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:
parent
10f8dc84a5
commit
ea3b290dd0
@ -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.
|
||||||
|
|||||||
@ -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"
|
||||||
]
|
]
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user