lib: TransactionModifier: clarify

This commit is contained in:
Simon Michael 2018-11-13 11:42:23 -08:00
parent 80b34ea48d
commit 4b5b9f46db
4 changed files with 30 additions and 18 deletions

View File

@ -58,7 +58,7 @@ transactionModifierToFunction mt =
\t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } -- TODO add modifier txn comment/tags ? \t@(tpostings -> ps) -> txnTieKnot t{ tpostings=generatePostings ps } -- TODO add modifier txn comment/tags ?
where where
q = simplifyQuery $ tmParseQuery mt (error' "a transaction modifier's query cannot depend on current date") 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 generatePostings ps = [p' | p <- ps
, p' <- if q `matchesPosting` p then p:[ m p | m <- mods] else [p]] , p' <- if q `matchesPosting` p then p:[ m p | m <- mods] else [p]]
@ -76,28 +76,28 @@ transactionModifierToFunction mt =
tmParseQuery :: TransactionModifier -> (Day -> Query) tmParseQuery :: TransactionModifier -> (Day -> Query)
tmParseQuery mt = fst . flip parseQuery (tmquerytxt mt) 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"). -- which will be used to make a new posting based on the old one (an "automated posting").
tmPostingToFunction :: Posting -> (Posting -> Posting) tmPostingRuleToFunction :: TMPostingRule -> (Posting -> Posting)
tmPostingToFunction p' = tmPostingRuleToFunction pr =
\p -> renderPostingCommentDates $ p' \p -> renderPostingCommentDates $ pr
{ pdate = pdate p { pdate = pdate p
, pdate2 = pdate2 p , pdate2 = pdate2 p
, pamount = amount' p , pamount = amount' p
} }
where where
amount' = case postingScale p' of amount' = case postingRuleMultiplier pr of
Nothing -> const $ pamount p' Nothing -> const $ pamount pr
Just n -> \p -> withAmountType (head $ amounts $ pamount p') $ pamount p `divideMixedAmount` (1/n) Just n -> \p -> withAmountType (head $ amounts $ pamount pr) $ pamount p `multiplyMixedAmount` n
withAmountType amount (Mixed as) = case acommodity amount of withAmountType pramount (Mixed as) = case acommodity pramount of
"" -> Mixed as "" -> 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 postingRuleMultiplier :: TMPostingRule -> Maybe Quantity
postingScale p = postingRuleMultiplier p =
case amounts $ pamount p of case amounts $ pamount p of
[a] | amultiplier a -> Just $ aquantity a [a] | amultiplier a -> Just $ aquantity a
_ -> Nothing _ -> Nothing
renderPostingCommentDates :: Posting -> Posting renderPostingCommentDates :: Posting -> Posting
renderPostingCommentDates p = p { pcomment = comment' } renderPostingCommentDates p = p { pcomment = comment' }

View File

@ -205,7 +205,8 @@ data Amount = Amount {
aquantity :: Quantity, aquantity :: Quantity,
aprice :: Price, -- ^ the (fixed) price for this amount, if any aprice :: Price, -- ^ the (fixed) price for this amount, if any
astyle :: AmountStyle, 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) } deriving (Eq,Ord,Typeable,Data,Generic,Show)
instance NFData Amount instance NFData Amount
@ -316,18 +317,29 @@ data Transaction = Transaction {
instance NFData 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 { data TransactionModifier = TransactionModifier {
tmquerytxt :: Text, tmquerytxt :: Text,
tmpostings :: [Posting] tmpostingrules :: [TMPostingRule]
} deriving (Eq,Typeable,Data,Generic,Show) } deriving (Eq,Typeable,Data,Generic,Show)
instance NFData TransactionModifier instance NFData TransactionModifier
nulltransactionmodifier = TransactionModifier{ nulltransactionmodifier = TransactionModifier{
tmquerytxt = "" 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. -- | A periodic transaction rule, describing a transaction that recurs.
data PeriodicTransaction = PeriodicTransaction { data PeriodicTransaction = PeriodicTransaction {
ptperiodexpr :: Text, -- ^ the period expression as written ptperiodexpr :: Text, -- ^ the period expression as written

View File

@ -740,7 +740,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)"
,tmpostings = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}] ,tmpostingrules = [nullposting{paccount="some:postings", pamount=Mixed[num 1]}]
} }
] ]

View File

@ -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. -- provided on the command line, or throw a parse error.
transactionModifierFromOpts :: CliOpts -> TransactionModifier transactionModifierFromOpts :: CliOpts -> TransactionModifier
transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} = transactionModifierFromOpts CliOpts{rawopts_=rawopts,reportopts_=ropts} =
TransactionModifier{tmquerytxt=q, tmpostings=ps} TransactionModifier{tmquerytxt=q, tmpostingrules=ps}
where where
q = T.pack $ query_ ropts q = T.pack $ query_ ropts
ps = map (parseposting . stripquotes . T.pack) $ listofstringopt "add-posting" rawopts ps = map (parseposting . stripquotes . T.pack) $ listofstringopt "add-posting" rawopts