slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

lib: Make sure automatic postings generated from postings with more than one commodity match on commodity symbol (#1582).

Browse Source
This commit is contained in:
Stephen Morgan 2021-06-28 21:51:25 +10:00 committed by Simon Michael
parent bb7d04c031
commit 2a9d358627
2 changed files with 32 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
hledger-lib/Hledger/Data/TransactionModifier.hs
View File

@ -13,16 +13,17 @@ module Hledger.Data.TransactionModifier (
where where
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Data.Maybe import Data.Maybe (catMaybes)
import qualified Data.Text as T import qualified Data.Text as T
import Data.Time.Calendar import Data.Time.Calendar (Day)
import Hledger.Data.Types import Hledger.Data.Types
import Hledger.Data.Dates import Hledger.Data.Dates
import Hledger.Data.Amount import Hledger.Data.Amount
import Hledger.Data.Transaction import Hledger.Data.Transaction (txnTieKnot)
import Hledger.Query import Hledger.Query (Query, filterQuery, matchesAmount, matchesPosting,
parseQuery, queryIsSym, simplifyQuery)
import Hledger.Data.Posting (commentJoin, commentAddTag) import Hledger.Data.Posting (commentJoin, commentAddTag)
import Hledger.Utils import Hledger.Utils (dbg6, wrap)
-- $setup -- $setup
-- >>> :set -XOverloadedStrings -- >>> :set -XOverloadedStrings
@ -57,8 +58,8 @@ modifyTransactions d tmods ts = do
-- Currently the only kind of modification possible is adding automated -- Currently the only kind of modification possible is adding automated
-- postings when certain other postings are present. -- postings when certain other postings are present.
-- --
-- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}
-- >>> import qualified Data.Text.IO as T -- >>> import qualified Data.Text.IO as T
-- >>> t = nulltransaction{tpostings=["ping" `post` usd 1]}
-- >>> 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" `post` usd 2]
-- 0000-01-01 -- 0000-01-01
@ -79,7 +80,7 @@ transactionModifierToFunction :: Day -> TransactionModifier -> Either String (Tr
transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingrules} = do transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingrules} = do
q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt q <- simplifyQuery . fst <$> parseQuery refdate tmquerytxt
let let
fs = map (tmPostingRuleToFunction tmquerytxt) tmpostingrules fs = map (tmPostingRuleToFunction q tmquerytxt) tmpostingrules
generatePostings ps = [p' | p <- ps generatePostings ps = [p' | p <- ps
, p' <- if q `matchesPosting` p then p:[f p | f <- fs] else [p]] , p' <- if q `matchesPosting` p then p:[f p | f <- fs] else [p]]
Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps} Right $ \t@(tpostings -> ps) -> txnTieKnot t{tpostings=generatePostings ps}
@ -92,8 +93,8 @@ transactionModifierToFunction refdate TransactionModifier{tmquerytxt, tmpostingr
-- and a hidden _generated-posting: tag which does not. -- and a hidden _generated-posting: tag which does not.
-- 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 :: T.Text -> TMPostingRule -> (Posting -> Posting) tmPostingRuleToFunction :: Query -> T.Text -> TMPostingRule -> (Posting -> Posting)
tmPostingRuleToFunction querytxt pr = tmPostingRuleToFunction query querytxt pr =
\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
@ -105,13 +106,14 @@ tmPostingRuleToFunction querytxt pr =
} }
where where
qry = "= " <> querytxt qry = "= " <> querytxt
symq = filterQuery queryIsSym query
amount' = case postingRuleMultiplier pr of amount' = case postingRuleMultiplier pr of
Nothing -> const $ pamount pr Nothing -> const . filterMixedAmount (symq `matchesAmount`) $ 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.
let let
pramount = dbg6 "pramount" . head . amountsRaw $ pamount pr pramount = dbg6 "pramount" . head . amountsRaw $ pamount pr
matchedamount = dbg6 "matchedamount" $ pamount p matchedamount = dbg6 "matchedamount" . filterMixedAmount (symq `matchesAmount`) $ pamount p
-- Handle a matched amount with a total price carefully so as to keep the transaction balanced (#928). -- 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 -- Approach 1: convert to a unit price and increase the display precision slightly
-- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount -- Mixed as = dbg6 "multipliedamount" $ n `multiplyMixedAmount` mixedAmountTotalPriceToUnitPrice matchedamount

19
hledger/test/journal/auto-postings.test
View File

@ -342,3 +342,22 @@ $ hledger -f- print --auto
(b) 1.5 B ; generated-posting: = (b) 1.5 B ; generated-posting: =
>=0 >=0
# 18. Auto-generated postings with currency matching only matches amounts with that currency in an auto posting (#1582)
<
= assets cur:USD
(b:USD) *1
2017-12-14
revenue:job -10 EUR
revenue:job -10 USD
assets
$ hledger -f- print --auto
2017-12-14 ; modified:
revenue:job -10 EUR
revenue:job -10 USD
assets
(b:USD) 10 USD ; generated-posting: = assets cur:USD
>=0