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
between (char '(') (char ')') $ takeWhileP Nothing (/= ')')
descriptionp :: JournalParser m Text
descriptionp :: TextParser m Text
descriptionp = takeWhileP Nothing (not . semicolonOrNewline)
where semicolonOrNewline c = c == ';' || c == '\n'
@ -457,7 +457,7 @@ accountnamep = do
-- | Parse whitespace then an amount, with an optional left or right
-- currency symbol and optional price, or return the special
-- "missing" marker amount.
spaceandamountormissingp :: Monad m => JournalParser m MixedAmount
spaceandamountormissingp :: JournalParser m MixedAmount
spaceandamountormissingp =
option missingmixedamt $ try $ do
lift $ skipSome spacenonewline
@ -480,13 +480,13 @@ test_spaceandamountormissingp = do
-- | Parse a single-commodity amount, with optional symbol on the left or
-- right, optional unit or total price, and optional (ignored)
-- ledger-style balance assertion or fixed lot price declaration.
amountp :: Monad m => JournalParser m Amount
amountp :: JournalParser m Amount
amountp = do
amount <- amountwithoutpricep
price <- priceamountp
pure $ amount { aprice = price }
amountwithoutpricep :: Monad m => JournalParser m Amount
amountwithoutpricep :: JournalParser m Amount
amountwithoutpricep =
try leftsymbolamountp <|> try rightsymbolamountp <|> nosymbolamountp
@ -533,7 +533,7 @@ skipMany' p = go False
then go True
else pure isNull
leftsymbolamountp :: Monad m => JournalParser m Amount
leftsymbolamountp :: JournalParser m Amount
leftsymbolamountp = do
sign <- lift signp
m <- lift multiplierp
@ -545,7 +545,7 @@ leftsymbolamountp = do
return $ Amount c (sign q) NoPrice s m
<?> "left-symbol amount"
rightsymbolamountp :: Monad m => JournalParser m Amount
rightsymbolamountp :: JournalParser m Amount
rightsymbolamountp = do
m <- lift multiplierp
sign <- lift signp
@ -564,7 +564,7 @@ rightsymbolamountp = do
return $ Amount c (sign q) NoPrice s m
<?> "right-symbol amount"
nosymbolamountp :: Monad m => JournalParser m Amount
nosymbolamountp :: JournalParser m Amount
nosymbolamountp = do
m <- lift multiplierp
suggestedStyle <- getDefaultAmountStyle
@ -589,7 +589,7 @@ quotedcommoditysymbolp =
simplecommoditysymbolp :: TextParser m CommoditySymbol
simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar)
priceamountp :: Monad m => JournalParser m Price
priceamountp :: JournalParser m Price
priceamountp = option NoPrice $ try $ do
lift (skipMany spacenonewline)
char '@'
@ -600,7 +600,7 @@ priceamountp = option NoPrice $ try $ do
pure $ priceConstructor priceAmount
partialbalanceassertionp :: Monad m => JournalParser m BalanceAssertion
partialbalanceassertionp :: JournalParser m BalanceAssertion
partialbalanceassertionp = optional $ try $ do
lift (skipMany spacenonewline)
sourcepos <- genericSourcePos <$> lift getPosition
@ -620,7 +620,7 @@ partialbalanceassertionp = optional $ try $ do
-- <|> return Nothing
-- 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
lift (skipMany spacenonewline)
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\n" -- a commodity with no format
-- >>> 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
-- | Parse a one-line commodity directive.
--
-- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00"
-- >>> Right _ <- rejp commoditydirectiveonelinep "commodity $1.00 ; blah\n"
commoditydirectiveonelinep :: Monad m => JournalParser m ()
commoditydirectiveonelinep :: JournalParser m ()
commoditydirectiveonelinep = do
string "commodity"
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.
--
-- >>> Right _ <- rejp commoditydirectivemultilinep "commodity $ ; blah \n format $1.00 ; blah"
commoditydirectivemultilinep :: Monad m => JournalParser m ()
commoditydirectivemultilinep :: JournalParser m ()
commoditydirectivemultilinep = do
string "commodity"
lift (skipSome spacenonewline)
@ -301,7 +301,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 -> JournalParser m AmountStyle
formatdirectivep :: CommoditySymbol -> JournalParser m AmountStyle
formatdirectivep expectedsym = do
string "format"
lift (skipSome spacenonewline)
@ -398,7 +398,7 @@ defaultyeardirectivep = do
failIfInvalidYear y
setYear y'
defaultcommoditydirectivep :: Monad m => JournalParser m ()
defaultcommoditydirectivep :: JournalParser m ()
defaultcommoditydirectivep = do
char 'D' <?> "default commodity"
lift (skipSome spacenonewline)
@ -409,7 +409,7 @@ defaultcommoditydirectivep = do
then parseErrorAt pos pleaseincludedecimalpoint
else setDefaultCommodityAndStyle (acommodity, astyle)
marketpricedirectivep :: Monad m => JournalParser m MarketPrice
marketpricedirectivep :: JournalParser m MarketPrice
marketpricedirectivep = do
char 'P' <?> "market price"
lift (skipMany spacenonewline)
@ -429,7 +429,7 @@ ignoredpricecommoditydirectivep = do
lift restofline
return ()
commodityconversiondirectivep :: Monad m => JournalParser m ()
commodityconversiondirectivep :: JournalParser m ()
commodityconversiondirectivep = do
char 'C' <?> "commodity conversion"
lift (skipSome spacenonewline)
@ -443,7 +443,7 @@ commodityconversiondirectivep = do
--- ** transactions
modifiertransactionp :: MonadIO m => ErroringJournalParser m ModifierTransaction
modifiertransactionp :: JournalParser m ModifierTransaction
modifiertransactionp = do
char '=' <?> "modifier transaction"
lift (skipMany spacenonewline)
@ -452,17 +452,17 @@ modifiertransactionp = do
return $ ModifierTransaction valueexpr postings
-- | Parse a periodic transaction
periodictransactionp :: MonadIO m => ErroringJournalParser m PeriodicTransaction
periodictransactionp :: JournalParser m PeriodicTransaction
periodictransactionp = do
char '~' <?> "periodic transaction"
lift (skipMany spacenonewline)
periodexpr <- T.strip <$> descriptionp
periodexpr <- lift $ T.strip <$> descriptionp
_ <- lift followingcommentp
postings <- postingsp Nothing
return $ PeriodicTransaction periodexpr postings
-- | Parse a (possibly unbalanced) transaction.
transactionp :: MonadIO m => ErroringJournalParser m Transaction
transactionp :: JournalParser m Transaction
transactionp = do
-- ptrace "transactionp"
pos <- getPosition
@ -471,7 +471,7 @@ transactionp = do
lookAhead (lift spacenonewline <|> newline) <?> "whitespace or newline"
status <- lift statusp <?> "cleared status"
code <- lift codep <?> "transaction code"
description <- T.strip <$> descriptionp
description <- lift $ T.strip <$> descriptionp
(comment, tags) <- lift transactioncommentp
let year = first3 $ toGregorian date
postings <- postingsp (Just year)
@ -576,17 +576,17 @@ test_transactionp = do
-- Parse the following whitespace-beginning lines as postings, posting
-- 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"
-- linebeginningwithspaces :: Monad m => JournalParser m String
-- linebeginningwithspaces :: JournalParser m String
-- linebeginningwithspaces = do
-- sp <- lift (skipSome spacenonewline)
-- c <- nonspace
-- cs <- lift restofline
-- return $ sp ++ (c:cs) ++ "\n"
postingp :: MonadIO m => Maybe Year -> ErroringJournalParser m Posting
postingp :: Maybe Year -> JournalParser m Posting
postingp mTransactionYear = do
-- pdbg 0 "postingp"
(status, account) <- try $ do