lib!: lib: Remove aismultiplier from Amount.

In Amount, aismultiplier is a boolean flag that will always be False,
except for in TMPostingRules, where it indicates whether the posting
rule is a multiplier. It is therefore unnecessary in the vast majority
of cases. This posting pulls this flag out of Amount and puts it into
TMPostingRule, so it is only kept around when necessary.

This changes the parsing of journals somewhat. Previously you could
include an * before an amount anywhere in a Journal, and it would
happily parse and set the aismultiplier flag true. This will now fail
with a parse error: * is now only acceptable before an amount within an
auto posting rule.

Any usage of the library in which the aismultiplier field is read or set
should be removed. If you truly need its functionality, you should
switch to using TMPostingRule.

This changes the JSON output of Amount, as it will no longer include
aismultiplier.
This commit is contained in:
Stephen Morgan 2021-07-02 22:54:49 +10:00 committed by Simon Michael
parent 3969eb2679
commit 7ed2a0aa9b
12 changed files with 95 additions and 70 deletions

View File

@ -218,7 +218,7 @@ instance Num Amount where
-- | The empty simple amount.
amount, nullamt :: Amount
amount = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle, aismultiplier=False}
amount = Amount{acommodity="", aquantity=0, aprice=Nothing, astyle=amountstyle}
nullamt = amount
-- | A temporary value for parsed transactions which had no amount specified.

View File

@ -827,7 +827,7 @@ journalBalanceTransactions bopts' j' =
styles = Just $ journalCommodityStyles j
bopts = bopts'{commodity_styles_=styles}
-- balance assignments will not be allowed on these
txnmodifieraccts = S.fromList $ map paccount $ concatMap tmpostingrules $ jtxnmodifiers j
txnmodifieraccts = S.fromList . map (paccount . tmprPosting) . concatMap tmpostingrules $ jtxnmodifiers j
in
runST $ do
-- We'll update a mutable array of transactions as we balance them,

View File

@ -136,6 +136,7 @@ postingKV Posting{..} =
instance ToJSON Transaction
instance ToJSON TransactionModifier
instance ToJSON TMPostingRule
instance ToJSON PeriodicTransaction
instance ToJSON PriceDirective
instance ToJSON DateSpan

View File

@ -60,17 +60,18 @@ modifyTransactions d tmods ts = do
--
-- >>> import qualified Data.Text.IO as T
-- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}
-- >>> tmpost acc amt = TMPostingRule (acc `post` amt) False
-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate
-- >>> test $ TransactionModifier "" ["pong" `post` usd 2]
-- >>> test $ TransactionModifier "" ["pong" `tmpost` usd 2]
-- 0000-01-01
-- ping $1.00
-- pong $2.00 ; generated-posting: =
-- <BLANKLINE>
-- >>> test $ TransactionModifier "miss" ["pong" `post` usd 2]
-- >>> test $ TransactionModifier "miss" ["pong" `tmpost` usd 2]
-- 0000-01-01
-- ping $1.00
-- <BLANKLINE>
-- >>> test $ TransactionModifier "ping" ["pong" `post` amount{aismultiplier=True, aquantity=3}]
-- >>> test $ TransactionModifier "ping" [("pong" `tmpost` amount{aquantity=3}){tmprIsMultiplier=True}]
-- 0000-01-01
-- ping $1.00
-- pong $3.00 ; generated-posting: = ping
@ -93,7 +94,7 @@ transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingr
-- The TransactionModifier's query text is also provided, and saved
-- as the tags' value.
tmPostingRuleToFunction :: Query -> T.Text -> TMPostingRule -> (Posting -> Posting)
tmPostingRuleToFunction query querytxt pr =
tmPostingRuleToFunction query querytxt tmpr =
\p -> renderPostingCommentDates $ pr
{ pdate = pdate pr <|> pdate p
, pdate2 = pdate2 pr <|> pdate2 p
@ -104,9 +105,10 @@ tmPostingRuleToFunction query querytxt pr =
ptags pr
}
where
pr = tmprPosting tmpr
qry = "= " <> querytxt
symq = filterQuery (liftA2 (||) queryIsSym queryIsAmt) query
amount' = case postingRuleMultiplier pr of
amount' = case postingRuleMultiplier tmpr of
Nothing -> const $ pamount pr
Just n -> \p ->
-- Multiply the old posting's amount by the posting rule's multiplier.
@ -127,9 +129,9 @@ tmPostingRuleToFunction query querytxt pr =
c -> mapMixedAmount (\a -> a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount}) as
postingRuleMultiplier :: TMPostingRule -> Maybe Quantity
postingRuleMultiplier p = case amountsRaw $ pamount p of
[a] | aismultiplier a -> Just $ aquantity a
_ -> Nothing
postingRuleMultiplier tmpr = case amountsRaw . pamount $ tmprPosting tmpr of
[a] | tmprIsMultiplier tmpr -> Just $ aquantity a
_ -> Nothing
renderPostingCommentDates :: Posting -> Posting
renderPostingCommentDates p = p { pcomment = comment' }

View File

@ -224,8 +224,6 @@ data Commodity = Commodity {
data Amount = Amount {
acommodity :: !CommoditySymbol, -- commodity symbol, or special value "AUTO"
aquantity :: !Quantity, -- numeric quantity, or zero in case of "AUTO"
aismultiplier :: !Bool, -- ^ kludge: a flag marking this amount and posting as a multiplier
-- in a TMPostingRule. In a regular Posting, should always be false.
astyle :: !AmountStyle,
aprice :: !(Maybe AmountPrice) -- ^ the (fixed, transaction-specific) price for this amount, if any
} deriving (Eq,Ord,Generic,Show)
@ -429,7 +427,10 @@ nulltransactionmodifier = TransactionModifier{
-- to the matched posting's transaction.
-- Can be like a regular posting, or the amount can have the aismultiplier flag set,
-- indicating that it's a multiplier for the matched posting's amount.
type TMPostingRule = Posting
data TMPostingRule = TMPostingRule
{ tmprPosting :: Posting
, tmprIsMultiplier :: Bool
} deriving (Eq,Generic,Show)
-- | A periodic transaction rule, describing a transaction that recurs.
data PeriodicTransaction = PeriodicTransaction {

View File

@ -32,7 +32,7 @@ module Hledger.Read (
readJournal',
-- * Re-exported
JournalReader.postingp,
JournalReader.tmpostingrulep,
findReader,
splitReaderPrefix,
module Hledger.Read.Common,

View File

@ -86,6 +86,7 @@ module Hledger.Read.Common (
amountp,
amountp',
mamountp',
amountpwithmultiplier,
commoditysymbolp,
priceamountp,
balanceassertionp,
@ -768,10 +769,12 @@ spaceandamountormissingp =
-- files with any supported decimal mark, but it also allows different decimal marks
-- in different amounts, which is a bit too loose. There's an open issue.
amountp :: JournalParser m Amount
amountp = label "amount" $ do
let
spaces = lift $ skipNonNewlineSpaces
amount <- amountwithoutpricep <* spaces
amountp = amountpwithmultiplier False
amountpwithmultiplier :: Bool -> JournalParser m Amount
amountpwithmultiplier mult = label "amount" $ do
let spaces = lift $ skipNonNewlineSpaces
amount <- amountwithoutpricep mult <* spaces
(mprice, _elotprice, _elotdate) <- runPermutation $
(,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp amount <* spaces)
<*> toPermutationWithDefault Nothing (Just <$> lotpricep <* spaces)
@ -781,20 +784,20 @@ amountp = label "amount" $ do
amountpnolotpricesp :: JournalParser m Amount
amountpnolotpricesp = label "amount" $ do
let spaces = lift $ skipNonNewlineSpaces
amount <- amountwithoutpricep
amount <- amountwithoutpricep False
spaces
mprice <- optional $ priceamountp amount <* spaces
pure $ amount { aprice = mprice }
amountwithoutpricep :: JournalParser m Amount
amountwithoutpricep = do
(mult, sign) <- lift $ (,) <$> multiplierp <*> signp
leftsymbolamountp mult sign <|> rightornosymbolamountp mult sign
amountwithoutpricep :: Bool -> JournalParser m Amount
amountwithoutpricep mult = do
sign <- lift signp
leftsymbolamountp sign <|> rightornosymbolamountp sign
where
leftsymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount
leftsymbolamountp mult sign = label "amount" $ do
leftsymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount
leftsymbolamountp sign = label "amount" $ do
c <- lift commoditysymbolp
mdecmarkStyle <- getDecimalMarkStyle
mcommodityStyle <- getAmountStyle c
@ -809,10 +812,10 @@ amountwithoutpricep = do
let numRegion = (offBeforeNum, offAfterNum)
(q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent
let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
return $ nullamt{acommodity=c, aquantity=sign (sign2 q), aismultiplier=mult, astyle=s, aprice=Nothing}
return nullamt{acommodity=c, aquantity=sign (sign2 q), astyle=s, aprice=Nothing}
rightornosymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount
rightornosymbolamountp mult sign = label "amount" $ do
rightornosymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount
rightornosymbolamountp sign = label "amount" $ do
offBeforeNum <- getOffset
ambiguousRawNum <- lift rawnumberp
mExponent <- lift $ optional $ try exponentp
@ -828,7 +831,7 @@ amountwithoutpricep = do
let msuggestedStyle = mdecmarkStyle <|> mcommodityStyle
(q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion msuggestedStyle ambiguousRawNum mExponent
let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}
return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=Nothing}
return nullamt{acommodity=c, aquantity=sign q, astyle=s, aprice=Nothing}
-- no symbol amount
Nothing -> do
-- look for a number style to use when parsing, based on
@ -845,7 +848,7 @@ amountwithoutpricep = do
let (c,s) = case (mult, defcs) of
(False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec})
_ -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps})
return $ nullamt{acommodity=c, aquantity=sign q, aismultiplier=mult, astyle=s, aprice=Nothing}
return nullamt{acommodity=c, aquantity=sign q, astyle=s, aprice=Nothing}
-- For reducing code duplication. Doesn't parse anything. Has the type
-- of a parser only in order to throw parse errors (for convenience).
@ -878,9 +881,6 @@ mamountp' = mixedAmount . amountp'
signp :: Num a => TextParser m (a -> a)
signp = ((char '-' *> pure negate <|> char '+' *> pure id) <* skipNonNewlineSpaces) <|> pure id
multiplierp :: TextParser m Bool
multiplierp = option False $ char '*' *> pure True
commoditysymbolp :: TextParser m CommoditySymbol
commoditysymbolp =
quotedcommoditysymbolp <|> simplecommoditysymbolp <?> "commodity symbol"
@ -902,7 +902,7 @@ priceamountp baseAmt = label "transaction price" $ do
when parenthesised $ void $ char ')'
lift skipNonNewlineSpaces
priceAmount <- amountwithoutpricep -- <?> "unpriced amount (specifying a price)"
priceAmount <- amountwithoutpricep False -- <?> "unpriced amount (specifying a price)"
let amtsign' = signum $ aquantity baseAmt
amtsign = if amtsign' == 0 then 1 else amtsign'
@ -939,7 +939,7 @@ lotpricep = label "ledger-style lot price" $ do
doublebrace <- option False $ char '{' >> pure True
_fixed <- fmap isJust $ optional $ lift skipNonNewlineSpaces >> char '='
lift skipNonNewlineSpaces
_a <- amountwithoutpricep
_a <- amountwithoutpricep False
lift skipNonNewlineSpaces
char '}'
when (doublebrace) $ void $ char '}'

View File

@ -58,7 +58,7 @@ module Hledger.Read.JournalReader (
datetimep,
datep,
modifiedaccountnamep,
postingp,
tmpostingrulep,
statusp,
emptyorcommentlinep,
followingcommentp,
@ -592,8 +592,8 @@ transactionmodifierp = do
lift skipNonNewlineSpaces
querytxt <- lift $ T.strip <$> descriptionp
(_comment, _tags) <- lift transactioncommentp -- TODO apply these to modified txns ?
postings <- postingsp Nothing
return $ TransactionModifier querytxt postings
postingrules <- tmpostingrulesp Nothing
return $ TransactionModifier querytxt postingrules
-- | Parse a periodic transaction rule.
--
@ -695,32 +695,49 @@ postingsp mTransactionYear = many (postingp mTransactionYear) <?> "postings"
-- return $ sp ++ (c:cs) ++ "\n"
postingp :: Maybe Year -> JournalParser m Posting
postingp mTransactionYear = do
-- lift $ dbgparse 0 "postingp"
(status, account) <- try $ do
lift skipNonNewlineSpaces1
status <- lift statusp
postingp = fmap fst . postingphelper False
-- Parse the following whitespace-beginning lines as transaction posting rules, posting
-- tags, and/or comments (inferring year, if needed, from the given date).
tmpostingrulesp :: Maybe Year -> JournalParser m [TMPostingRule]
tmpostingrulesp mTransactionYear = many (tmpostingrulep mTransactionYear) <?> "posting rules"
tmpostingrulep :: Maybe Year -> JournalParser m TMPostingRule
tmpostingrulep = fmap (uncurry TMPostingRule) . postingphelper True
-- Parse a Posting, and return a flag with whether a multiplier has been detected.
-- The multiplier is used in TMPostingRules.
postingphelper :: Bool -> Maybe Year -> JournalParser m (Posting, Bool)
postingphelper isPostingRule mTransactionYear = do
-- lift $ dbgparse 0 "postingp"
(status, account) <- try $ do
lift skipNonNewlineSpaces1
status <- lift statusp
lift skipNonNewlineSpaces
account <- modifiedaccountnamep
return (status, account)
let (ptype, account') = (accountNamePostingType account, textUnbracket account)
lift skipNonNewlineSpaces
account <- modifiedaccountnamep
return (status, account)
let (ptype, account') = (accountNamePostingType account, textUnbracket account)
lift skipNonNewlineSpaces
amount <- optional amountp
lift skipNonNewlineSpaces
massertion <- optional balanceassertionp
lift skipNonNewlineSpaces
(comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear
return posting
{ pdate=mdate
, pdate2=mdate2
, pstatus=status
, paccount=account'
, pamount=maybe missingmixedamt mixedAmount amount
, pcomment=comment
, ptype=ptype
, ptags=tags
, pbalanceassertion=massertion
}
mult <- if isPostingRule then multiplierp else pure False
amount <- optional $ amountpwithmultiplier mult
lift skipNonNewlineSpaces
massertion <- optional balanceassertionp
lift skipNonNewlineSpaces
(comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear
let p = posting
{ pdate=mdate
, pdate2=mdate2
, pstatus=status
, paccount=account'
, pamount=maybe missingmixedamt mixedAmount amount
, pcomment=comment
, ptype=ptype
, ptags=tags
, pbalanceassertion=massertion
}
return (p, mult)
where
multiplierp = option False $ True <$ char '*'
--- ** tests
@ -866,7 +883,7 @@ tests_JournalReader = tests "JournalReader" [
"= (some value expr)\n some:postings 1.\n"
nulltransactionmodifier {
tmquerytxt = "(some value expr)"
,tmpostingrules = [nullposting{paccount="some:postings", pamount=mixedAmount (num 1)}]
,tmpostingrules = [TMPostingRule nullposting{paccount="some:postings", pamount=mixedAmount (num 1)} False]
}
]

View File

@ -559,7 +559,7 @@ cumulativeSum value start = snd . M.mapAccumWithKey accumValued start
tests_MultiBalanceReport = tests "MultiBalanceReport" [
let
amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}
amt0 = Amount {acommodity="$", aquantity=0, aprice=Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = Precision 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}}
(rspec,journal) `gives` r = do
let rspec' = rspec{rsQuery=And [queryFromFlags $ rsOpts rspec, rsQuery rspec]}
(eitems, etotal) = r

View File

@ -55,7 +55,7 @@ transactionModifierFromOpts CliOpts{rawopts_=rawopts} =
ps = map (parseposting . T.pack) $ listofstringopt "add-posting" rawopts
parseposting t = either (error' . errorBundlePretty) id ep -- PARTIAL:
where
ep = runIdentity (runJournalParser (postingp Nothing <* eof) t')
ep = runIdentity (runJournalParser (tmpostingrulep Nothing <* eof) t')
t' = " " <> t <> "\n" -- inject space and newline for proper parsing
printOrDiff :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ())

View File

@ -155,3 +155,11 @@ $ hledger -f- print
equity:opening/closing balances
>=0
# 13. Adding a multiplier in a normal posting gives a parse error.
<
2020-01-01
(a) *1
$ hledger -f- print
>2 /unexpected '\*'/
>=1

View File

@ -14,7 +14,6 @@ $ hledger -f- reg --output-format=json
"pamount": [
{
"acommodity": "AAA",
"aismultiplier": false,
"aprice": null,
"aquantity": {
"decimalMantissa": 10,
@ -43,7 +42,6 @@ $ hledger -f- reg --output-format=json
[
{
"acommodity": "AAA",
"aismultiplier": false,
"aprice": null,
"aquantity": {
"decimalMantissa": 10,
@ -73,7 +71,6 @@ $ hledger -f- bal --output-format=json
[
{
"acommodity": "AAA",
"aismultiplier": false,
"aprice": null,
"aquantity": {
"decimalMantissa": 10,
@ -94,7 +91,6 @@ $ hledger -f- bal --output-format=json
[
{
"acommodity": "AAA",
"aismultiplier": false,
"aprice": null,
"aquantity": {
"decimalMantissa": 10,