2020-08-05 23:41:13 +03:00
|
|
|
{-# LANGUAGE NamedFieldPuns #-}
|
2018-07-30 21:38:47 +03:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
|
|
{-|
|
|
|
|
|
|
|
|
A 'TransactionModifier' is a rule that modifies certain 'Transaction's,
|
2019-07-15 13:28:52 +03:00
|
|
|
typically adding automated postings to them.
|
2018-07-30 21:38:47 +03:00
|
|
|
|
|
|
|
-}
|
|
|
|
module Hledger.Data.TransactionModifier (
|
2019-02-01 22:31:04 +03:00
|
|
|
modifyTransactions
|
2018-07-30 21:38:47 +03:00
|
|
|
)
|
|
|
|
where
|
|
|
|
|
2021-07-01 05:01:00 +03:00
|
|
|
import Control.Applicative ((<|>), liftA2)
|
2021-06-28 14:51:25 +03:00
|
|
|
import Data.Maybe (catMaybes)
|
2018-07-30 21:38:47 +03:00
|
|
|
import qualified Data.Text as T
|
2021-06-28 14:51:25 +03:00
|
|
|
import Data.Time.Calendar (Day)
|
2018-07-30 21:38:47 +03:00
|
|
|
import Hledger.Data.Types
|
|
|
|
import Hledger.Data.Dates
|
|
|
|
import Hledger.Data.Amount
|
2021-06-28 14:51:25 +03:00
|
|
|
import Hledger.Data.Transaction (txnTieKnot)
|
|
|
|
import Hledger.Query (Query, filterQuery, matchesAmount, matchesPosting,
|
2021-07-01 05:01:00 +03:00
|
|
|
parseQuery, queryIsAmt, queryIsSym, simplifyQuery)
|
2019-07-17 20:38:14 +03:00
|
|
|
import Hledger.Data.Posting (commentJoin, commentAddTag)
|
2021-06-28 14:51:25 +03:00
|
|
|
import Hledger.Utils (dbg6, wrap)
|
2018-07-30 21:38:47 +03:00
|
|
|
|
|
|
|
-- $setup
|
|
|
|
-- >>> :set -XOverloadedStrings
|
|
|
|
-- >>> import Hledger.Data.Posting
|
|
|
|
-- >>> import Hledger.Data.Transaction
|
|
|
|
-- >>> import Hledger.Data.Journal
|
|
|
|
|
2019-02-01 22:31:04 +03:00
|
|
|
-- | Apply all the given transaction modifiers, in turn, to each transaction.
|
2020-08-05 23:41:13 +03:00
|
|
|
-- Or if any of them fails to be parsed, return the first error. A reference
|
|
|
|
-- date is provided to help interpret relative dates in transaction modifier
|
|
|
|
-- queries.
|
|
|
|
modifyTransactions :: Day -> [TransactionModifier] -> [Transaction] -> Either String [Transaction]
|
|
|
|
modifyTransactions d tmods ts = do
|
|
|
|
fs <- mapM (transactionModifierToFunction d) tmods -- convert modifiers to functions, or return a parse error
|
|
|
|
let
|
|
|
|
modifytxn t = t''
|
2019-07-17 20:38:14 +03:00
|
|
|
where
|
2020-08-05 23:41:13 +03:00
|
|
|
t' = foldr (flip (.)) id fs t -- apply each function in turn
|
|
|
|
t'' = if t' == t -- and add some tags if it was changed
|
|
|
|
then t'
|
|
|
|
else t'{tcomment=tcomment t' `commentAddTag` ("modified",""), ttags=("modified","") : ttags t'}
|
|
|
|
Right $ map modifytxn ts
|
2019-02-01 22:31:04 +03:00
|
|
|
|
2020-08-05 23:41:13 +03:00
|
|
|
-- | Converts a 'TransactionModifier' to a 'Transaction'-transforming function
|
2018-07-31 12:39:11 +03:00
|
|
|
-- which applies the modification(s) specified by the TransactionModifier.
|
2020-08-05 23:41:13 +03:00
|
|
|
-- Or, returns the error message there is a problem parsing the TransactionModifier's query.
|
|
|
|
-- A reference date is provided to help interpret relative dates in the query.
|
|
|
|
--
|
2019-07-15 13:28:52 +03:00
|
|
|
-- The postings of the transformed transaction will reference it in the usual
|
2018-07-31 12:39:11 +03:00
|
|
|
-- way (ie, 'txnTieKnot' is called).
|
2018-07-30 21:38:47 +03:00
|
|
|
--
|
2020-08-05 23:41:13 +03:00
|
|
|
-- Currently the only kind of modification possible is adding automated
|
|
|
|
-- postings when certain other postings are present.
|
|
|
|
--
|
2020-12-25 08:38:26 +03:00
|
|
|
-- >>> import qualified Data.Text.IO as T
|
2021-06-28 14:51:25 +03:00
|
|
|
-- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}
|
2020-12-25 08:38:26 +03:00
|
|
|
-- >>> test = either putStr (T.putStr.showTransaction) . fmap ($ t) . transactionModifierToFunction nulldate
|
2020-08-08 18:53:16 +03:00
|
|
|
-- >>> test $ TransactionModifier "" ["pong" `post` usd 2]
|
2020-02-03 19:03:44 +03:00
|
|
|
-- 0000-01-01
|
2018-07-30 21:38:47 +03:00
|
|
|
-- ping $1.00
|
2019-10-02 09:30:31 +03:00
|
|
|
-- pong $2.00 ; generated-posting: =
|
2018-07-30 21:38:47 +03:00
|
|
|
-- <BLANKLINE>
|
2020-08-08 18:53:16 +03:00
|
|
|
-- >>> test $ TransactionModifier "miss" ["pong" `post` usd 2]
|
2020-02-03 19:03:44 +03:00
|
|
|
-- 0000-01-01
|
2018-07-30 21:38:47 +03:00
|
|
|
-- ping $1.00
|
|
|
|
-- <BLANKLINE>
|
2020-08-08 18:53:16 +03:00
|
|
|
-- >>> test $ TransactionModifier "ping" ["pong" `post` amount{aismultiplier=True, aquantity=3}]
|
2020-02-03 19:03:44 +03:00
|
|
|
-- 0000-01-01
|
2020-08-08 18:53:16 +03:00
|
|
|
-- ping $1.00
|
|
|
|
-- pong $3.00 ; generated-posting: = ping
|
2018-07-30 21:38:47 +03:00
|
|
|
-- <BLANKLINE>
|
2018-09-05 00:02:04 +03:00
|
|
|
--
|
2020-08-05 23:41:13 +03:00
|
|
|
transactionModifierToFunction :: Day -> TransactionModifier -> Either String (Transaction -> Transaction)
|
|
|
|
transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingrules} = do
|
|
|
|
q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt
|
|
|
|
let
|
2021-06-28 14:51:25 +03:00
|
|
|
fs = map (tmPostingRuleToFunction q tmquerytxt) tmpostingrules
|
2021-07-01 05:01:00 +03:00
|
|
|
generatePostings ps = concatMap (\p -> p : map ($p) (if q `matchesPosting` p then fs else [])) ps
|
2020-08-05 23:41:13 +03:00
|
|
|
Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps}
|
2018-07-30 21:38:47 +03:00
|
|
|
|
2018-11-13 22:42:23 +03:00
|
|
|
-- | Converts a 'TransactionModifier''s posting rule to a 'Posting'-generating function,
|
2018-07-30 21:38:47 +03:00
|
|
|
-- which will be used to make a new posting based on the old one (an "automated posting").
|
2018-11-14 02:37:42 +03:00
|
|
|
-- The new posting's amount can optionally be the old posting's amount multiplied by a constant.
|
2019-07-15 13:28:52 +03:00
|
|
|
-- If the old posting had a total-priced amount, the new posting's multiplied amount will be unit-priced.
|
2019-07-17 20:38:14 +03:00
|
|
|
-- The new posting will have two tags added: a normal generated-posting: tag which also appears in the comment,
|
|
|
|
-- and a hidden _generated-posting: tag which does not.
|
|
|
|
-- The TransactionModifier's query text is also provided, and saved
|
|
|
|
-- as the tags' value.
|
2021-06-28 14:51:25 +03:00
|
|
|
tmPostingRuleToFunction :: Query -> T.Text -> TMPostingRule -> (Posting -> Posting)
|
|
|
|
tmPostingRuleToFunction query querytxt pr =
|
2018-11-13 22:42:23 +03:00
|
|
|
\p -> renderPostingCommentDates $ pr
|
2019-07-17 20:38:14 +03:00
|
|
|
{ pdate = pdate pr <|> pdate p
|
|
|
|
, pdate2 = pdate2 pr <|> pdate2 p
|
|
|
|
, pamount = amount' p
|
|
|
|
, pcomment = pcomment pr `commentAddTag` ("generated-posting",qry)
|
|
|
|
, ptags = ("generated-posting", qry) :
|
|
|
|
("_generated-posting",qry) :
|
|
|
|
ptags pr
|
2018-07-30 21:38:47 +03:00
|
|
|
}
|
|
|
|
where
|
2019-07-17 20:38:14 +03:00
|
|
|
qry = "= " <> querytxt
|
2021-07-01 05:01:00 +03:00
|
|
|
symq = filterQuery (liftA2 (||) queryIsSym queryIsAmt) query
|
2018-11-13 22:42:23 +03:00
|
|
|
amount' = case postingRuleMultiplier pr of
|
2021-07-01 05:01:00 +03:00
|
|
|
Nothing -> const $ pamount pr
|
2018-11-14 02:37:42 +03:00
|
|
|
Just n -> \p ->
|
|
|
|
-- Multiply the old posting's amount by the posting rule's multiplier.
|
|
|
|
let
|
lib: Change internal representation of MixedAmount to use a strict Map
instead of a list of Amounts. No longer export Mixed constructor, to
keep API clean (if you really need it, you can import it directly from
Hledger.Data.Types). We also ensure the JSON representation of
MixedAmount doesn't change: it is stored as a normalised list of
Amounts.
This commit improves performance. Here are some indicative results.
hledger reg -f examples/10000x1000x10.journal
- Maximum residency decreases from 65MB to 60MB (8% decrease)
- Total memory in use decreases from 178MiB to 157MiB (12% decrease)
hledger reg -f examples/10000x10000x10.journal
- Maximum residency decreases from 69MB to 60MB (13% decrease)
- Total memory in use decreases from 198MiB to 153MiB (23% decrease)
hledger bal -f examples/10000x1000x10.journal
- Total heap usage decreases from 6.4GB to 6.0GB (6% decrease)
- Total memory in use decreases from 178MiB to 153MiB (14% decrease)
hledger bal -f examples/10000x10000x10.journal
- Total heap usage decreases from 7.3GB to 6.9GB (5% decrease)
- Total memory in use decreases from 196MiB to 185MiB (5% decrease)
hledger bal -M -f examples/10000x1000x10.journal
- Total heap usage decreases from 16.8GB to 10.6GB (47% decrease)
- Total time decreases from 14.3s to 12.0s (16% decrease)
hledger bal -M -f examples/10000x10000x10.journal
- Total heap usage decreases from 108GB to 48GB (56% decrease)
- Total time decreases from 62s to 41s (33% decrease)
If you never directly use the constructor Mixed or pattern match against
it then you don't need to make any changes. If you do, then do the
following:
- If you really care about the individual Amounts and never normalise
your MixedAmount (for example, just storing `Mixed amts` and then
extracting `amts` as a pattern match, then use should switch to using
[Amount]. This should just involve removing the `Mixed` constructor.
- If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of
amount arithmetic (+), (-), then you should replace the constructor
`Mixed` with the function `mixed`. To extract the list of Amounts, use
the function `amounts`.
- If you ever call `normaliseMixedAmountSquashPricesForDisplay`, you can
replace that with `mixedAmountStripPrices`. (N.B. this does something
slightly different from `normaliseMixedAmountSquashPricesForDisplay`,
but I don't think there's any use case for squashing prices and then
keeping the first of the squashed prices around. If you disagree let
me know.)
- Any remaining calls to `normaliseMixedAmount` can be removed, as that
is now the identity function.
2021-01-29 08:07:11 +03:00
|
|
|
pramount = dbg6 "pramount" . head . amountsRaw $ pamount pr
|
2021-06-28 14:51:25 +03:00
|
|
|
matchedamount = dbg6 "matchedamount" . filterMixedAmount (symq `matchesAmount`) $ pamount p
|
2018-11-14 04:50:30 +03:00
|
|
|
-- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928).
|
|
|
|
-- Approach 1: convert to a unit price and increase the display precision slightly
|
2020-07-03 21:37:01 +03:00
|
|
|
-- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount
|
2019-07-15 13:28:52 +03:00
|
|
|
-- Approach 2: multiply the total price (keeping it positive) as well as the quantity
|
lib: Change internal representation of MixedAmount to use a strict Map
instead of a list of Amounts. No longer export Mixed constructor, to
keep API clean (if you really need it, you can import it directly from
Hledger.Data.Types). We also ensure the JSON representation of
MixedAmount doesn't change: it is stored as a normalised list of
Amounts.
This commit improves performance. Here are some indicative results.
hledger reg -f examples/10000x1000x10.journal
- Maximum residency decreases from 65MB to 60MB (8% decrease)
- Total memory in use decreases from 178MiB to 157MiB (12% decrease)
hledger reg -f examples/10000x10000x10.journal
- Maximum residency decreases from 69MB to 60MB (13% decrease)
- Total memory in use decreases from 198MiB to 153MiB (23% decrease)
hledger bal -f examples/10000x1000x10.journal
- Total heap usage decreases from 6.4GB to 6.0GB (6% decrease)
- Total memory in use decreases from 178MiB to 153MiB (14% decrease)
hledger bal -f examples/10000x10000x10.journal
- Total heap usage decreases from 7.3GB to 6.9GB (5% decrease)
- Total memory in use decreases from 196MiB to 185MiB (5% decrease)
hledger bal -M -f examples/10000x1000x10.journal
- Total heap usage decreases from 16.8GB to 10.6GB (47% decrease)
- Total time decreases from 14.3s to 12.0s (16% decrease)
hledger bal -M -f examples/10000x10000x10.journal
- Total heap usage decreases from 108GB to 48GB (56% decrease)
- Total time decreases from 62s to 41s (33% decrease)
If you never directly use the constructor Mixed or pattern match against
it then you don't need to make any changes. If you do, then do the
following:
- If you really care about the individual Amounts and never normalise
your MixedAmount (for example, just storing `Mixed amts` and then
extracting `amts` as a pattern match, then use should switch to using
[Amount]. This should just involve removing the `Mixed` constructor.
- If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of
amount arithmetic (+), (-), then you should replace the constructor
`Mixed` with the function `mixed`. To extract the list of Amounts, use
the function `amounts`.
- If you ever call `normaliseMixedAmountSquashPricesForDisplay`, you can
replace that with `mixedAmountStripPrices`. (N.B. this does something
slightly different from `normaliseMixedAmountSquashPricesForDisplay`,
but I don't think there's any use case for squashing prices and then
keeping the first of the squashed prices around. If you disagree let
me know.)
- Any remaining calls to `normaliseMixedAmount` can be removed, as that
is now the identity function.
2021-01-29 08:07:11 +03:00
|
|
|
as = dbg6 "multipliedamount" $ multiplyMixedAmount n matchedamount
|
2018-11-14 02:37:42 +03:00
|
|
|
in
|
|
|
|
case acommodity pramount of
|
2021-01-31 07:23:46 +03:00
|
|
|
"" -> as
|
2018-11-14 02:37:42 +03:00
|
|
|
-- TODO multipliers with commodity symbols are not yet a documented feature.
|
2019-07-15 13:28:52 +03:00
|
|
|
-- For now: in addition to multiplying the quantity, it also replaces the
|
|
|
|
-- matched amount's commodity, display style, and price with those of the posting rule.
|
2021-01-31 07:23:46 +03:00
|
|
|
c -> mapMixedAmount (\a -> a{acommodity = c, astyle = astyle pramount, aprice = aprice pramount}) as
|
2018-07-30 21:38:47 +03:00
|
|
|
|
2018-11-13 22:42:23 +03:00
|
|
|
postingRuleMultiplier :: TMPostingRule -> Maybe Quantity
|
lib: Change internal representation of MixedAmount to use a strict Map
instead of a list of Amounts. No longer export Mixed constructor, to
keep API clean (if you really need it, you can import it directly from
Hledger.Data.Types). We also ensure the JSON representation of
MixedAmount doesn't change: it is stored as a normalised list of
Amounts.
This commit improves performance. Here are some indicative results.
hledger reg -f examples/10000x1000x10.journal
- Maximum residency decreases from 65MB to 60MB (8% decrease)
- Total memory in use decreases from 178MiB to 157MiB (12% decrease)
hledger reg -f examples/10000x10000x10.journal
- Maximum residency decreases from 69MB to 60MB (13% decrease)
- Total memory in use decreases from 198MiB to 153MiB (23% decrease)
hledger bal -f examples/10000x1000x10.journal
- Total heap usage decreases from 6.4GB to 6.0GB (6% decrease)
- Total memory in use decreases from 178MiB to 153MiB (14% decrease)
hledger bal -f examples/10000x10000x10.journal
- Total heap usage decreases from 7.3GB to 6.9GB (5% decrease)
- Total memory in use decreases from 196MiB to 185MiB (5% decrease)
hledger bal -M -f examples/10000x1000x10.journal
- Total heap usage decreases from 16.8GB to 10.6GB (47% decrease)
- Total time decreases from 14.3s to 12.0s (16% decrease)
hledger bal -M -f examples/10000x10000x10.journal
- Total heap usage decreases from 108GB to 48GB (56% decrease)
- Total time decreases from 62s to 41s (33% decrease)
If you never directly use the constructor Mixed or pattern match against
it then you don't need to make any changes. If you do, then do the
following:
- If you really care about the individual Amounts and never normalise
your MixedAmount (for example, just storing `Mixed amts` and then
extracting `amts` as a pattern match, then use should switch to using
[Amount]. This should just involve removing the `Mixed` constructor.
- If you ever call `mixed`, `normaliseMixedAmount`, or do any sort of
amount arithmetic (+), (-), then you should replace the constructor
`Mixed` with the function `mixed`. To extract the list of Amounts, use
the function `amounts`.
- If you ever call `normaliseMixedAmountSquashPricesForDisplay`, you can
replace that with `mixedAmountStripPrices`. (N.B. this does something
slightly different from `normaliseMixedAmountSquashPricesForDisplay`,
but I don't think there's any use case for squashing prices and then
keeping the first of the squashed prices around. If you disagree let
me know.)
- Any remaining calls to `normaliseMixedAmount` can be removed, as that
is now the identity function.
2021-01-29 08:07:11 +03:00
|
|
|
postingRuleMultiplier p = case amountsRaw $ pamount p of
|
|
|
|
[a] | aismultiplier a -> Just $ aquantity a
|
|
|
|
_ -> Nothing
|
2018-11-13 22:18:08 +03:00
|
|
|
|
2018-07-30 21:38:47 +03:00
|
|
|
renderPostingCommentDates :: Posting -> Posting
|
|
|
|
renderPostingCommentDates p = p { pcomment = comment' }
|
|
|
|
where
|
2020-11-05 04:58:04 +03:00
|
|
|
dates = T.concat $ catMaybes [showDate <$> pdate p, ("=" <>) . showDate <$> pdate2 p]
|
2018-07-30 21:38:47 +03:00
|
|
|
comment'
|
2019-07-17 20:38:14 +03:00
|
|
|
| T.null dates = pcomment p
|
2020-11-05 04:58:04 +03:00
|
|
|
| otherwise = (wrap "[" "]" dates) `commentJoin` pcomment p
|