journal: more flexible, Ledger-compatible parsing of lot prices

We now accept (but still ignore) a fixed or nonfixed ({=} or {}) lot
price following a posting amount, and it may appear before or after a
transaction price (@ or @@). And it may no longer appear after a
balance assertion.

Also: fixedlotpricep renamed to lotpricep, now also parses non-fixed
lot prices. A bit of amount parsers cleanup.
This commit is contained in:
Simon Michael 2020-04-08 15:26:18 -07:00
parent 10f8dc84a5
commit ea3b290dd0
2 changed files with 38 additions and 26 deletions

View File

@ -84,7 +84,7 @@ module Hledger.Read.Common (
commoditysymbolp, commoditysymbolp,
priceamountp, priceamountp,
balanceassertionp, balanceassertionp,
fixedlotpricep, lotpricep,
numberp, numberp,
fromRawNumber, fromRawNumber,
rawnumberp, rawnumberp,
@ -603,14 +603,27 @@ spaceandamountormissingp =
lift $ skipSome spacenonewline lift $ skipSome spacenonewline
Mixed . (:[]) <$> amountp Mixed . (:[]) <$> amountp
-- | Parse a single-commodity amount, with optional symbol on the left or -- | Parse a single-commodity amount, with optional symbol on the left
-- right, optional unit or total price, and optional (ignored) -- or right, followed by an optional transaction price (@ or @@), and
-- ledger-style balance assertion or fixed lot price declaration. -- an optional ledger-style lot price ({} or {=}). The lot price will
-- be ignored, and may appear before or after the transaction price.
amountp :: JournalParser m Amount amountp :: JournalParser m Amount
amountp = label "amount" $ do amountp = label "amount" $ do
let spaces = lift $ skipMany spacenonewline
amount <- amountwithoutpricep amount <- amountwithoutpricep
lift $ skipMany spacenonewline spaces
mprice <- priceamountp _elotprice <- optional $ lotpricep <* spaces
mprice <- optional $ priceamountp <* spaces
_elotprice <- optional $ lotpricep
pure $ amount { aprice = mprice }
-- XXX Just like amountp but don't allow lot prices. Needed for balanceassertionp.
amountpnolotprices :: JournalParser m Amount
amountpnolotprices = label "amount" $ do
let spaces = lift $ skipMany spacenonewline
amount <- amountwithoutpricep
spaces
mprice <- optional $ priceamountp <* spaces
pure $ amount { aprice = mprice } pure $ amount { aprice = mprice }
amountwithoutpricep :: JournalParser m Amount amountwithoutpricep :: JournalParser m Amount
@ -720,15 +733,16 @@ quotedcommoditysymbolp =
simplecommoditysymbolp :: TextParser m CommoditySymbol simplecommoditysymbolp :: TextParser m CommoditySymbol
simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar) simplecommoditysymbolp = takeWhile1P Nothing (not . isNonsimpleCommodityChar)
priceamountp :: JournalParser m (Maybe AmountPrice) priceamountp :: JournalParser m AmountPrice
priceamountp = option Nothing $ do priceamountp = (do
char '@' char '@'
priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice priceConstructor <- char '@' *> pure TotalPrice <|> pure UnitPrice
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
priceAmount <- amountwithoutpricep <?> "unpriced amount (specifying a price)" priceAmount <- amountwithoutpricep -- <?> "unpriced amount (specifying a price)"
pure $ Just $ priceConstructor priceAmount pure $ priceConstructor priceAmount
) <?> "price amount"
balanceassertionp :: JournalParser m BalanceAssertion balanceassertionp :: JournalParser m BalanceAssertion
balanceassertionp = do balanceassertionp = do
@ -739,7 +753,7 @@ balanceassertionp = do
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
-- this amount can have a price; balance assertions ignore it, -- this amount can have a price; balance assertions ignore it,
-- but balance assignments will use it -- but balance assignments will use it
a <- amountp <?> "amount (for a balance assertion or assignment)" a <- amountpnolotprices <?> "amount (for a balance assertion or assignment)"
return BalanceAssertion return BalanceAssertion
{ baamount = a { baamount = a
, batotal = istotal , batotal = istotal
@ -747,22 +761,19 @@ balanceassertionp = do
, baposition = sourcepos , baposition = sourcepos
} }
-- Parse a Ledger-style fixed lot price: {=PRICE} -- Parse a Ledger-style fixed {=PRICE} or non-fixed {PRICE} lot price,
-- as a Left or Right Amount respectively.
-- https://www.ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices . -- https://www.ledger-cli.org/3.0/doc/ledger3.html#Fixing-Lot-Prices .
-- Currently we ignore these (hledger's @ PRICE is equivalent), lotpricep :: JournalParser m (Either Amount Amount)
-- and we don't parse a Ledger-style {PRICE} (equivalent to Ledger's @ PRICE). lotpricep = (do
fixedlotpricep :: JournalParser m (Maybe Amount) char '{'
fixedlotpricep = optional $ do fixed <- fmap isJust $ optional $ lift (skipMany spacenonewline) >> char '='
try $ do
lift (skipMany spacenonewline)
char '{'
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
char '=' a <- amountwithoutpricep
lift (skipMany spacenonewline)
a <- amountwithoutpricep <?> "unpriced amount (for an ignored ledger-style fixed lot price)"
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
char '}' char '}'
return a return $ (if fixed then Left else Right) a
) <?> "ledger-style lot price or fixed lot price"
-- | Parse a string representation of a number for its value and display -- | Parse a string representation of a number for its value and display
-- attributes. -- attributes.

View File

@ -716,8 +716,7 @@ postingp mTransactionYear = do
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp amount <- option missingmixedamt $ Mixed . (:[]) <$> amountp
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
massertion <- optional $ balanceassertionp massertion <- optional balanceassertionp
_ <- fixedlotpricep
lift (skipMany spacenonewline) lift (skipMany spacenonewline)
(comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear (comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear
return posting return posting
@ -856,7 +855,9 @@ tests_JournalReader = tests "JournalReader" [
,test "quoted commodity symbol with digits" $ assertParse (postingp Nothing) " a 1 \"DE123\"\n" ,test "quoted commodity symbol with digits" $ assertParse (postingp Nothing) " a 1 \"DE123\"\n"
,test "balance assertion and fixed lot price" $ assertParse (postingp Nothing) " a 1 \"DE123\" =$1 { =2.2 EUR} \n" ,test "lot price before transaction price" $ assertParse (postingp Nothing) " a 1A {1B} @ 1B\n"
,test "lot price after transaction price" $ assertParse (postingp Nothing) " a 1A @ 1B {1B}\n"
,test "lot price after balance assertion not allowed" $ assertParseError (postingp Nothing) " a 1A @ 1B = 1A {1B}\n" "unexpected '{'"
,test "balance assertion over entire contents of account" $ assertParse (postingp Nothing) " a $1 == $1\n" ,test "balance assertion over entire contents of account" $ assertParse (postingp Nothing) " a $1 == $1\n"
] ]