    {-# LANGUAGE OverloadedStrings,
    			 FlexibleContexts #-}
    -- |
    -- Module       : Test.Hspec.Attoparsec
    -- Copyright    : (c) 2014 Alp Mestanogullari
    -- License      : BSD3
    -- Maintainer   : alpmestan@gmail.com
    -- Stability    : experimental
    --
    -- Utility functions for testing @attoparsec@ parsers, each one providing
    -- an example of how to use it.
    module Test.Hspec.Attoparsec
      ( -- * Equality-based combinator
        shouldParse

      , -- * Predicate-based combinator
        parseSatisfies

      , -- * Inspecting the result
        shouldSucceedOn
      , shouldFailOn

      , -- * Inspecting unconsumed input
        leavesUnconsumed

      , -- * The 'Source' class, connecting parsers and inputs
        Source(..)

      , -- * The 'Leftover' class, letting us inspect unconsumed input
        Leftover(..)
      ) where

    import Control.Monad (when)
    import Test.Hspec.Attoparsec.Source
    import Test.Hspec.Expectations

    -- | Create an expectation by saying what the result should be.
    --   Intended to be used with '~>' as follows:
    --
    -- >   "<!-- foo -->" ~> htmlCommentParser
    -- >     `shouldParse` TagComment " foo "
    shouldParse :: (Eq a, Show a) => Either String a -> a -> Expectation
    Either String a
    res shouldParse :: forall a. (Eq a, Show a) => Either String a -> a -> Expectation
    `shouldParse` a
    expectedVal =
      (String -> Expectation)
    -> (a -> Expectation) -> Either String a -> Expectation
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (HasCallStack => String -> Expectation
    String -> Expectation
    expectationFailure (String -> Expectation)
    -> (String -> String) -> String -> Expectation
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    errmsg)
             a -> Expectation
    checkEquality
             Either String a
    res

      where errmsg :: String -> String
    errmsg String
    err =   String
    "  expected: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    expectedVal
                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n  but parsing failed with error: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    err

            checkEquality :: a -> Expectation
    checkEquality a
    parsedVal =
              Bool -> Expectation -> Expectation
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (a
    parsedVal a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    expectedVal) (Expectation -> Expectation) -> Expectation -> Expectation
    forall a b. (a -> b) -> a -> b
    $
                HasCallStack => String -> Expectation
    String -> Expectation
    expectationFailure (String -> Expectation) -> String -> Expectation
    forall a b. (a -> b) -> a -> b
    $   String
    "  expected: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    expectedVal
                                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n  but got: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    parsedVal

    -- | Create an expectation by saying that the parser should successfully
    --   parse a value and that this value should satisfy some predicate.
    --
    --   This can fail if the parsing doesn't succeed or if it succeeds but
    --   the value doesn't match the predicate.
    --
    -- > ">>>" ~> many (char '>')
    -- >   `parseSatisfies` ((==3) . length)
    parseSatisfies :: Show a => Either String a -> (a -> Bool) -> Expectation
    parseSatisfies :: forall a. Show a => Either String a -> (a -> Bool) -> Expectation
    parseSatisfies Either String a
    res a -> Bool
    predicate =
      (String -> Expectation)
    -> (a -> Expectation) -> Either String a -> Expectation
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (HasCallStack => String -> Expectation
    String -> Expectation
    expectationFailure (String -> Expectation)
    -> (String -> String) -> String -> Expectation
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    errmsg)
             a -> Expectation
    checkPred
             Either String a
    res

      where errmsg :: String -> String
    errmsg String
    err =   String
    "  expected a parsed value to check against the predicate"
                      String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n  but parsing failed with error: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    err

            checkPred :: a -> Expectation
    checkPred a
    value =
              Bool -> Expectation -> Expectation
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ a -> Bool
    predicate a
    value) (Expectation -> Expectation) -> Expectation -> Expectation
    forall a b. (a -> b) -> a -> b
    $
                HasCallStack => String -> Expectation
    String -> Expectation
    expectationFailure (String -> Expectation) -> String -> Expectation
    forall a b. (a -> b) -> a -> b
    $
                     String
    "  the following value did not match the predicate: \n"
                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "  " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    value

    -- | Check that a parser fails on some given input
    --
    -- > char 'x' `shouldFailOn` "a"
    shouldFailOn :: (Source p s s' r, Show a)
                 => p s' a
                 -> s
                 -> Expectation
    p s' a
    parser shouldFailOn :: forall (p :: * -> * -> *) s s' (r :: * -> *) a.
    (Source p s s' r, Show a) =>
    p s' a -> s -> Expectation
    `shouldFailOn` s
    string =
      (s
    string s -> p s' a -> Either String a
    forall a. s -> p s' a -> Either String a
    forall (parser :: * -> * -> *) string string' (result :: * -> *) a.
    Source parser string string' result =>
    string -> parser string' a -> Either String a
    ~> p s' a
    parser) Either String a -> (Either String a -> Bool) -> Expectation
    forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
    `shouldSatisfy` Either String a -> Bool
    forall a b. Either a b -> Bool
    isLeft

    -- | Check that a parser succeeds on some given input
    --
    -- > char 'x' `shouldSucceedOn` "x"
    shouldSucceedOn :: (Source p s s' r, Show a)
                    => p s' a
                    -> s
                    -> Expectation
    p s' a
    parser shouldSucceedOn :: forall (p :: * -> * -> *) s s' (r :: * -> *) a.
    (Source p s s' r, Show a) =>
    p s' a -> s -> Expectation
    `shouldSucceedOn` s
    string =
      (s
    string s -> p s' a -> Either String a
    forall a. s -> p s' a -> Either String a
    forall (parser :: * -> * -> *) string string' (result :: * -> *) a.
    Source parser string string' result =>
    string -> parser string' a -> Either String a
    ~> p s' a
    parser) Either String a -> (Either String a -> Bool) -> Expectation
    forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
    `shouldSatisfy` Either String a -> Bool
    forall a b. Either a b -> Bool
    isRight

    isLeft :: Either a b -> Bool
    isLeft :: forall a b. Either a b -> Bool
    isLeft (Left a
    _) = Bool
    True
    isLeft Either a b
    _        = Bool
    False

    isRight :: Either a b -> Bool
    isRight :: forall a b. Either a b -> Bool
    isRight (Right b
    _) = Bool
    True
    isRight Either a b
    _         = Bool
    False

    -- | Checking that the given parser succeeds
    --   and yields the given part of the input unconsumed.
    --   Intended to be used in conjunction with '~?>'
    --
    -- > ("xa" :: Text) ~?> char 'x'
    -- >   `leavesUnconsumed` "a"
    leavesUnconsumed :: (Source p s s' r, Leftover r s)
                     => r a
                     -> s
                     -> Expectation
    leavesUnconsumed :: forall (p :: * -> * -> *) s s' (r :: * -> *) a.
    (Source p s s' r, Leftover r s) =>
    r a -> s -> Expectation
    leavesUnconsumed r a
    res s
    str
      | Maybe s
    unconsumed Maybe s -> Maybe s -> Bool
    forall a. Eq a => a -> a -> Bool
    == Maybe s
    forall a. Maybe a
    Nothing Bool -> Bool -> Bool
    && s
    str s -> s -> Bool
    forall a. Eq a => a -> a -> Bool
    /= s
    "" =
          HasCallStack => String -> Expectation
    String -> Expectation
    expectationFailure (String -> Expectation) -> String -> Expectation
    forall a b. (a -> b) -> a -> b
    $
               String
    "  expected the parser to leave the following unconsumed: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ s -> String
    forall a. Show a => a -> String
    show s
    str
          String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n  but got no leftover"
      | Bool
    otherwise =
          case Maybe s
    unconsumed of
            Just s
    str' ->
              Bool -> Expectation -> Expectation
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (s
    str s -> s -> Bool
    forall a. Eq a => a -> a -> Bool
    /= s
    str') (Expectation -> Expectation) -> Expectation -> Expectation
    forall a b. (a -> b) -> a -> b
    $
                HasCallStack => String -> Expectation
    String -> Expectation
    expectationFailure (String -> Expectation) -> String -> Expectation
    forall a b. (a -> b) -> a -> b
    $
                       String
    "  expected the parser to leave the following unconsumed: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ s -> String
    forall a. Show a => a -> String
    show s
    str
                  String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n  but got: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ s -> String
    forall a. Show a => a -> String
    show s
    str'
            Maybe s
    Nothing -> HasCallStack => String -> Expectation
    String -> Expectation
    expectationFailure (String -> Expectation) -> String -> Expectation
    forall a b. (a -> b) -> a -> b
    $
                              String
    "  expected the parser to leave the following unconsumed: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ s -> String
    forall a. Show a => a -> String
    show s
    str
                         String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n  but got no unconsumed input"

      where unconsumed :: Maybe s
    unconsumed = r a -> Maybe s
    forall a. r a -> Maybe s
    forall (r :: * -> *) s a. Leftover r s => r a -> Maybe s
    leftover r a
    res