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

lib: weaken parser types

Browse Source
This commit is contained in:
Alex Chen 2018-06-05 23:52:28 -06:00
parent 9b6558401f
commit b034fa7ca9
2 changed files with 25 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -334,7 +334,7 @@ codep = option "" $ try $ do
skipSome spacenonewline skipSome spacenonewline
between (char '(') (char ')') $ takeWhileP Nothing (/= ')') between (char '(') (char ')') $ takeWhileP Nothing (/= ')')
descriptionp :: JournalParser m Text descriptionp :: TextParser m Text
descriptionp = takeWhileP Nothing (not . semicolonOrNewline) descriptionp = takeWhileP Nothing (not . semicolonOrNewline)
where semicolonOrNewline c = c == ';' || c == '\n' where semicolonOrNewline c = c == ';' || c == '\n'
@ -457,7 +457,7 @@ accountnamep = do
-- | Parse whitespace then an amount, with an optional left or right -- | Parse whitespace then an amount, with an optional left or right
-- currency symbol and optional price, or return the special -- currency symbol and optional price, or return the special
-- "missing" marker amount. -- "missing" marker amount.
spaceandamountormissingp :: Monad m => JournalParser m MixedAmount spaceandamountormissingp :: JournalParser m MixedAmount
spaceandamountormissingp = spaceandamountormissingp =
option missingmixedamt $ try $ do option missingmixedamt $ try $ do
lift $ skipSome spacenonewline lift $ skipSome spacenonewline
@ -480,13 +480,13 @@ test_spaceandamountormissingp = do
-- | Parse a single-commodity amount, with optional symbol on the left or -- | Parse a single-commodity amount, with optional symbol on the left or
-- right, optional unit or total price, and optional (ignored) -- right, optional unit or total price, and optional (ignored)
-- ledger-style balance assertion or fixed lot price declaration. -- ledger-style balance assertion or fixed lot price declaration.
amountp :: Monad m => JournalParser m Amount amountp :: JournalParser m Amount
amountp = do amountp = do
amount <- amountwithoutpricep amount <- amountwithoutpricep
price <- priceamountp price <- priceamountp
pure $ amount { aprice = price } pure $ amount { aprice = price }
amountwithoutpricep :: Monad m => JournalParser m Amount amountwithoutpricep :: JournalParser m Amount
amountwithoutpricep = amountwithoutpricep =
try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp
@ -533,7 +533,7 @@ skipMany' p = go False
then go True then go True
else pure isNull else pure isNull
leftsymbolamountp :: Monad m => JournalParser m Amount leftsymbolamountp :: JournalParser m Amount
leftsymbolamountp = do leftsymbolamountp = do
sign <- lift signp sign <- lift signp
m <- lift multiplierp m <- lift multiplierp
@ -545,7 +545,7 @@ leftsymbolamountp = do
return $ Amount c (sign q) NoPrice s m return $ Amount c (sign q) NoPrice s m
<?> "left-symbol amount" <?> "left-symbol amount"
rightsymbolamountp :: Monad m => JournalParser m Amount rightsymbolamountp :: JournalParser m Amount
rightsymbolamountp = do rightsymbolamountp = do
m <- lift multiplierp m <- lift multiplierp
sign <- lift signp sign <- lift signp
@ -564,7 +564,7 @@ rightsymbolamountp = do
return $ Amount c (sign q) NoPrice s m return $ Amount c (sign q) NoPrice s m
<?> "right-symbol amount" <?> "right-symbol amount"
nosymbolamountp :: Monad m => JournalParser m Amount nosymbolamountp :: JournalParser m Amount
nosymbolamountp = do nosymbolamountp = do
m <- lift multiplierp m <- lift multiplierp
suggestedStyle <- getDefaultAmountStyle suggestedStyle <- getDefaultAmountStyle
@ -589,7 +589,7 @@ quotedcommoditysymbolp =
simplecommoditysymbolp :: TextParser m CommoditySymbol simplecommoditysymbolp :: TextParser m CommoditySymbol
simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar)
priceamountp :: Monad m => JournalParser m Price priceamountp :: JournalParser m Price
priceamountp = option NoPrice $ try $ do priceamountp = option NoPrice $ try $ do
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
char '@' char '@'
@ -600,7 +600,7 @@ priceamountp = option NoPrice $ try $ do
pure $ priceConstructor priceAmount pure $ priceConstructor priceAmount
partialbalanceassertionp :: Monad m => JournalParser m BalanceAssertion partialbalanceassertionp :: JournalParser m BalanceAssertion
partialbalanceassertionp = optional $ try $ do partialbalanceassertionp = optional $ try $ do
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
sourcepos <- genericSourcePos <$> lift getPosition sourcepos <- genericSourcePos <$> lift getPosition
@ -620,7 +620,7 @@ partialbalanceassertionp = optional $ try $ do
-- <|> return Nothing -- <|> return Nothing
-- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices -- http://ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices
fixedlotpricep :: Monad m => JournalParser m (Maybe Amount) fixedlotpricep :: JournalParser m (Maybe Amount)
fixedlotpricep = optional $ try $ do fixedlotpricep = optional $ try $ do
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
char '{' char '{'

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

@ -261,14 +261,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 => JournalParser m () commoditydirectivep :: 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 => JournalParser m () commoditydirectiveonelinep :: JournalParser m ()
commoditydirectiveonelinep = do commoditydirectiveonelinep = do
string "commodity" string "commodity"
lift (skipSome spacenonewline) lift (skipSome spacenonewline)
@ -287,7 +287,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 => JournalParser m () commoditydirectivemultilinep :: JournalParser m ()
commoditydirectivemultilinep = do commoditydirectivemultilinep = do
string "commodity" string "commodity"
lift (skipSome spacenonewline) lift (skipSome spacenonewline)
@ -301,7 +301,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 -> JournalParser m AmountStyle formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle
formatdirectivep expectedsym = do formatdirectivep expectedsym = do
string "format" string "format"
lift (skipSome spacenonewline) lift (skipSome spacenonewline)
@ -398,7 +398,7 @@ defaultyeardirectivep = do
failIfInvalidYear y failIfInvalidYear y
setYear y' setYear y'
defaultcommoditydirectivep :: Monad m => JournalParser m () defaultcommoditydirectivep :: JournalParser m ()
defaultcommoditydirectivep = do defaultcommoditydirectivep = do
char 'D' <?> "default commodity" char 'D' <?> "default commodity"
lift (skipSome spacenonewline) lift (skipSome spacenonewline)
@ -409,7 +409,7 @@ defaultcommoditydirectivep = do
then parseErrorAt pos pleaseincludedecimalpoint then parseErrorAt pos pleaseincludedecimalpoint
else setDefaultCommodityAndStyle (acommodity, astyle) else setDefaultCommodityAndStyle (acommodity, astyle)
marketpricedirectivep :: Monad m => JournalParser m MarketPrice marketpricedirectivep :: JournalParser m MarketPrice
marketpricedirectivep = do marketpricedirectivep = do
char 'P' <?> "market price" char 'P' <?> "market price"
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
@ -429,7 +429,7 @@ ignoredpricecommoditydirectivep = do
lift restofline lift restofline
return () return ()
commodityconversiondirectivep :: Monad m => JournalParser m () commodityconversiondirectivep :: JournalParser m ()
commodityconversiondirectivep = do commodityconversiondirectivep = do
char 'C' <?> "commodity conversion" char 'C' <?> "commodity conversion"
lift (skipSome spacenonewline) lift (skipSome spacenonewline)
@ -443,7 +443,7 @@ commodityconversiondirectivep = do
--- ** transactions --- ** transactions
modifiertransactionp :: MonadIO m => ErroringJournalParser m ModifierTransaction modifiertransactionp :: JournalParser m ModifierTransaction
modifiertransactionp = do modifiertransactionp = do
char '=' <?> "modifier transaction" char '=' <?> "modifier transaction"
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
@ -452,17 +452,17 @@ modifiertransactionp = do
return $ ModifierTransaction valueexpr postings return $ ModifierTransaction valueexpr postings
-- | Parse a periodic transaction -- | Parse a periodic transaction
periodictransactionp :: MonadIO m => ErroringJournalParser m PeriodicTransaction periodictransactionp :: JournalParser m PeriodicTransaction
periodictransactionp = do periodictransactionp = do
char '~' <?> "periodic transaction" char '~' <?> "periodic transaction"
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
periodexpr <- T.strip <$> descriptionp periodexpr <- lift $ T.strip <$> descriptionp
_ <- lift followingcommentp _ <- lift followingcommentp
postings <- postingsp Nothing postings <- postingsp Nothing
return $ PeriodicTransaction periodexpr postings return $ PeriodicTransaction periodexpr postings
-- | Parse a (possibly unbalanced) transaction. -- | Parse a (possibly unbalanced) transaction.
transactionp :: MonadIO m => ErroringJournalParser m Transaction transactionp :: JournalParser m Transaction
transactionp = do transactionp = do
-- ptrace "transactionp" -- ptrace "transactionp"
pos <- getPosition pos <- getPosition
@ -471,7 +471,7 @@ transactionp = do
lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline" lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline"
status <- lift statusp <?> "cleared status" status <- lift statusp <?> "cleared status"
code <- lift codep <?> "transaction code" code <- lift codep <?> "transaction code"
description <- T.strip <$> descriptionp description <- lift $ T.strip <$> descriptionp
(comment, tags) <- lift transactioncommentp (comment, tags) <- lift transactioncommentp
let year = first3 $ toGregorian date let year = first3 $ toGregorian date
postings <- postingsp (Just year) postings <- postingsp (Just year)
@ -576,17 +576,17 @@ test_transactionp = do
-- Parse the following whitespace-beginning lines as postings, posting -- Parse the following whitespace-beginning lines as postings, posting
-- tags, and/or comments (inferring year, if needed, from the given date). -- tags, and/or comments (inferring year, if needed, from the given date).
postingsp :: MonadIO m => Maybe Year -> ErroringJournalParser m [Posting] postingsp :: Maybe Year -> JournalParser m [Posting]
postingsp mTransactionYear = many (postingp mTransactionYear) <?> "postings" postingsp mTransactionYear = many (postingp mTransactionYear) <?> "postings"
-- linebeginningwithspaces :: Monad m => JournalParser m String -- linebeginningwithspaces :: JournalParser m String
-- linebeginningwithspaces = do -- linebeginningwithspaces = do
-- sp <- lift (skipSome spacenonewline) -- sp <- lift (skipSome spacenonewline)
-- c <- nonspace -- c <- nonspace
-- cs <- lift restofline -- cs <- lift restofline
-- return $ sp ++ (c:cs) ++ "\n" -- return $ sp ++ (c:cs) ++ "\n"
postingp :: MonadIO m => Maybe Year -> ErroringJournalParser m Posting postingp :: Maybe Year -> JournalParser m Posting
postingp mTransactionYear = do postingp mTransactionYear = do
-- pdbg 0 "postingp" -- pdbg 0 "postingp"
(status, account) <- try $ do (status, account) <- try $ do