From 7ed2a0aa9b3c2863f7a1d5df7da7d0404f0edc54 Mon Sep 17 00:00:00 2001 From: Stephen Morgan Date: Fri, 2 Jul 2021 22:54:49 +1000 Subject: [PATCH] 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. --- hledger-lib/Hledger/Data/Amount.hs | 2 +- hledger-lib/Hledger/Data/Journal.hs | 2 +- hledger-lib/Hledger/Data/Json.hs | 1 + .../Hledger/Data/TransactionModifier.hs | 18 +++-- hledger-lib/Hledger/Data/Types.hs | 7 +- hledger-lib/Hledger/Read.hs | 2 +- hledger-lib/Hledger/Read/Common.hs | 42 +++++------ hledger-lib/Hledger/Read/JournalReader.hs | 75 ++++++++++++------- .../Hledger/Reports/MultiBalanceReport.hs | 2 +- hledger/Hledger/Cli/Commands/Rewrite.hs | 2 +- hledger/test/journal/parse-errors.test | 8 ++ hledger/test/json.test | 4 - 12 files changed, 95 insertions(+), 70 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index afdb7ee13..fd462aa48 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -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. diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 37fc1b3e9..beb1e80bc 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -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, diff --git a/hledger-lib/Hledger/Data/Json.hs b/hledger-lib/Hledger/Data/Json.hs index ea5ce68b0..8b34e0dbc 100644 --- a/hledger-lib/Hledger/Data/Json.hs +++ b/hledger-lib/Hledger/Data/Json.hs @@ -136,6 +136,7 @@ postingKV Posting{..} = instance ToJSON Transaction instance ToJSON TransactionModifier +instance ToJSON TMPostingRule instance ToJSON PeriodicTransaction instance ToJSON PriceDirective instance ToJSON DateSpan diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 01d6ec2c5..b4c2b06ff 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -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: = -- --- >>> test $ TransactionModifier "miss" ["pong" `post` usd 2] +-- >>> test $ TransactionModifier "miss" ["pong" `tmpost` usd 2] -- 0000-01-01 -- ping $1.00 -- --- >>> 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' } diff --git a/hledger-lib/Hledger/Data/Types.hs b/hledger-lib/Hledger/Data/Types.hs index 44fa14767..cc25934d1 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -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 { diff --git a/hledger-lib/Hledger/Read.hs b/hledger-lib/Hledger/Read.hs index 215f21bfc..aa5d199ad 100644 --- a/hledger-lib/Hledger/Read.hs +++ b/hledger-lib/Hledger/Read.hs @@ -32,7 +32,7 @@ module Hledger.Read ( readJournal', -- * Re-exported - JournalReader.postingp, + JournalReader.tmpostingrulep, findReader, splitReaderPrefix, module Hledger.Read.Common, diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index 3b106c926..33f575478 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -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 '}' diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 41ea90232..ed80fb298 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -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] } ] diff --git a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs index ba0329005..4f4690fe2 100644 --- a/hledger-lib/Hledger/Reports/MultiBalanceReport.hs +++ b/hledger-lib/Hledger/Reports/MultiBalanceReport.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index 9c2467364..92b7dfa60 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -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 ()) diff --git a/hledger/test/journal/parse-errors.test b/hledger/test/journal/parse-errors.test index f210edf08..52c2a680a 100644 --- a/hledger/test/journal/parse-errors.test +++ b/hledger/test/journal/parse-errors.test @@ -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 diff --git a/hledger/test/json.test b/hledger/test/json.test index 925221e26..5c699ea34 100644 --- a/hledger/test/json.test +++ b/hledger/test/json.test @@ -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,