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

dev:Transaction: refactor/clarify transactionInferCostsFromEquity

Browse Source
This commit is contained in:
Simon Michael 2023-07-15 16:19:45 -10:00
parent 516a5cb448
commit d19690e5bd
1 changed files with 74 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

120
hledger-lib/Hledger/Data/Transaction.hs
View File

@ -53,7 +53,7 @@ module Hledger.Data.Transaction
) where
import Control.Monad.Trans.State (StateT(..), evalStateT)
import Data.Bifunctor (first)
import Data.Bifunctor (first, second)
import Data.Foldable (foldlM)
import Data.Maybe (fromMaybe, isJust, mapMaybe)
import Data.Semigroup (Endo(..))
@ -70,6 +70,7 @@ import Hledger.Data.Dates
import Hledger.Data.Posting
import Hledger.Data.Amount
import Hledger.Data.Valuation
import Data.Decimal (normalizeDecimal, decimalPlaces)
import Data.Functor ((<&>))
@ -229,7 +230,11 @@ transactionAddInferredEquityPostings verbosetags equityAcct t =
type IdxPosting = (Int, Posting)
-- XXX WARNING, the following code is twisty and hard to follow
-- XXX Warning: The following code - for analysing equity conversion postings,
-- inferring missing costs and ignoring redundant costs -
-- is twisty and hard to follow.
label s = ((s <> ": ")++)
-- | Add costs inferred from equity postings in this transaction.
-- For every adjacent pair of conversion postings, it will first search the postings
@ -241,7 +246,6 @@ type IdxPosting = (Int, Posting)
-- the costful and conversion postings, but don't add costs.
transactionInferCostsFromEquity :: Bool -> M.Map AccountName AccountType -> Transaction -> Either String Transaction
transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do
-- number the postings
let npostings = zip [0..] $ tpostings t
@ -253,51 +257,65 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra
-- 1. each pair of conversion postings, and the corresponding postings which balance them, are tagged for easy identification
-- 2. each pair of balancing postings which did't have an explicit cost, have had a cost calculated and added to one of them
-- 3. if any ambiguous situation was detected, an informative error is raised
updateposting <- transformIndexedPostingsF (addCostsToPostings dryrun) conversionPairs otherps
processposting <- transformIndexedPostingsF (addCostsToPostings dryrun) conversionPairs otherps
-- And if there was no error, use it to modify the transaction's postings
return t{tpostings = map (snd . updateposting) npostings}
-- And if there was no error, use it to modify the transaction's postings.
return t{tpostings = map (snd . processposting) npostings}
where
-- A helper to apply addCostsToPostings to each pair of conversion postings,
-- while statefully consuming the other postings.
transformIndexedPostingsF f = evalStateT . fmap (appEndo . foldMap Endo) . traverse f
-- Generate the tricksy processposting function,
-- which when applied to each posting in turn, rather magically has the effect of
-- applying addCostsToPostings to each pair of conversion postings in the transaction,
-- matching them with the other postings, tagging them and perhaps adding cost information to the other postings.
-- General type:
-- transformIndexedPostingsF :: (Monad m, Foldable t, Traversable t) =>
-- (a -> StateT s m (a1 -> a1)) ->
-- t a ->
-- s ->
-- m (a1 -> a1)
-- Concrete type:
transformIndexedPostingsF ::
((IdxPosting, IdxPosting) -> StateT ([IdxPosting],[IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)) -> -- state update function (addCostsToPostings with the bool applied)
[(IdxPosting, IdxPosting)] -> -- initial state: the pairs of adjacent conversion postings in the transaction
([IdxPosting],[IdxPosting]) -> -- initial state: the other postings in the transaction, separated into costful and costless
(Either Text (IdxPosting -> IdxPosting)) -- returns an error message or a posting transform function
transformIndexedPostingsF updatefn = evalStateT . fmap (appEndo . foldMap Endo) . traverse (updatefn)
-- Generate a state-updating function to be used by the above. Approximately:
-- given a pair of conversion postings, and two stateful lists representing the remaining
-- costful and costless other postings,
-- 1. consume two other postings which match the conversion postings
-- 2. add tags to the two conversion postings and the matched other postings
-- 3. add an explicit cost, if there is none, to one of matched other postings
-- or raise an informative error if ambiguity is found, or do nothing, as appropriate.
--
-- Or, if the first argument is true, do a dry run instead:
-- identify and tag
-- the costful and conversion postings, but don't add costs (and if there are no
-- costful postings at all, do nothing).
--
addCostsToPostings :: Bool -> (IdxPosting, IdxPosting)
-> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)
-- A tricksy state update helper for processposting/transformIndexedPostingsF.
-- Approximately: given a pair of conversion postings to match,
-- and lists of the remaining unmatched costful and costless other postings,
-- 1. find (and consume) two other postings which match the two conversion postings
-- 2. add identifying tags to the four postings
-- 3. add an explicit cost, if missing, to one of the matched other postings
-- 4. or if there is a problem, raise an informative error or do nothing as appropriate.
-- Or, if the first argument is true:
-- do a dry run instead: find and consume, add tags, but don't add costs
-- (and if there are no costful postings at all, do nothing).
addCostsToPostings :: Bool -> (IdxPosting, IdxPosting) -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)
addCostsToPostings dryrun' ((n1, cp1), (n2, cp2)) = StateT $ \(costps, otherps) -> do
-- Get the two conversion posting amounts, if possible
ca1 <- conversionPostingAmountNoCost cp1
ca2 <- conversionPostingAmountNoCost cp2
let
-- Approximately: add a cost and/or tag to this posting if appropriate.
transformPostingF np costp (n,p) =
(n, if | n == np -> costp `postingAddTags` [("_price-matched","")]
| n == n1 || n == n2 -> p `postingAddTags` [("_conversion-matched","")]
| otherwise -> p)
-- All costful postings which match the conversion posting pair
matchingCostPs = mapMaybe (mapM $ costfulPostingIfMatchesBothAmounts ca1 ca2) costps
matchingCostPs =
dbg7With (label "matched costful postings".show.length) $
mapMaybe (mapM $ costfulPostingIfMatchesBothAmounts ca1 ca2) costps
-- All other single-commodity postings whose amount matches at least one of the conversion postings,
-- with an explicit cost added. Or in dry run mode, all other single-commodity postings.
matchingOtherPs
| dryrun' = [(n,(p, a)) | (n,p) <- otherps, let Just a = postingSingleAmount p]
| otherwise = mapMaybe (mapM $ addCostIfMatchesOneAmount ca1 ca2) otherps
matchingOtherPs =
dbg7With (label "matched costless postings".show.length) $
if dryrun'
then [(n,(p, a)) | (n,p) <- otherps, let Just a = postingSingleAmount p]
else mapMaybe (mapM $ addCostIfMatchesOneAmount ca1 ca2) otherps
-- A function that adds a cost and/or tag to a numbered posting if appropriate.
postingAddCostAndOrTag np costp (n,p) =
(n, if | n == np -> costp `postingAddTags` [("_price-matched","")]
| n == n1 || n == n2 -> p `postingAddTags` [("_conversion-matched","")]
| otherwise -> p)
-- Annotate any errors with the conversion posting pair
first (annotateWithPostings [cp1, cp2]) $
@ -306,9 +324,9 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra
-- delete it from the list of costful postings in the state, delete the
-- first matching costless posting from the list of costless postings
-- in the state, and return the transformation function with the new state.
| [(np, (costp, _))] <- matchingCostPs
| [(np, costp)] <- matchingCostPs
, Just newcostps <- deleteIdx np costps
-> Right (transformPostingF np costp, (if dryrun' then costps else newcostps, otherps))
-> Right (postingAddCostAndOrTag np costp, (if dryrun' then costps else newcostps, otherps))
-- If no costful postings match the conversion postings, but some
-- of the costless postings match, check that the first such posting has a
@ -317,9 +335,9 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra
-- and return the transformation function with the new state.
| [] <- matchingCostPs
, (np, (costp, amt)):nps <- matchingOtherPs
, not $ any (amountMatches amt . snd . snd) nps
, not $ any (amountsMatch amt . snd . snd) nps
, Just newotherps <- deleteIdx np otherps
-> Right (transformPostingF np costp, (costps, if dryrun' then otherps else newotherps))
-> Right (postingAddCostAndOrTag np costp, (costps, if dryrun' then otherps else newotherps))
-- Otherwise, do nothing, leaving the transaction unchanged.
-- We don't want to be over-zealous reporting problems here
@ -329,12 +347,16 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra
-- If a posting with cost matches both the conversion amounts, return it along
-- with the matching amount which must be present in another non-conversion posting.
costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
costfulPostingIfMatchesBothAmounts a1 a2 p = do
a@Amount{aprice=Just _} <- postingSingleAmount p
if | amountMatches (-a1) a && amountMatches a2 (amountCost a) -> Just (p, -a2)
| amountMatches (-a2) a && amountMatches a1 (amountCost a) -> Just (p, -a1)
costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe Posting
costfulPostingIfMatchesBothAmounts a1 a2 costfulp = do
a@Amount{aprice=Just _} <- postingSingleAmount costfulp
if
| dbgamtmatch 1 a1 a (amountsMatch (-a1) a) && dbgcostmatch 2 a2 a (amountsMatch a2 (amountCost a)) -> Just costfulp
| dbgamtmatch 2 a2 a (amountsMatch (-a2) a) && dbgcostmatch 1 a1 a (amountsMatch a1 (amountCost a)) -> Just costfulp
| otherwise -> Nothing
where
dbgamtmatch n a b = dbg7 ("conversion posting " <>show n<>" "<>showAmount a<>" balances amount "<>showAmountWithoutPrice b <>" of costful posting "<>showAmount b<>" at precision "<>amountShowPrecision a<>" ?")
dbgcostmatch n a b = dbg7 ("and\nconversion posting "<>show n<>" "<>showAmount a<>" matches cost " <>showAmount (amountCost b)<>" of costful posting "<>showAmount b<>" at precision "<>amountShowPrecision a<>" ?")
-- Add a cost to a posting if it matches (negative) one of the
-- supplied conversion amounts, adding the other amount as the cost.
@ -342,9 +364,10 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra
addCostIfMatchesOneAmount a1 a2 p = do
a <- postingSingleAmount p
let newp cost = p{pamount = mixedAmount a{aprice = Just $ TotalPrice cost}}
if | amountMatches (-a1) a -> Just (newp a2, a2)
| amountMatches (-a2) a -> Just (newp a1, a1)
| otherwise -> Nothing
if
| amountsMatch (-a1) a -> Just (newp a2, a2)
| amountsMatch (-a2) a -> Just (newp a1, a1)
| otherwise -> Nothing
-- Get the single-commodity costless amount from a conversion posting, or raise an error.
conversionPostingAmountNoCost p = case postingSingleAmount p of
@ -368,6 +391,11 @@ transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTra
deleteUniqueMatch _ [] = Nothing
annotateWithPostings xs str = T.unlines $ str : postingsAsLines False xs
amountShowPrecision a =
case asprecision $ astyle a of
Precision n -> show n
NaturalPrecision -> show $ decimalPlaces $ normalizeDecimal $ aquantity a
-- Using the provided account types map, sort the given indexed postings
-- into three lists of posting numbers (stored in two pairs), like so:
-- (conversion postings, (costful other postings, costless other postings)).