{-# 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 (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 (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 (r :: * -> *) s a. Leftover r s => r a -> Maybe s
leftover r a
res