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:
		
							parent
							
								
									3969eb2679
								
							
						
					
					
						commit
						7ed2a0aa9b
					
				| @ -218,7 +218,7 @@ instance Num Amount where | |||||||
| 
 | 
 | ||||||
| -- | The empty simple amount. | -- | The empty simple amount. | ||||||
| amount, nullamt :: 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 | nullamt = amount | ||||||
| 
 | 
 | ||||||
| -- | A temporary value for parsed transactions which had no amount specified. | -- | A temporary value for parsed transactions which had no amount specified. | ||||||
|  | |||||||
| @ -827,7 +827,7 @@ journalBalanceTransactions bopts' j' = | |||||||
|     styles = Just $ journalCommodityStyles j |     styles = Just $ journalCommodityStyles j | ||||||
|     bopts = bopts'{commodity_styles_=styles} |     bopts = bopts'{commodity_styles_=styles} | ||||||
|     -- balance assignments will not be allowed on these |     -- 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 |   in | ||||||
|     runST $ do |     runST $ do | ||||||
|       -- We'll update a mutable array of transactions as we balance them, |       -- We'll update a mutable array of transactions as we balance them, | ||||||
|  | |||||||
| @ -136,6 +136,7 @@ postingKV Posting{..} = | |||||||
| 
 | 
 | ||||||
| instance ToJSON Transaction | instance ToJSON Transaction | ||||||
| instance ToJSON TransactionModifier | instance ToJSON TransactionModifier | ||||||
|  | instance ToJSON TMPostingRule | ||||||
| instance ToJSON PeriodicTransaction | instance ToJSON PeriodicTransaction | ||||||
| instance ToJSON PriceDirective | instance ToJSON PriceDirective | ||||||
| instance ToJSON DateSpan | instance ToJSON DateSpan | ||||||
|  | |||||||
| @ -60,17 +60,18 @@ modifyTransactions d tmods ts = do | |||||||
| -- | -- | ||||||
| -- >>> import qualified Data.Text.IO as T | -- >>> import qualified Data.Text.IO as T | ||||||
| -- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]} | -- >>> 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 = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate | ||||||
| -- >>> test $ TransactionModifier "" ["pong" `post` usd 2] | -- >>> test $ TransactionModifier "" ["pong" `tmpost` usd 2] | ||||||
| -- 0000-01-01 | -- 0000-01-01 | ||||||
| --     ping           $1.00 | --     ping           $1.00 | ||||||
| --     pong           $2.00  ; generated-posting: = | --     pong           $2.00  ; generated-posting: = | ||||||
| -- <BLANKLINE> | -- <BLANKLINE> | ||||||
| -- >>> test $ TransactionModifier "miss" ["pong" `post` usd 2] | -- >>> test $ TransactionModifier "miss" ["pong" `tmpost` usd 2] | ||||||
| -- 0000-01-01 | -- 0000-01-01 | ||||||
| --     ping           $1.00 | --     ping           $1.00 | ||||||
| -- <BLANKLINE> | -- <BLANKLINE> | ||||||
| -- >>> test $ TransactionModifier "ping" ["pong" `post` amount{aismultiplier=True, aquantity=3}] | -- >>> test $ TransactionModifier "ping" [("pong" `tmpost` amount{aquantity=3}){tmprIsMultiplier=True}] | ||||||
| -- 0000-01-01 | -- 0000-01-01 | ||||||
| --     ping           $1.00 | --     ping           $1.00 | ||||||
| --     pong           $3.00  ; generated-posting: = ping | --     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 | -- The TransactionModifier's query text is also provided, and saved | ||||||
| -- as the tags' value. | -- as the tags' value. | ||||||
| tmPostingRuleToFunction :: Query -> T.Text -> TMPostingRule -> (Posting -> Posting) | tmPostingRuleToFunction :: Query -> T.Text -> TMPostingRule -> (Posting -> Posting) | ||||||
| tmPostingRuleToFunction query querytxt pr = | tmPostingRuleToFunction query querytxt tmpr = | ||||||
|   \p -> renderPostingCommentDates $ pr |   \p -> renderPostingCommentDates $ pr | ||||||
|       { pdate    = pdate  pr <|> pdate  p |       { pdate    = pdate  pr <|> pdate  p | ||||||
|       , pdate2   = pdate2 pr <|> pdate2 p |       , pdate2   = pdate2 pr <|> pdate2 p | ||||||
| @ -104,9 +105,10 @@ tmPostingRuleToFunction query querytxt pr = | |||||||
|                    ptags pr |                    ptags pr | ||||||
|       } |       } | ||||||
|   where |   where | ||||||
|  |     pr = tmprPosting tmpr | ||||||
|     qry = "= " <> querytxt |     qry = "= " <> querytxt | ||||||
|     symq = filterQuery (liftA2 (||) queryIsSym queryIsAmt) query |     symq = filterQuery (liftA2 (||) queryIsSym queryIsAmt) query | ||||||
|     amount' = case postingRuleMultiplier pr of |     amount' = case postingRuleMultiplier tmpr of | ||||||
|         Nothing -> const $ pamount pr |         Nothing -> const $ pamount pr | ||||||
|         Just n  -> \p -> |         Just n  -> \p -> | ||||||
|           -- Multiply the old posting's amount by the posting rule's multiplier. |           -- 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 |               c  -> mapMixedAmount (\a -> a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount}) as | ||||||
| 
 | 
 | ||||||
| postingRuleMultiplier :: TMPostingRule -> Maybe Quantity | postingRuleMultiplier :: TMPostingRule -> Maybe Quantity | ||||||
| postingRuleMultiplier p = case amountsRaw $ pamount p of | postingRuleMultiplier tmpr = case amountsRaw . pamount $ tmprPosting tmpr of | ||||||
|     [a] | aismultiplier a -> Just $ aquantity a |     [a] | tmprIsMultiplier tmpr -> Just $ aquantity a | ||||||
|     _                     -> Nothing |     _                           -> Nothing | ||||||
| 
 | 
 | ||||||
| renderPostingCommentDates :: Posting -> Posting | renderPostingCommentDates :: Posting -> Posting | ||||||
| renderPostingCommentDates p = p { pcomment = comment' } | renderPostingCommentDates p = p { pcomment = comment' } | ||||||
|  | |||||||
| @ -224,8 +224,6 @@ data Commodity = Commodity { | |||||||
| data Amount = Amount { | data Amount = Amount { | ||||||
|       acommodity  :: !CommoditySymbol,     -- commodity symbol, or special value "AUTO" |       acommodity  :: !CommoditySymbol,     -- commodity symbol, or special value "AUTO" | ||||||
|       aquantity   :: !Quantity,            -- numeric quantity, or zero in case of "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, |       astyle      :: !AmountStyle, | ||||||
|       aprice      :: !(Maybe AmountPrice)  -- ^ the (fixed, transaction-specific) price for this amount, if any |       aprice      :: !(Maybe AmountPrice)  -- ^ the (fixed, transaction-specific) price for this amount, if any | ||||||
|     } deriving (Eq,Ord,Generic,Show) |     } deriving (Eq,Ord,Generic,Show) | ||||||
| @ -429,7 +427,10 @@ nulltransactionmodifier = TransactionModifier{ | |||||||
| -- to the matched posting's transaction. | -- to the matched posting's transaction. | ||||||
| -- Can be like a regular posting, or the amount can have the aismultiplier flag set, | -- 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. | -- 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. | -- | A periodic transaction rule, describing a transaction that recurs. | ||||||
| data PeriodicTransaction = PeriodicTransaction { | data PeriodicTransaction = PeriodicTransaction { | ||||||
|  | |||||||
| @ -32,7 +32,7 @@ module Hledger.Read ( | |||||||
|   readJournal', |   readJournal', | ||||||
| 
 | 
 | ||||||
|   -- * Re-exported |   -- * Re-exported | ||||||
|   JournalReader.postingp, |   JournalReader.tmpostingrulep, | ||||||
|   findReader, |   findReader, | ||||||
|   splitReaderPrefix, |   splitReaderPrefix, | ||||||
|   module Hledger.Read.Common, |   module Hledger.Read.Common, | ||||||
|  | |||||||
| @ -86,6 +86,7 @@ module Hledger.Read.Common ( | |||||||
|   amountp, |   amountp, | ||||||
|   amountp', |   amountp', | ||||||
|   mamountp', |   mamountp', | ||||||
|  |   amountpwithmultiplier, | ||||||
|   commoditysymbolp, |   commoditysymbolp, | ||||||
|   priceamountp, |   priceamountp, | ||||||
|   balanceassertionp, |   balanceassertionp, | ||||||
| @ -768,10 +769,12 @@ spaceandamountormissingp = | |||||||
| -- files with any supported decimal mark, but it also allows different decimal marks | -- 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. | -- in  different amounts, which is a bit too loose. There's an open issue. | ||||||
| amountp :: JournalParser m Amount | amountp :: JournalParser m Amount | ||||||
| amountp = label "amount" $ do | amountp = amountpwithmultiplier False | ||||||
|   let  | 
 | ||||||
|     spaces = lift $ skipNonNewlineSpaces | amountpwithmultiplier :: Bool -> JournalParser m Amount | ||||||
|   amount <- amountwithoutpricep <* spaces | amountpwithmultiplier mult = label "amount" $ do | ||||||
|  |   let spaces = lift $ skipNonNewlineSpaces | ||||||
|  |   amount <- amountwithoutpricep mult <* spaces | ||||||
|   (mprice, _elotprice, _elotdate) <- runPermutation $ |   (mprice, _elotprice, _elotdate) <- runPermutation $ | ||||||
|     (,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp amount <* spaces) |     (,,) <$> toPermutationWithDefault Nothing (Just <$> priceamountp amount <* spaces) | ||||||
|          <*> toPermutationWithDefault Nothing (Just <$> lotpricep <* spaces) |          <*> toPermutationWithDefault Nothing (Just <$> lotpricep <* spaces) | ||||||
| @ -781,20 +784,20 @@ amountp = label "amount" $ do | |||||||
| amountpnolotpricesp :: JournalParser m Amount | amountpnolotpricesp :: JournalParser m Amount | ||||||
| amountpnolotpricesp = label "amount" $ do | amountpnolotpricesp = label "amount" $ do | ||||||
|   let spaces = lift $ skipNonNewlineSpaces |   let spaces = lift $ skipNonNewlineSpaces | ||||||
|   amount <- amountwithoutpricep |   amount <- amountwithoutpricep False | ||||||
|   spaces |   spaces | ||||||
|   mprice <- optional $ priceamountp amount <* spaces |   mprice <- optional $ priceamountp amount <* spaces | ||||||
|   pure $ amount { aprice = mprice } |   pure $ amount { aprice = mprice } | ||||||
| 
 | 
 | ||||||
| amountwithoutpricep :: JournalParser m Amount | amountwithoutpricep :: Bool -> JournalParser m Amount | ||||||
| amountwithoutpricep = do | amountwithoutpricep mult = do | ||||||
|   (mult, sign) <- lift $ (,) <$> multiplierp <*> signp |   sign <- lift signp | ||||||
|   leftsymbolamountp mult sign <|> rightornosymbolamountp mult sign |   leftsymbolamountp sign <|> rightornosymbolamountp sign | ||||||
| 
 | 
 | ||||||
|   where |   where | ||||||
| 
 | 
 | ||||||
|   leftsymbolamountp :: Bool -> (Decimal -> Decimal) -> JournalParser m Amount |   leftsymbolamountp :: (Decimal -> Decimal) -> JournalParser m Amount | ||||||
|   leftsymbolamountp mult sign = label "amount" $ do |   leftsymbolamountp sign = label "amount" $ do | ||||||
|     c <- lift commoditysymbolp |     c <- lift commoditysymbolp | ||||||
|     mdecmarkStyle <- getDecimalMarkStyle |     mdecmarkStyle <- getDecimalMarkStyle | ||||||
|     mcommodityStyle <- getAmountStyle c |     mcommodityStyle <- getAmountStyle c | ||||||
| @ -809,10 +812,10 @@ amountwithoutpricep = do | |||||||
|     let numRegion = (offBeforeNum, offAfterNum) |     let numRegion = (offBeforeNum, offAfterNum) | ||||||
|     (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent |     (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion suggestedStyle ambiguousRawNum mExponent | ||||||
|     let s = amountstyle{ascommodityside=L, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} |     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 :: (Decimal -> Decimal) -> JournalParser m Amount | ||||||
|   rightornosymbolamountp mult sign = label "amount" $ do |   rightornosymbolamountp sign = label "amount" $ do | ||||||
|     offBeforeNum <- getOffset |     offBeforeNum <- getOffset | ||||||
|     ambiguousRawNum <- lift rawnumberp |     ambiguousRawNum <- lift rawnumberp | ||||||
|     mExponent <- lift $ optional $ try exponentp |     mExponent <- lift $ optional $ try exponentp | ||||||
| @ -828,7 +831,7 @@ amountwithoutpricep = do | |||||||
|         let msuggestedStyle = mdecmarkStyle <|> mcommodityStyle |         let msuggestedStyle = mdecmarkStyle <|> mcommodityStyle | ||||||
|         (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion msuggestedStyle ambiguousRawNum mExponent |         (q,prec,mdec,mgrps) <- lift $ interpretNumber numRegion msuggestedStyle ambiguousRawNum mExponent | ||||||
|         let s = amountstyle{ascommodityside=R, ascommodityspaced=commodityspaced, asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps} |         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 |       -- no symbol amount | ||||||
|       Nothing -> do |       Nothing -> do | ||||||
|         -- look for a number style to use when parsing, based on |         -- look for a number style to use when parsing, based on | ||||||
| @ -845,7 +848,7 @@ amountwithoutpricep = do | |||||||
|         let (c,s) = case (mult, defcs) of |         let (c,s) = case (mult, defcs) of | ||||||
|               (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec}) |               (False, Just (defc,defs)) -> (defc, defs{asprecision=max (asprecision defs) prec}) | ||||||
|               _ -> ("", amountstyle{asprecision=prec, asdecimalpoint=mdec, asdigitgroups=mgrps}) |               _ -> ("", 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 |   -- For reducing code duplication. Doesn't parse anything. Has the type | ||||||
|   -- of a parser only in order to throw parse errors (for convenience). |   -- 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 :: Num a => TextParser m (a -> a) | ||||||
| signp = ((char '-' *> pure negate <|> char '+' *> pure id) <* skipNonNewlineSpaces) <|> pure id | 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 :: TextParser m CommoditySymbol | ||||||
| commoditysymbolp = | commoditysymbolp = | ||||||
|   quotedcommoditysymbolp <|> simplecommoditysymbolp <?> "commodity symbol" |   quotedcommoditysymbolp <|> simplecommoditysymbolp <?> "commodity symbol" | ||||||
| @ -902,7 +902,7 @@ priceamountp baseAmt = label "transaction price" $ do | |||||||
|   when parenthesised $ void $ char ')' |   when parenthesised $ void $ char ')' | ||||||
| 
 | 
 | ||||||
|   lift skipNonNewlineSpaces |   lift skipNonNewlineSpaces | ||||||
|   priceAmount <- amountwithoutpricep -- <?> "unpriced amount (specifying a price)" |   priceAmount <- amountwithoutpricep False -- <?> "unpriced amount (specifying a price)" | ||||||
| 
 | 
 | ||||||
|   let amtsign' = signum $ aquantity baseAmt |   let amtsign' = signum $ aquantity baseAmt | ||||||
|       amtsign  = if amtsign' == 0 then 1 else amtsign' |       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 |   doublebrace <- option False $ char '{' >> pure True | ||||||
|   _fixed <- fmap isJust $ optional $ lift skipNonNewlineSpaces >> char '=' |   _fixed <- fmap isJust $ optional $ lift skipNonNewlineSpaces >> char '=' | ||||||
|   lift skipNonNewlineSpaces |   lift skipNonNewlineSpaces | ||||||
|   _a <- amountwithoutpricep |   _a <- amountwithoutpricep False | ||||||
|   lift skipNonNewlineSpaces |   lift skipNonNewlineSpaces | ||||||
|   char '}' |   char '}' | ||||||
|   when (doublebrace) $ void $ char '}' |   when (doublebrace) $ void $ char '}' | ||||||
|  | |||||||
| @ -58,7 +58,7 @@ module Hledger.Read.JournalReader ( | |||||||
|   datetimep, |   datetimep, | ||||||
|   datep, |   datep, | ||||||
|   modifiedaccountnamep, |   modifiedaccountnamep, | ||||||
|   postingp, |   tmpostingrulep, | ||||||
|   statusp, |   statusp, | ||||||
|   emptyorcommentlinep, |   emptyorcommentlinep, | ||||||
|   followingcommentp, |   followingcommentp, | ||||||
| @ -592,8 +592,8 @@ transactionmodifierp = do | |||||||
|   lift skipNonNewlineSpaces |   lift skipNonNewlineSpaces | ||||||
|   querytxt <- lift $ T.strip <$> descriptionp |   querytxt <- lift $ T.strip <$> descriptionp | ||||||
|   (_comment, _tags) <- lift transactioncommentp   -- TODO apply these to modified txns ? |   (_comment, _tags) <- lift transactioncommentp   -- TODO apply these to modified txns ? | ||||||
|   postings <- postingsp Nothing |   postingrules <- tmpostingrulesp Nothing | ||||||
|   return $ TransactionModifier querytxt postings |   return $ TransactionModifier querytxt postingrules | ||||||
| 
 | 
 | ||||||
| -- | Parse a periodic transaction rule. | -- | Parse a periodic transaction rule. | ||||||
| -- | -- | ||||||
| @ -695,32 +695,49 @@ postingsp mTransactionYear = many (postingp mTransactionYear) <?> "postings" | |||||||
| --   return $ sp ++ (c:cs) ++ "\n" | --   return $ sp ++ (c:cs) ++ "\n" | ||||||
| 
 | 
 | ||||||
| postingp :: Maybe Year -> JournalParser m Posting | postingp :: Maybe Year -> JournalParser m Posting | ||||||
| postingp mTransactionYear = do | postingp = fmap fst . postingphelper False | ||||||
|   -- lift $ dbgparse 0 "postingp" | 
 | ||||||
|   (status, account) <- try $ do | -- Parse the following whitespace-beginning lines as transaction posting rules, posting | ||||||
|     lift skipNonNewlineSpaces1 | -- tags, and/or comments (inferring year, if needed, from the given date). | ||||||
|     status <- lift statusp | 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 |     lift skipNonNewlineSpaces | ||||||
|     account <- modifiedaccountnamep |     mult <- if isPostingRule then multiplierp else pure False | ||||||
|     return (status, account) |     amount <- optional $ amountpwithmultiplier mult | ||||||
|   let (ptype, account') = (accountNamePostingType account, textUnbracket account) |     lift skipNonNewlineSpaces | ||||||
|   lift skipNonNewlineSpaces |     massertion <- optional balanceassertionp | ||||||
|   amount <- optional amountp |     lift skipNonNewlineSpaces | ||||||
|   lift skipNonNewlineSpaces |     (comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear | ||||||
|   massertion <- optional balanceassertionp |     let p = posting | ||||||
|   lift skipNonNewlineSpaces |             { pdate=mdate | ||||||
|   (comment,tags,mdate,mdate2) <- lift $ postingcommentp mTransactionYear |             , pdate2=mdate2 | ||||||
|   return posting |             , pstatus=status | ||||||
|    { pdate=mdate |             , paccount=account' | ||||||
|    , pdate2=mdate2 |             , pamount=maybe missingmixedamt mixedAmount amount | ||||||
|    , pstatus=status |             , pcomment=comment | ||||||
|    , paccount=account' |             , ptype=ptype | ||||||
|    , pamount=maybe missingmixedamt mixedAmount amount |             , ptags=tags | ||||||
|    , pcomment=comment |             , pbalanceassertion=massertion | ||||||
|    , ptype=ptype |             } | ||||||
|    , ptags=tags |     return (p, mult) | ||||||
|    , pbalanceassertion=massertion |   where | ||||||
|    } |     multiplierp = option False $ True <$ char '*' | ||||||
| 
 | 
 | ||||||
| --- ** tests | --- ** tests | ||||||
| 
 | 
 | ||||||
| @ -866,7 +883,7 @@ tests_JournalReader = tests "JournalReader" [ | |||||||
|       "= (some value expr)\n some:postings  1.\n" |       "= (some value expr)\n some:postings  1.\n" | ||||||
|       nulltransactionmodifier { |       nulltransactionmodifier { | ||||||
|         tmquerytxt = "(some value expr)" |         tmquerytxt = "(some value expr)" | ||||||
|        ,tmpostingrules = [nullposting{paccount="some:postings", pamount=mixedAmount (num 1)}] |        ,tmpostingrules = [TMPostingRule nullposting{paccount="some:postings", pamount=mixedAmount (num 1)} False] | ||||||
|       } |       } | ||||||
|     ] |     ] | ||||||
| 
 | 
 | ||||||
|  | |||||||
| @ -559,7 +559,7 @@ cumulativeSum value start = snd . M.mapAccumWithKey accumValued start | |||||||
| tests_MultiBalanceReport = tests "MultiBalanceReport" [ | tests_MultiBalanceReport = tests "MultiBalanceReport" [ | ||||||
| 
 | 
 | ||||||
|   let |   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 |     (rspec,journal) `gives` r = do | ||||||
|       let rspec' = rspec{rsQuery=And [queryFromFlags $ rsOpts rspec, rsQuery rspec]} |       let rspec' = rspec{rsQuery=And [queryFromFlags $ rsOpts rspec, rsQuery rspec]} | ||||||
|           (eitems, etotal) = r |           (eitems, etotal) = r | ||||||
|  | |||||||
| @ -55,7 +55,7 @@ transactionModifierFromOpts CliOpts{rawopts_=rawopts} = | |||||||
|     ps = map (parseposting . T.pack) $ listofstringopt "add-posting" rawopts |     ps = map (parseposting . T.pack) $ listofstringopt "add-posting" rawopts | ||||||
|     parseposting t = either (error' . errorBundlePretty) id ep  -- PARTIAL: |     parseposting t = either (error' . errorBundlePretty) id ep  -- PARTIAL: | ||||||
|       where |       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 |         t' = " " <> t <> "\n" -- inject space and newline for proper parsing | ||||||
| 
 | 
 | ||||||
| printOrDiff :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ()) | printOrDiff :: RawOpts -> (CliOpts -> Journal -> Journal -> IO ()) | ||||||
|  | |||||||
| @ -155,3 +155,11 @@ $ hledger -f- print | |||||||
|     equity:opening/closing balances |     equity:opening/closing balances | ||||||
| 
 | 
 | ||||||
| >=0 | >=0 | ||||||
|  | 
 | ||||||
|  | # 13. Adding a multiplier in a normal posting gives a parse error. | ||||||
|  | < | ||||||
|  | 2020-01-01 | ||||||
|  |   (a)  *1 | ||||||
|  | $ hledger -f- print | ||||||
|  | >2 /unexpected '\*'/ | ||||||
|  | >=1 | ||||||
|  | |||||||
| @ -14,7 +14,6 @@ $ hledger -f- reg --output-format=json | |||||||
|       "pamount": [ |       "pamount": [ | ||||||
|         { |         { | ||||||
|           "acommodity": "AAA", |           "acommodity": "AAA", | ||||||
|           "aismultiplier": false, |  | ||||||
|           "aprice": null, |           "aprice": null, | ||||||
|           "aquantity": { |           "aquantity": { | ||||||
|             "decimalMantissa": 10, |             "decimalMantissa": 10, | ||||||
| @ -43,7 +42,6 @@ $ hledger -f- reg --output-format=json | |||||||
|     [ |     [ | ||||||
|       { |       { | ||||||
|         "acommodity": "AAA", |         "acommodity": "AAA", | ||||||
|         "aismultiplier": false, |  | ||||||
|         "aprice": null, |         "aprice": null, | ||||||
|         "aquantity": { |         "aquantity": { | ||||||
|           "decimalMantissa": 10, |           "decimalMantissa": 10, | ||||||
| @ -73,7 +71,6 @@ $ hledger -f- bal --output-format=json | |||||||
|       [ |       [ | ||||||
|         { |         { | ||||||
|           "acommodity": "AAA", |           "acommodity": "AAA", | ||||||
|           "aismultiplier": false, |  | ||||||
|           "aprice": null, |           "aprice": null, | ||||||
|           "aquantity": { |           "aquantity": { | ||||||
|             "decimalMantissa": 10, |             "decimalMantissa": 10, | ||||||
| @ -94,7 +91,6 @@ $ hledger -f- bal --output-format=json | |||||||
|   [ |   [ | ||||||
|     { |     { | ||||||
|       "acommodity": "AAA", |       "acommodity": "AAA", | ||||||
|       "aismultiplier": false, |  | ||||||
|       "aprice": null, |       "aprice": null, | ||||||
|       "aquantity": { |       "aquantity": { | ||||||
|         "decimalMantissa": 10, |         "decimalMantissa": 10, | ||||||
|  | |||||||
		Loading…
	
		Reference in New Issue
	
	Block a user