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

module Hledger.Utils.Test (
   module Test.Tasty
  ,module Test.Tasty.HUnit
  -- ,module QC
  -- ,module SC
  ,tests
  ,test
  ,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(..))
#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup ((<>))
#endif
-- import Data.CallStack
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)
-- import Hledger.Utils.UTF8IOCompat (error')

-- * tasty helpers

-- TODO: pretty-print values in failure messages


-- | Name and group a list of tests. Shorter alias for Test.Tasty.HUnit.testGroup.
tests :: String -> [TestTree] -> TestTree
tests :: String -> [TestTree] -> TestTree
tests = String -> [TestTree] -> TestTree
testGroup

-- | Name an assertion or sequence of assertions. Shorter alias for Test.Tasty.HUnit.testCase.
test :: String -> Assertion -> TestTree
test :: String -> Assertion -> TestTree
test = String -> Assertion -> TestTree
testCase

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

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

-- | 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 :: 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
-> String
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> 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) String
"" 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 (String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure(String -> Assertion)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n")(String -> String)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String
"\nparse error at "String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ParseErrorBundle Text CustomErr -> String
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 :: StateT st (ParsecT CustomErr Text IO) a -> Text -> a -> Assertion
assertParseEq StateT st (ParsecT CustomErr Text IO) a
parser Text
input a
expected = 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 a
expected

-- | 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 :: 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
-> String
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> 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) String
"" 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 (String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n") (String -> String)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"\nparse error at "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty)
         (String -> b -> b -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"" 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 :: StateT st (ParsecT CustomErr Text IO) a
-> String -> String -> Assertion
assertParseError StateT st (ParsecT CustomErr Text IO) a
parser String
input String
errstr = do
  Either (ParseErrorBundle Text CustomErr) a
ep <- ParsecT CustomErr Text IO a
-> String
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> 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) String
"" (String -> Text
T.pack String
input)
  case Either (ParseErrorBundle Text CustomErr) a
ep of
    Right a
v -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"\nparse succeeded unexpectedly, producing:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
pshow a
v String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
    Left ParseErrorBundle Text CustomErr
e  -> do
      let e' :: String
e' = ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
e
      if String
errstr String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` String
e'
      then () -> Assertion
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"\nparse error is not as expected:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
e' String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\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 :: 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
-> String
-> Text
-> IO (Either (ParseErrorBundle Text CustomErr) st)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> 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) String
"" Text
input
  case Either (ParseErrorBundle Text CustomErr) st
es of
    Left ParseErrorBundle Text CustomErr
err -> String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n") (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ (String
"\nparse error at "String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text CustomErr -> String
customErrorBundlePretty ParseErrorBundle Text CustomErr
err
    Right st
s  -> String -> b -> b -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
String -> a -> a -> Assertion
assertEqual String
"" 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 :: 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 :: String
filepath = String
""
  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
-> String
-> Text
-> ExceptT
     FinalParseError IO (Either (ParseErrorBundle Text CustomErr) a)
forall (m :: * -> *) e s a.
Monad m =>
ParsecT e s m a
-> String -> 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) String
filepath Text
input
  case Either FinalParseError (Either (ParseErrorBundle Text CustomErr) a)
eep of
    Left FinalParseError
finalErr ->
      let prettyErr :: String
prettyErr = FinalParseErrorBundle' CustomErr -> String
finalErrorBundlePretty (FinalParseErrorBundle' CustomErr -> String)
-> FinalParseErrorBundle' CustomErr -> String
forall a b. (a -> b) -> a -> b
$ String
-> Text -> FinalParseError -> FinalParseErrorBundle' CustomErr
forall e.
String -> Text -> FinalParseError' e -> FinalParseErrorBundle' e
attachSource String
filepath Text
input FinalParseError
finalErr
      in  String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure (String -> Assertion) -> String -> Assertion
forall a b. (a -> b) -> a -> b
$ String
"parse error at " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
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 (String -> Assertion
forall a. HasCallStack => String -> IO a
assertFailure(String -> Assertion)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n")(String -> String)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(String
"\nparse error at "String -> String -> String
forall a. [a] -> [a] -> [a]
++)(String -> String)
-> (ParseErrorBundle Text CustomErr -> String)
-> ParseErrorBundle Text CustomErr
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.ParseErrorBundle Text CustomErr -> String
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 :: 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 a
expected = 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 a
expected

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