From 4b5b9f46dbec66cf79f6de43c9f87488f3d81e80 Mon Sep 17 00:00:00 2001 From: Simon Michael Date: Tue, 13 Nov 2018 11:42:23 -0800 Subject: [PATCH] lib: TransactionModifier: clarify --- .../Hledger/Data/TransactionModifier.hs | 26 +++++++++---------- hledger-lib/Hledger/Data/Types.hs | 18 ++++++++++--- hledger-lib/Hledger/Read/JournalReader.hs | 2 +- hledger/Hledger/Cli/Commands/Rewrite.hs | 2 +- 4 files changed, 30 insertions(+), 18 deletions(-) diff --git a/hledger-lib/Hledger/Data/TransactionModifier.hs b/hledger-lib/Hledger/Data/TransactionModifier.hs index 6a2a33d5b..33d85fbe7 100644 --- a/hledger-lib/Hledger/Data/TransactionModifier.hs +++ b/hledger-lib/Hledger/Data/TransactionModifier.hs @@ -58,7 +58,7 @@ transactionModifierToFunction mt = \t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } -- TODO add modifier txn comment/tags ? where q = simplifyQuery $ tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date") - mods = map tmPostingToFunction $ tmpostings mt + mods = map tmPostingRuleToFunction $ tmpostingrules mt generatePostings ps = [p' | p <- ps , p' <- if q `matchesPosting` p then p:[ m p | m <- mods] else [p]] @@ -76,28 +76,28 @@ transactionModifierToFunction mt = tmParseQuery :: TransactionModifier -> (Day -> Query) tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt) --- | Converts a 'TransactionModifier''s posting to a 'Posting'-generating function, +-- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function, -- which will be used to make a new posting based on the old one (an "automated posting"). -tmPostingToFunction :: Posting -> (Posting -> Posting) -tmPostingToFunction p' = - \p -> renderPostingCommentDates $ p' +tmPostingRuleToFunction :: TMPostingRule -> (Posting -> Posting) +tmPostingRuleToFunction pr = + \p -> renderPostingCommentDates $ pr { pdate = pdate p , pdate2 = pdate2 p , pamount = amount' p } where - amount' = case postingScale p' of - Nothing -> const $ pamount p' - Just n -> \p -> withAmountType (head $ amounts $ pamount p') $ pamount p `divideMixedAmount` (1/n) - withAmountType amount (Mixed as) = case acommodity amount of + amount' = case postingRuleMultiplier pr of + Nothing -> const $ pamount pr + Just n -> \p -> withAmountType (head $ amounts $ pamount pr) $ pamount p `multiplyMixedAmount` n + withAmountType pramount (Mixed as) = case acommodity pramount of "" -> Mixed as - c -> Mixed [a{acommodity = c, astyle = astyle amount, aprice = aprice amount} | a <- as] + c -> Mixed [a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount} | a <- as] -postingScale :: Posting -> Maybe Quantity -postingScale p = +postingRuleMultiplier :: TMPostingRule -> Maybe Quantity +postingRuleMultiplier p = case amounts $ pamount p of [a] | amultiplier a -> Just $ aquantity a - _ -> Nothing + _ -> 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 132b882e7..4e1ac28d8 100644 --- a/hledger-lib/Hledger/Data/Types.hs +++ b/hledger-lib/Hledger/Data/Types.hs @@ -205,7 +205,8 @@ data Amount = Amount { aquantity :: Quantity, aprice :: Price, -- ^ the (fixed) price for this amount, if any astyle :: AmountStyle, - amultiplier :: Bool -- ^ kludge: a flag marking this amount and posting as a multipier in a TransactionModifier + amultiplier :: Bool -- ^ kludge: a flag marking this amount and posting as a multiplier + -- in a TMPostingRule. In a regular Posting, should always be false. } deriving (Eq,Ord,Typeable,Data,Generic,Show) instance NFData Amount @@ -316,18 +317,29 @@ data Transaction = Transaction { instance NFData Transaction +-- | A transaction modifier rule. This has a query which matches postings +-- in the journal, and a list of transformations to apply to those +-- postings or their transactions. Currently there is one kind of transformation: +-- the TMPostingRule, which adds a posting ("auto posting") to the transaction, +-- optionally setting its amount to the matched posting's amount multiplied by a constant. data TransactionModifier = TransactionModifier { tmquerytxt :: Text, - tmpostings :: [Posting] + tmpostingrules :: [TMPostingRule] } deriving (Eq,Typeable,Data,Generic,Show) instance NFData TransactionModifier nulltransactionmodifier = TransactionModifier{ tmquerytxt = "" - ,tmpostings = [] + ,tmpostingrules = [] } +-- | A transaction modifier transformation, which adds an extra posting +-- to the matched posting's transaction. +-- Can be like a regular posting, or the amount can have the amultiplier flag set, +-- indicating that it's a multiplier for the matched posting's amount. +type TMPostingRule = Posting + -- | A periodic transaction rule, describing a transaction that recurs. data PeriodicTransaction = PeriodicTransaction { ptperiodexpr :: Text, -- ^ the period expression as written diff --git a/hledger-lib/Hledger/Read/JournalReader.hs b/hledger-lib/Hledger/Read/JournalReader.hs index 1e048cedd..58e052bd8 100644 --- a/hledger-lib/Hledger/Read/JournalReader.hs +++ b/hledger-lib/Hledger/Read/JournalReader.hs @@ -740,7 +740,7 @@ tests_JournalReader = tests "JournalReader" [ "= (some value expr)\n some:postings 1.\n" nulltransactionmodifier { tmquerytxt = "(some value expr)" - ,tmpostings = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}] + ,tmpostingrules = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}] } ] diff --git a/hledger/Hledger/Cli/Commands/Rewrite.hs b/hledger/Hledger/Cli/Commands/Rewrite.hs index 893436b2a..216393bcd 100755 --- a/hledger/Hledger/Cli/Commands/Rewrite.hs +++ b/hledger/Hledger/Cli/Commands/Rewrite.hs @@ -189,7 +189,7 @@ rewrite opts@CliOpts{rawopts_=rawopts,reportopts_=ropts} j@Journal{jtxns=ts} = d -- provided on the command line, or throw a parse error. transactionModifierFromOpts :: CliOpts -> TransactionModifier transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} = - TransactionModifier{tmquerytxt=q, tmpostings=ps} + TransactionModifier{tmquerytxt=q, tmpostingrules=ps} where q = T.pack $ query_ ropts ps = map (parseposting . stripquotes . T.pack) $ listofstringopt "add-posting" rawopts