lib: make 'includedirectivep' an 'ErroringJournalParser'
- Update tests as well, requiring test utilities in Utils/Test.hs analogous to the those for 'JournalParser' but instead for 'ErroringJournalParser'
This commit is contained in:
Alex Chen
parent
855a8f1985
commit
3e54fc77a4
@ -106,7 +106,7 @@ reader = Reader
|
||||
-- | Parse and post-process a "Journal" from hledger's journal file
|
||||
-- format, or give an error.
|
||||
parse :: InputOpts -> FilePath -> Text -> ExceptT String IO Journal
|
||||
parse iopts = parseAndFinaliseJournal' journalp' iopts
|
||||
parse iopts = parseAndFinaliseJournal journalp' iopts
|
||||
where
|
||||
journalp' = do
|
||||
-- reverse parsed aliases to ensure that they are applied in order given on commandline
|
||||
@ -124,10 +124,10 @@ aliasesFromOpts = map (\a -> fromparse $ runParser accountaliasp ("--alias "++qu
|
||||
-- | A journal parser. Accumulates and returns a "ParsedJournal",
|
||||
-- which should be finalised/validated before use.
|
||||
--
|
||||
-- >>> rjp (journalp <* eof) "2015/1/1\n a 0\n"
|
||||
-- Right Journal with 1 transactions, 1 accounts
|
||||
-- >>> rejp (journalp <* eof) "2015/1/1\n a 0\n"
|
||||
-- Right (Right Journal with 1 transactions, 1 accounts)
|
||||
--
|
||||
journalp :: MonadIO m => JournalParser m ParsedJournal
|
||||
journalp :: MonadIO m => ErroringJournalParser m ParsedJournal
|
||||
journalp = do
|
||||
many addJournalItemP
|
||||
eof
|
||||
@ -135,7 +135,7 @@ journalp = do
|
||||
|
||||
-- | A side-effecting parser; parses any kind of journal item
|
||||
-- and updates the parse state accordingly.
|
||||
addJournalItemP :: MonadIO m => JournalParser m ()
|
||||
addJournalItemP :: MonadIO m => ErroringJournalParser m ()
|
||||
addJournalItemP =
|
||||
-- all journal line types can be distinguished by the first
|
||||
-- character, can use choice without backtracking
|
||||
@ -154,7 +154,7 @@ addJournalItemP =
|
||||
-- | Parse any journal directive and update the parse state accordingly.
|
||||
-- Cf http://hledger.org/manual.html#directives,
|
||||
-- http://ledger-cli.org/3.0/doc/ledger3.html#Command-Directives
|
||||
directivep :: MonadIO m => JournalParser m ()
|
||||
directivep :: MonadIO m => ErroringJournalParser m ()
|
||||
directivep = (do
|
||||
optional $ char '!'
|
||||
choice [
|
||||
@ -174,7 +174,7 @@ directivep = (do
|
||||
]
|
||||
) <?> "directive"
|
||||
|
||||
includedirectivep :: MonadIO m => JournalParser m ()
|
||||
includedirectivep :: MonadIO m => ErroringJournalParser m ()
|
||||
includedirectivep = do
|
||||
string "include"
|
||||
lift (skipSome spacenonewline)
|
||||
@ -784,8 +784,8 @@ tests_JournalReader = tests "JournalReader" [
|
||||
|
||||
,tests "directivep" [
|
||||
test "supports !" $ do
|
||||
expectParse directivep "!account a\n"
|
||||
expectParse directivep "!D 1.0\n"
|
||||
expectParseE directivep "!account a\n"
|
||||
expectParseE directivep "!D 1.0\n"
|
||||
]
|
||||
|
||||
,test "accountdirectivep" $ do
|
||||
@ -808,8 +808,8 @@ tests_JournalReader = tests "JournalReader" [
|
||||
expectParse ignoredpricecommoditydirectivep "N $\n"
|
||||
|
||||
,test "includedirectivep" $ do
|
||||
test "include" $ expectParseError includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
|
||||
test "glob" $ expectParseError includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
|
||||
test "include" $ expectParseErrorE includedirectivep "include nosuchfile\n" "No existing files match pattern: nosuchfile"
|
||||
test "glob" $ expectParseErrorE includedirectivep "include nosuchfile*\n" "No existing files match pattern: nosuchfile*"
|
||||
|
||||
,test "marketpricedirectivep" $ expectParseEq marketpricedirectivep
|
||||
"P 2017/01/30 BTC $922.83\n"
|
||||
@ -828,7 +828,7 @@ tests_JournalReader = tests "JournalReader" [
|
||||
|
||||
|
||||
,tests "journalp" [
|
||||
test "empty file" $ expectParseEq journalp "" nulljournal
|
||||
test "empty file" $ expectParseEqE journalp "" nulljournal
|
||||
]
|
||||
|
||||
]
|
||||
|
||||
@ -16,13 +16,18 @@ module Hledger.Utils.Test (
|
||||
,is
|
||||
,expectEqPP
|
||||
,expectParse
|
||||
,expectParseE
|
||||
,expectParseError
|
||||
,expectParseErrorE
|
||||
,expectParseEq
|
||||
,expectParseEqE
|
||||
,expectParseEqOn
|
||||
,expectParseEqOnE
|
||||
)
|
||||
where
|
||||
|
||||
import Control.Exception
|
||||
import Control.Monad.Except (ExceptT, runExceptT)
|
||||
import Control.Monad.State.Strict (StateT, evalStateT)
|
||||
#if !(MIN_VERSION_base(4,11,0))
|
||||
import Data.Monoid ((<>))
|
||||
@ -101,6 +106,7 @@ is = flip expectEqPP
|
||||
|
||||
-- | Test 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.
|
||||
expectParse :: (Monoid st, Eq a, Show a, HasCallStack) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> E.Test ()
|
||||
@ -108,6 +114,24 @@ expectParse parser input = do
|
||||
ep <- E.io (runParserT (evalStateT (parser <* eof) mempty) "" input)
|
||||
either (fail.(++"\n").("\nparse error at "++).parseErrorPretty) (const ok) ep
|
||||
|
||||
-- Suitable for hledger's ErroringJournalParser parsers.
|
||||
expectParseE
|
||||
:: (Monoid st, Eq a, Show a, HasCallStack)
|
||||
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
|
||||
-> T.Text
|
||||
-> E.Test ()
|
||||
expectParseE parser input = do
|
||||
let filepath = ""
|
||||
eep <- E.io $ runExceptT $
|
||||
runParserT (evalStateT (parser <* eof) mempty) filepath input
|
||||
case eep of
|
||||
Left finalErr ->
|
||||
let prettyErr = finalParseErrorPretty $ attachSource filepath input finalErr
|
||||
in fail $ "parse error at " <> prettyErr
|
||||
Right ep -> either (fail.(++"\n").("\nparse error at "++).parseErrorPretty)
|
||||
(const ok)
|
||||
ep
|
||||
|
||||
-- | Test that this stateful parser runnable in IO fails to parse
|
||||
-- the given input text, with a parse error containing the given string.
|
||||
expectParseError :: (Monoid st, Eq a, Show a, HasCallStack) =>
|
||||
@ -122,12 +146,43 @@ expectParseError parser input errstr = do
|
||||
then ok
|
||||
else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
|
||||
|
||||
expectParseErrorE
|
||||
:: (Monoid st, Eq a, Show a, HasCallStack)
|
||||
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
|
||||
-> T.Text
|
||||
-> String
|
||||
-> E.Test ()
|
||||
expectParseErrorE parser input errstr = do
|
||||
let filepath = ""
|
||||
eep <- E.io $ runExceptT $ runParserT (evalStateT parser mempty) filepath input
|
||||
case eep of
|
||||
Left finalErr -> do
|
||||
let prettyErr = finalParseErrorPretty $ attachSource filepath input finalErr
|
||||
if errstr `isInfixOf` prettyErr
|
||||
then ok
|
||||
else fail $ "\nparse error is not as expected:\n" ++ prettyErr ++ "\n"
|
||||
Right ep -> case ep of
|
||||
Right v -> fail $ "\nparse succeeded unexpectedly, producing:\n" ++ pshow v ++ "\n"
|
||||
Left e -> do
|
||||
let e' = parseErrorPretty e
|
||||
if errstr `isInfixOf` e'
|
||||
then ok
|
||||
else fail $ "\nparse error is not as expected:\n" ++ e' ++ "\n"
|
||||
|
||||
-- | Like expectParse, but also test the parse result is an expected value,
|
||||
-- pretty-printing both if it fails.
|
||||
expectParseEq :: (Monoid st, Eq a, Show a, HasCallStack) =>
|
||||
StateT st (ParsecT CustomErr T.Text IO) a -> T.Text -> a -> E.Test ()
|
||||
expectParseEq parser input expected = expectParseEqOn parser input id expected
|
||||
|
||||
expectParseEqE
|
||||
:: (Monoid st, Eq a, Show a, HasCallStack)
|
||||
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
|
||||
-> T.Text
|
||||
-> a
|
||||
-> E.Test ()
|
||||
expectParseEqE parser input expected = expectParseEqOnE parser input id expected
|
||||
|
||||
-- | Like expectParseEq, but transform the parse result with the given function
|
||||
-- before comparing it.
|
||||
expectParseEqOn :: (Monoid st, Eq b, Show b, HasCallStack) =>
|
||||
@ -136,3 +191,23 @@ expectParseEqOn parser input f expected = do
|
||||
ep <- E.io $ runParserT (evalStateT (parser <* eof) mempty) "" input
|
||||
either (fail . (++"\n") . ("\nparse error at "++) . parseErrorPretty) (expectEqPP expected . f) ep
|
||||
|
||||
expectParseEqOnE
|
||||
:: (Monoid st, Eq b, Show b, HasCallStack)
|
||||
=> StateT st (ParsecT CustomErr T.Text (ExceptT FinalParseError IO)) a
|
||||
-> T.Text
|
||||
-> (a -> b)
|
||||
-> b
|
||||
-> E.Test ()
|
||||
expectParseEqOnE parser input f expected = do
|
||||
let filepath = ""
|
||||
eep <- E.io $ runExceptT $
|
||||
runParserT (evalStateT (parser <* eof) mempty) filepath input
|
||||
case eep of
|
||||
Left finalErr ->
|
||||
let prettyErr = finalParseErrorPretty $ attachSource filepath input finalErr
|
||||
in fail $ "parse error at " <> prettyErr
|
||||
Right ep ->
|
||||
either (fail . (++"\n") . ("\nparse error at "++) . parseErrorPretty)
|
||||
(expectEqPP expected . f)
|
||||
ep
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user