lib: switch to custom parse errors for parserErrorAt

Also weaken the types of the parsers that use it
This commit is contained in:
Alex Chen 2018-06-05 14:25:30 -06:00
parent c5561f25f1
commit d707b351cc
2 changed files with 10 additions and 22 deletions

View File

@ -49,7 +49,6 @@ module Hledger.Read.Common (
getAccountAliases,
clearAccountAliases,
journalAddFile,
parserErrorAt,
-- * parsers
-- ** transaction bits
@ -318,18 +317,6 @@ journalAddFile f j@Journal{jfiles=fs} = j{jfiles=fs++[f]}
-- append, unlike the other fields, even though we do a final reverse,
-- to compensate for additional reversal due to including/monoid-concatting
-- -- | Terminate parsing entirely, returning the given error message
-- -- with the current parse position prepended.
-- parserError :: String -> ErroringJournalParser a
-- parserError s = do
-- pos <- getPosition
-- parserErrorAt pos s
-- | Terminate parsing entirely, returning the given error message
-- with the given parse position prepended.
parserErrorAt :: Monad m => SourcePos -> String -> ErroringJournalParser m a
parserErrorAt pos s = throwError $ sourcePosPretty pos ++ ":\n" ++ s
--- * parsers
--- ** transaction bits

View File

@ -100,6 +100,7 @@ import Hledger.Read.Common
import Hledger.Read.TimeclockReader (timeclockfilep)
import Hledger.Read.TimedotReader (timedotfilep)
import Hledger.Utils
import Hledger.Utils.ParseErrors
-- $setup
-- >>> :set -XOverloadedStrings
@ -265,14 +266,14 @@ indentedlinep = lift (skipSome spacenonewline) >> (rstrip <$> lift restofline)
-- >>> Right _ <- rejp commoditydirectivep "commodity $\n format $1.00"
-- >>> Right _ <- rejp commoditydirectivep "commodity $\n\n" -- a commodity with no format
-- >>> Right _ <- rejp commoditydirectivep "commodity $1.00\n format $1.00" -- both, what happens ?
commoditydirectivep :: Monad m => ErroringJournalParser m ()
commoditydirectivep :: Monad m => JournalParser m ()
commoditydirectivep = try commoditydirectiveonelinep <|> commoditydirectivemultilinep
-- | Parse a one-line commodity directive.
--
-- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00"
-- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00 ; blah\n"
commoditydirectiveonelinep :: Monad m => ErroringJournalParser m ()
commoditydirectiveonelinep :: Monad m => JournalParser m ()
commoditydirectiveonelinep = do
string "commodity"
lift (skipSome spacenonewline)
@ -282,7 +283,7 @@ commoditydirectiveonelinep = do
_ <- lift followingcommentp
let comm = Commodity{csymbol=acommodity, cformat=Just $ dbg2 "style from commodity directive" astyle}
if asdecimalpoint astyle == Nothing
then parserErrorAt pos pleaseincludedecimalpoint
then parseErrorAt pos pleaseincludedecimalpoint
else modify' (\j -> j{jcommodities=M.insert acommodity comm $ jcommodities j})
pleaseincludedecimalpoint :: String
@ -291,7 +292,7 @@ pleaseincludedecimalpoint = "to avoid ambiguity, please include a decimal point
-- | Parse a multi-line commodity directive, containing 0 or more format subdirectives.
--
-- >>> Right _ <- rejp commoditydirectivemultilinep "commodity $ ; blah \n format $1.00 ; blah"
commoditydirectivemultilinep :: Monad m => ErroringJournalParser m ()
commoditydirectivemultilinep :: Monad m => JournalParser m ()
commoditydirectivemultilinep = do
string "commodity"
lift (skipSome spacenonewline)
@ -305,7 +306,7 @@ commoditydirectivemultilinep = do
-- | Parse a format (sub)directive, throwing a parse error if its
-- symbol does not match the one given.
formatdirectivep :: Monad m => CommoditySymbol -> ErroringJournalParser m AmountStyle
formatdirectivep :: Monad m => CommoditySymbol -> JournalParser m AmountStyle
formatdirectivep expectedsym = do
string "format"
lift (skipSome spacenonewline)
@ -315,9 +316,9 @@ formatdirectivep expectedsym = do
if acommodity==expectedsym
then
if asdecimalpoint astyle == Nothing
then parserErrorAt pos pleaseincludedecimalpoint
then parseErrorAt pos pleaseincludedecimalpoint
else return $ dbg2 "style from format subdirective" astyle
else parserErrorAt pos $
else parseErrorAt pos $
printf "commodity directive symbol \"%s\" and format directive symbol \"%s\" should be the same" expectedsym acommodity
keywordp :: String -> JournalParser m ()
@ -402,7 +403,7 @@ defaultyeardirectivep = do
failIfInvalidYear y
setYear y'
defaultcommoditydirectivep :: Monad m => ErroringJournalParser m ()
defaultcommoditydirectivep :: Monad m => JournalParser m ()
defaultcommoditydirectivep = do
char 'D' <?> "default commodity"
lift (skipSome spacenonewline)
@ -410,7 +411,7 @@ defaultcommoditydirectivep = do
Amount{acommodity,astyle} <- amountp
lift restofline
if asdecimalpoint astyle == Nothing
then parserErrorAt pos pleaseincludedecimalpoint
then parseErrorAt pos pleaseincludedecimalpoint
else setDefaultCommodityAndStyle (acommodity, astyle)
marketpricedirectivep :: Monad m => JournalParser m MarketPrice