slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: switch to custom parse errors for parserErrorAt

Browse Source 
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
hledger-lib/Hledger/Read/Common.hs
View File

@ -49,7 +49,6 @@ module Hledger.Read.Common (
getAccountAliases, getAccountAliases,
clearAccountAliases, clearAccountAliases,
journalAddFile, journalAddFile,
parserErrorAt,
-- * parsers -- * parsers
-- ** transaction bits -- ** 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, -- append, unlike the other fields, even though we do a final reverse,
-- to compensate for additional reversal due to including/monoid-concatting -- 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 --- * parsers
--- ** transaction bits --- ** transaction bits

19
hledger-lib/Hledger/Read/JournalReader.hs
View File

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