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

lib: transactionInferCostsFromEquity: adjust to "cost" terminology

Browse Source
This commit is contained in:
Simon Michael 2023-01-20 21:25:30 -10:00
parent 5ca8752e48
commit e5f3c0ecdb
1 changed files with 44 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -235,90 +235,90 @@ type IdxPosting = (Int, Posting)
transactionInferCostsFromEquity :: M.Map AccountName AccountType -> Transaction -> Either String Transaction transactionInferCostsFromEquity :: M.Map AccountName AccountType -> Transaction -> Either String Transaction
transactionInferCostsFromEquity acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do transactionInferCostsFromEquity acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do
(conversionPairs, stateps) <- partitionPs npostings (conversionPairs, stateps) <- partitionPs npostings
f <- transformIndexedPostingsF addPricesToPostings conversionPairs stateps f <- transformIndexedPostingsF addCostsToPostings conversionPairs stateps
return t{tpostings = map (snd . f) npostings} return t{tpostings = map (snd . f) npostings}
where where
-- Include indices for postings -- Include indices for postings
npostings = zip [0..] $ tpostings t npostings = zip [0..] $ tpostings t
transformIndexedPostingsF f = evalStateT . fmap (appEndo . foldMap Endo) . traverse f transformIndexedPostingsF f = evalStateT . fmap (appEndo . foldMap Endo) . traverse f
-- Sort postings into pairs of conversion postings, transaction price postings, and other postings -- Sort postings into pairs of conversion postings, costful postings, and other postings
partitionPs = fmap fst . foldrM select (([], ([], [])), Nothing) partitionPs = fmap fst . foldrM select (([], ([], [])), Nothing)
select np@(_, p) ((cs, others@(ps, os)), Nothing) select np@(_, p) ((cs, others@(ps, os)), Nothing)
| isConversion p = Right ((cs, others), Just np) | isConversion p = Right ((cs, others), Just np)
| hasPrice p = Right ((cs, (np:ps, os)), Nothing) | hasCost p = Right ((cs, (np:ps, os)), Nothing)
| otherwise = Right ((cs, (ps, np:os)), Nothing) | otherwise = Right ((cs, (ps, np:os)), Nothing)
select np@(_, p) ((cs, others), Just lst) select np@(_, p) ((cs, others), Just lst)
| isConversion p = Right (((lst, np):cs, others), Nothing) | isConversion p = Right (((lst, np):cs, others), Nothing)
| otherwise = Left "Conversion postings must occur in adjacent pairs" | otherwise = Left "Conversion postings must occur in adjacent pairs"
-- Given a pair of indexed conversion postings, and a state consisting of lists of -- Given a pair of indexed conversion postings, and a state consisting of lists of
-- priced and unpriced non-conversion postings, create a function which adds transaction -- costful and costless non-conversion postings, create a function which adds a conversion cost
-- prices to the posting which matches the conversion postings if necessary, and tags -- to the posting which matches the conversion postings if necessary,
-- the conversion and matched postings. Then update the state by removing the matched -- and tags the conversion and matched postings. Then update the state by removing the
-- postings. If there are no matching postings or too much ambiguity, return an error -- matched postings. If there are no matching postings or too much ambiguity,
-- string annotated with the conversion postings. -- return an error string annotated with the conversion postings.
addPricesToPostings :: (IdxPosting, IdxPosting) addCostsToPostings :: (IdxPosting, IdxPosting)
-> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting) -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)
addPricesToPostings ((n1, cp1), (n2, cp2)) = StateT $ \(priceps, otherps) -> do addCostsToPostings ((n1, cp1), (n2, cp2)) = StateT $ \(costps, otherps) -> do
-- Get the two conversion posting amounts, if possible -- Get the two conversion posting amounts, if possible
ca1 <- postingAmountNoPrice cp1 ca1 <- postingAmountNoCost cp1
ca2 <- postingAmountNoPrice cp2 ca2 <- postingAmountNoCost cp2
let -- The function to add transaction prices and tag postings in the indexed list of postings let -- The function to add costs and tag postings in the indexed list of postings
transformPostingF np pricep (n,p) = transformPostingF np costp (n,p) =
(n, if | n == np -> pricep `postingAddTags` [("_price-matched","")] (n, if | n == np -> costp `postingAddTags` [("_price-matched","")]
| n == n1 || n == n2 -> p `postingAddTags` [("_conversion-matched","")] | n == n1 || n == n2 -> p `postingAddTags` [("_conversion-matched","")]
| otherwise -> p) | otherwise -> p)
-- All priced postings which match the conversion posting pair -- All costful postings which match the conversion posting pair
matchingPricePs = mapMaybe (mapM $ pricedPostingIfMatchesBothAmounts ca1 ca2) priceps matchingCostPs = mapMaybe (mapM $ costfulPostingIfMatchesBothAmounts ca1 ca2) costps
-- All other postings which match at least one of the conversion posting pair -- All other postings which match at least one of the conversion posting pair
matchingOtherPs = mapMaybe (mapM $ addPriceIfMatchesOneAmount ca1 ca2) otherps matchingOtherPs = mapMaybe (mapM $ addCostIfMatchesOneAmount ca1 ca2) otherps
-- Annotate any errors with the conversion posting pair -- Annotate any errors with the conversion posting pair
first (annotateWithPostings [cp1, cp2]) $ first (annotateWithPostings [cp1, cp2]) $
if -- If a single transaction price posting matches the conversion postings, if -- If a single costful posting matches the conversion postings,
-- delete it from the list of priced postings in the state, delete the -- delete it from the list of costful postings in the state, delete the
-- first matching unpriced posting from the list of non-priced postings -- first matching costless posting from the list of costless postings
-- in the state, and return the transformation function with the new state. -- in the state, and return the transformation function with the new state.
| [(np, (pricep, _))] <- matchingPricePs | [(np, (costp, _))] <- matchingCostPs
, Just newpriceps <- deleteIdx np priceps , Just newcostps <- deleteIdx np costps
-> Right (transformPostingF np pricep, (newpriceps, otherps)) -> Right (transformPostingF np costp, (newcostps, otherps))
-- If no transaction price postings match the conversion postings, but some -- If no costful postings match the conversion postings, but some
-- of the unpriced postings match, check that the first such posting has a -- of the costless postings match, check that the first such posting has a
-- different amount from all the others, and if so add a transaction price to -- different amount from all the others, and if so add a cost to it,
-- it, then delete it from the list of non-priced postings in the state, and -- then delete it from the list of costless postings in the state,
-- return the transformation function with the new state. -- and return the transformation function with the new state.
| [] <- matchingPricePs | [] <- matchingCostPs
, (np, (pricep, amt)):nps <- matchingOtherPs , (np, (costp, amt)):nps <- matchingOtherPs
, not $ any (amountMatches amt . snd . snd) nps , not $ any (amountMatches amt . snd . snd) nps
, Just newotherps <- deleteIdx np otherps , Just newotherps <- deleteIdx np otherps
-> Right (transformPostingF np pricep, (priceps, newotherps)) -> Right (transformPostingF np costp, (costps, newotherps))
-- Otherwise it's too ambiguous to make a guess, so return an error. -- Otherwise it's too ambiguous to make a guess, so return an error.
| otherwise -> Left "There is not a unique posting which matches the conversion posting pair:" | otherwise -> Left "There is not a unique posting which matches the conversion posting pair:"
-- If a posting with transaction price matches both the conversion amounts, return it along -- 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. -- with the matching amount which must be present in another non-conversion posting.
pricedPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe (Posting, Amount) costfulPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
pricedPostingIfMatchesBothAmounts a1 a2 p = do costfulPostingIfMatchesBothAmounts a1 a2 p = do
a@Amount{aprice=Just _} <- postingSingleAmount p a@Amount{aprice=Just _} <- postingSingleAmount p
if | amountMatches (-a1) a && amountMatches a2 (amountCost a) -> Just (p, -a2) if | amountMatches (-a1) a && amountMatches a2 (amountCost a) -> Just (p, -a2)
| amountMatches (-a2) a && amountMatches a1 (amountCost a) -> Just (p, -a1) | amountMatches (-a2) a && amountMatches a1 (amountCost a) -> Just (p, -a1)
| otherwise -> Nothing | otherwise -> Nothing
-- Add a transaction price to a posting if it matches (negative) one of the -- Add a cost to a posting if it matches (negative) one of the
-- supplied conversion amounts, adding the other amount as the price -- supplied conversion amounts, adding the other amount as the cost.
addPriceIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount) addCostIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
addPriceIfMatchesOneAmount a1 a2 p = do addCostIfMatchesOneAmount a1 a2 p = do
a <- postingSingleAmount p a <- postingSingleAmount p
let newp price = p{pamount = mixedAmount a{aprice = Just $ TotalPrice price}} let newp cost = p{pamount = mixedAmount a{aprice = Just $ TotalPrice cost}}
if | amountMatches (-a1) a -> Just (newp a2, a2) if | amountMatches (-a1) a -> Just (newp a2, a2)
| amountMatches (-a2) a -> Just (newp a1, a1) | amountMatches (-a2) a -> Just (newp a1, a1)
| otherwise -> Nothing | otherwise -> Nothing
hasPrice p = isJust $ aprice =<< postingSingleAmount p hasCost p = isJust $ aprice =<< postingSingleAmount p
postingAmountNoPrice p = case postingSingleAmount p of postingAmountNoCost p = case postingSingleAmount p of
Just a@Amount{aprice=Nothing} -> Right a Just a@Amount{aprice=Nothing} -> Right a
_ -> Left $ annotateWithPostings [p] "The posting must only have a single amount with no transaction price" _ -> Left $ annotateWithPostings [p] "The posting must only have a single amount with no cost"
postingSingleAmount p = case amountsRaw (pamount p) of postingSingleAmount p = case amountsRaw (pamount p) of
[a] -> Just a [a] -> Just a
_ -> Nothing _ -> Nothing
@ -333,6 +333,7 @@ transactionInferCostsFromEquity acctTypes t = first (annotateErrorWithTransactio
-- still be more efficient than using a Map or another data structure. Even monster -- still be more efficient than using a Map or another data structure. Even monster
-- transactions with up to 10 postings, which are generally not a good -- transactions with up to 10 postings, which are generally not a good
-- idea, are still too small for there to be an advantage. -- idea, are still too small for there to be an advantage.
-- XXX shouldn't assume transactions have few postings
deleteIdx n = deleteUniqueMatch ((n==) . fst) deleteIdx n = deleteUniqueMatch ((n==) . fst)
deleteUniqueMatch p (x:xs) | p x = if any p xs then Nothing else Just xs deleteUniqueMatch p (x:xs) | p x = if any p xs then Nothing else Just xs
| otherwise = (x:) <$> deleteUniqueMatch p xs | otherwise = (x:) <$> deleteUniqueMatch p xs