{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Hledger.Utils.Test (
   module Test.Tasty
  ,module Test.Tasty.HUnit
  -- ,module QC
  -- ,module SC
  ,assertLeft
  ,assertRight
  ,assertParse
  ,assertParseEq
  ,assertParseEqOn
  ,assertParseError
  ,assertParseE
  ,assertParseEqE
  ,assertParseErrorE
  ,assertParseStateOn
)
where

import Control.Monad.Except (ExceptT, runExceptT)
import Control.Monad.State.Strict (StateT, evalStateT, execStateT)
import Data.Default (Default(..))
import Data.List (isInfixOf)
import qualified Data.Text as T
import Test.Tasty hiding (defaultMain)
import Test.Tasty.HUnit
-- import Test.Tasty.QuickCheck as QC
-- import Test.Tasty.SmallCheck as SC
import Text.Megaparsec
import Text.Megaparsec.Custom
  ( CustomErr,
    FinalParseError,
    attachSource,
    customErrorBundlePretty,
    finalErrorBundlePretty,
  )

import Hledger.Utils.Debug (pshow)

-- * tasty helpers

-- TODO: pretty-print values in failure messages

-- | Assert any Left value.
assertLeft :: (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft :: forall b a. (HasCallStack, Eq b, Show b) => Either a b -> Assertion
assertLeft (Left a
_)  = () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
assertLeft (Right b
b) = [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"expected Left, got (Right " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ b -> [Char]
forall a. Show a => a -> [Char]
show b
b [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- | Assert any Right value.
assertRight :: (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight :: forall a b. (HasCallStack, Eq a, Show a) => Either a b -> Assertion
assertRight (Right b
_) = () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
assertRight (Left a
a)  = [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"expected Right, got (Left " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
show a
a [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- | Assert that this stateful parser runnable in IO successfully parses
-- all of the given input text, showing the parse error if it fails.
-- Suitable for hledger's JournalParser parsers.
assertParse :: (HasCallStack, Eq a, Show a, Default st) =>
  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> Assertion
assertParse :: forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> Assertion
assertParse StateT st (ParsecT CustomErr Text IO) a
parser Text
input = do
  Either (ParseErrorBundle Text CustomErr) a
ep <- ParsecT CustomErr Text IO a
-> [Char]
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (StateT st (ParsecT CustomErr Text IO) a
-> st -> ParsecT CustomErr Text IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT st (ParsecT CustomErr Text IO) a
parser StateT st (ParsecT CustomErr Text IO) a
-> StateT st (ParsecT CustomErr Text IO) ()
-> StateT st (ParsecT CustomErr Text IO) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT st (ParsecT CustomErr Text IO) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) st
forall a. Default a => a
def) [Char]
"" Text
input
  (ParseErrorBundle Text CustomErr -> Assertion)
-> (a -> Assertion)
-> Either (ParseErrorBundle Text CustomErr) a
-> Assertion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure([Char] -> Assertion)
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n")([Char] -> [Char])
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Char]
"\nparse error at "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)([Char] -> [Char])
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty)
         (Assertion -> a -> Assertion
forall a b. a -> b -> a
const (Assertion -> a -> Assertion) -> Assertion -> a -> Assertion
forall a b. (a -> b) -> a -> b
$ () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ())
         Either (ParseErrorBundle Text CustomErr) a
ep

-- | Assert a parser produces an expected value.
assertParseEq :: (HasCallStack, Eq a, Show a, Default st) =>
  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> Assertion
assertParseEq :: forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT st (ParsecT CustomErr Text IO) a
parser Text
input = StateT st (ParsecT CustomErr Text IO) a
-> Text -> (a -> a) -> a -> Assertion
forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOn StateT st (ParsecT CustomErr Text IO) a
parser Text
input a -> a
forall a. a -> a
id

-- | Like assertParseEq, but transform the parse result with the given function
-- before comparing it.
assertParseEqOn :: (HasCallStack, Eq b, Show b, Default st) =>
  StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> (a -> b) -> b -> Assertion
assertParseEqOn :: forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOn StateT st (ParsecT CustomErr Text IO) a
parser Text
input a -> b
f b
expected = do
  Either (ParseErrorBundle Text CustomErr) a
ep <- ParsecT CustomErr Text IO a
-> [Char]
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (StateT st (ParsecT CustomErr Text IO) a
-> st -> ParsecT CustomErr Text IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT st (ParsecT CustomErr Text IO) a
parser StateT st (ParsecT CustomErr Text IO) a
-> StateT st (ParsecT CustomErr Text IO) ()
-> StateT st (ParsecT CustomErr Text IO) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT st (ParsecT CustomErr Text IO) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) st
forall a. Default a => a
def) [Char]
"" Text
input
  (ParseErrorBundle Text CustomErr -> Assertion)
-> (a -> Assertion)
-> Either (ParseErrorBundle Text CustomErr) a
-> Assertion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion)
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n") ([Char] -> [Char])
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"\nparse error at "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char])
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty)
         ([Char] -> b -> b -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
[Char] -> a -> a -> Assertion
assertEqual [Char]
"" b
expected (b -> Assertion) -> (a -> b) -> a -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
         Either (ParseErrorBundle Text CustomErr) a
ep

-- | Assert that this stateful parser runnable in IO fails to parse
-- the given input text, with a parse error containing the given string.
assertParseError :: (HasCallStack, Eq a, Show a, Default st) =>
  StateT st (ParsecT CustomErr T.Text IO) a -> String -> String -> Assertion
assertParseError :: forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> [Char] -> [Char] -> Assertion
assertParseError StateT st (ParsecT CustomErr Text IO) a
parser [Char]
input [Char]
errstr = do
  Either (ParseErrorBundle Text CustomErr) a
ep <- ParsecT CustomErr Text IO a
-> [Char]
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (StateT st (ParsecT CustomErr Text IO) a
-> st -> ParsecT CustomErr Text IO a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT st (ParsecT CustomErr Text IO) a
parser st
forall a. Default a => a
def) [Char]
"" ([Char] -> Text
T.pack [Char]
input)
  case Either (ParseErrorBundle Text CustomErr) a
ep of
    Right a
v -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"\nparse succeeded unexpectedly, producing:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
pshow a
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
    Left ParseErrorBundle Text CustomErr
e  -> do
      let e' :: [Char]
e' = ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
      if [Char]
errstr [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
e'
      then () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"\nparse error is not as expected:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"

-- | Run a stateful parser in IO like assertParse, then assert that the
-- final state (the wrapped state, not megaparsec's internal state),
-- transformed by the given function, matches the given expected value.
assertParseStateOn :: (HasCallStack, Eq b, Show b, Default st) =>
     StateT st (ParsecT CustomErr T.Text IO) a
  -> T.Text
  -> (st -> b)
  -> b
  -> Assertion
assertParseStateOn :: forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT CustomErr Text IO) a
-> Text -> (st -> b) -> b -> Assertion
assertParseStateOn StateT st (ParsecT CustomErr Text IO) a
parser Text
input st -> b
f b
expected = do
  Either (ParseErrorBundle Text CustomErr) st
es <- ParsecT CustomErr Text IO st
-> [Char]
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) st)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (StateT st (ParsecT CustomErr Text IO) a
-> st -> ParsecT CustomErr Text IO st
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m s
execStateT (StateT st (ParsecT CustomErr Text IO) a
parser StateT st (ParsecT CustomErr Text IO) a
-> StateT st (ParsecT CustomErr Text IO) ()
-> StateT st (ParsecT CustomErr Text IO) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT st (ParsecT CustomErr Text IO) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) st
forall a. Default a => a
def) [Char]
"" Text
input
  case Either (ParseErrorBundle Text CustomErr) st
es of
    Left ParseErrorBundle Text CustomErr
err -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n") ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ([Char]
"\nparse error at "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty ParseErrorBundle Text CustomErr
err
    Right st
s  -> [Char] -> b -> b -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
[Char] -> a -> a -> Assertion
assertEqual [Char]
"" b
expected (b -> Assertion) -> b -> Assertion
forall a b. (a -> b) -> a -> b
$ st -> b
f st
s

-- | These "E" variants of the above are suitable for hledger's ErroringJournalParser parsers.
assertParseE
  :: (HasCallStack, Eq a, Show a, Default st)
  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
  -> T.Text
  -> Assertion
assertParseE :: forall a st.
(HasCallStack, Eq a, Show a, Default st) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> Assertion
assertParseE StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
parser Text
input = do
  let filepath :: [Char]
filepath = [Char]
""
  Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a)
eep <- ExceptT
  FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
-> IO
     (Either
        FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
 -> IO
      (Either
         FinalParseError (Either (ParseErrorBundle Text CustomErr) a)))
-> ExceptT
     FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
-> IO
     (Either
        FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
forall a b. (a -> b) -> a -> b
$
           ParsecT CustomErr Text (ExceptT FinalParseError IO) a
-> [Char]
-> Text
-> ExceptT
     FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> st -> ParsecT CustomErr Text (ExceptT FinalParseError IO) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
parser StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> StateT
     st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
-> StateT
     st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) st
forall a. Default a => a
def) [Char]
filepath Text
input
  case Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a)
eep of
    Left FinalParseError
finalErr ->
      let prettyErr :: [Char]
prettyErr = FinalParseErrorBundle' CustomErr -> [Char]
finalErrorBundlePretty (FinalParseErrorBundle' CustomErr -> [Char])
-> FinalParseErrorBundle' CustomErr -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
-> Text -> FinalParseError -> FinalParseErrorBundle' CustomErr
forall e.
[Char] -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
attachSource [Char]
filepath Text
input FinalParseError
finalErr
      in  [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"parse error at " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
prettyErr
    Right Either (ParseErrorBundle Text CustomErr) a
ep ->
      (ParseErrorBundle Text CustomErr -> Assertion)
-> (a -> Assertion)
-> Either (ParseErrorBundle Text CustomErr) a
-> Assertion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure([Char] -> Assertion)
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n")([Char] -> [Char])
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Char]
"\nparse error at "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++)([Char] -> [Char])
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty)
             (Assertion -> a -> Assertion
forall a b. a -> b -> a
const (Assertion -> a -> Assertion) -> Assertion -> a -> Assertion
forall a b. (a -> b) -> a -> b
$ () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ())
             Either (ParseErrorBundle Text CustomErr) a
ep

assertParseEqE
  :: (Default st, Eq a, Show a, HasCallStack)
  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
  -> T.Text
  -> a
  -> Assertion
assertParseEqE :: forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> a -> Assertion
assertParseEqE StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
parser Text
input = StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> (a -> a) -> a -> Assertion
forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOnE StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
parser Text
input a -> a
forall a. a -> a
id

assertParseEqOnE
  :: (HasCallStack, Eq b, Show b, Default st)
  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
  -> T.Text
  -> (a -> b)
  -> b
  -> Assertion
assertParseEqOnE :: forall b st a.
(HasCallStack, Eq b, Show b, Default st) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> (a -> b) -> b -> Assertion
assertParseEqOnE StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
parser Text
input a -> b
f b
expected = do
  let filepath :: [Char]
filepath = [Char]
""
  Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a)
eep <- ExceptT
  FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
-> IO
     (Either
        FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
 -> IO
      (Either
         FinalParseError (Either (ParseErrorBundle Text CustomErr) a)))
-> ExceptT
     FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
-> IO
     (Either
        FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text (ExceptT FinalParseError IO) a
-> [Char]
-> Text
-> ExceptT
     FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> st -> ParsecT CustomErr Text (ExceptT FinalParseError IO) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
parser StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> StateT
     st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
-> StateT
     st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof) st
forall a. Default a => a
def) [Char]
filepath Text
input
  case Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a)
eep of
    Left FinalParseError
finalErr ->
      let prettyErr :: [Char]
prettyErr = FinalParseErrorBundle' CustomErr -> [Char]
finalErrorBundlePretty (FinalParseErrorBundle' CustomErr -> [Char])
-> FinalParseErrorBundle' CustomErr -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
-> Text -> FinalParseError -> FinalParseErrorBundle' CustomErr
forall e.
[Char] -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
attachSource [Char]
filepath Text
input FinalParseError
finalErr
      in  [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"parse error at " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
prettyErr
    Right Either (ParseErrorBundle Text CustomErr) a
ep ->
      (ParseErrorBundle Text CustomErr -> Assertion)
-> (a -> Assertion)
-> Either (ParseErrorBundle Text CustomErr) a
-> Assertion
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion)
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++[Char]
"\n") ([Char] -> [Char])
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
"\nparse error at "[Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++) ([Char] -> [Char])
-> (ParseErrorBundle Text CustomErr -> [Char])
-> ParseErrorBundle Text CustomErr
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty)
             ([Char] -> b -> b -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
[Char] -> a -> a -> Assertion
assertEqual [Char]
"" b
expected (b -> Assertion) -> (a -> b) -> a -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f)
             Either (ParseErrorBundle Text CustomErr) a
ep

assertParseErrorE
  :: (Default st, Eq a, Show a, HasCallStack)
  => StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
  -> T.Text
  -> String
  -> Assertion
assertParseErrorE :: forall st a.
(Default st, Eq a, Show a, HasCallStack) =>
StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> Text -> [Char] -> Assertion
assertParseErrorE StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
parser Text
input [Char]
errstr = do
  let filepath :: [Char]
filepath = [Char]
""
  Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a)
eep <- ExceptT
  FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
-> IO
     (Either
        FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT (ExceptT
   FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
 -> IO
      (Either
         FinalParseError (Either (ParseErrorBundle Text CustomErr) a)))
-> ExceptT
     FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
-> IO
     (Either
        FinalParseError (Either (ParseErrorBundle Text CustomErr) a))
forall a b. (a -> b) -> a -> b
$ ParsecT CustomErr Text (ExceptT FinalParseError IO) a
-> [Char]
-> Text
-> ExceptT
     FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> [Char] -> s -> m (Either (ParseErrorBundle s e) a)
runParserT (StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
-> st -> ParsecT CustomErr Text (ExceptT FinalParseError IO) a
forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT StateT st (ParsecT CustomErr Text (ExceptT FinalParseError IO)) a
parser st
forall a. Default a => a
def) [Char]
filepath Text
input
  case Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a)
eep of
    Left FinalParseError
finalErr -> do
      let prettyErr :: [Char]
prettyErr = FinalParseErrorBundle' CustomErr -> [Char]
finalErrorBundlePretty (FinalParseErrorBundle' CustomErr -> [Char])
-> FinalParseErrorBundle' CustomErr -> [Char]
forall a b. (a -> b) -> a -> b
$ [Char]
-> Text -> FinalParseError -> FinalParseErrorBundle' CustomErr
forall e.
[Char] -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
attachSource [Char]
filepath Text
input FinalParseError
finalErr
      if [Char]
errstr [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
prettyErr
      then () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"\nparse error is not as expected:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
prettyErr [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
    Right Either (ParseErrorBundle Text CustomErr) a
ep -> case Either (ParseErrorBundle Text CustomErr) a
ep of
      Right a
v -> [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"\nparse succeeded unexpectedly, producing:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ a -> [Char]
forall a. Show a => a -> [Char]
pshow a
v [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"
      Left ParseErrorBundle Text CustomErr
e  -> do
        let e' :: [Char]
e' = ParseErrorBundle Text CustomErr -> [Char]
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
        if [Char]
errstr [Char] -> [Char] -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` [Char]
e'
        then () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        else [Char] -> Assertion
forall a. HasCallStack => [Char] -> IO a
assertFailure ([Char] -> Assertion) -> [Char] -> Assertion
forall a b. (a -> b) -> a -> b
$ [Char]
"\nparse error is not as expected:\n" [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
e' [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
"\n"