diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index 52dedcd8e..0cc8e4c16 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -27,6 +27,7 @@ module Hledger.Data.Journal ( journalToCost, journalAddInferredEquityPostings, journalInferCostsFromEquity, + journalMarkRedundantCosts, journalReverse, journalSetLastReadTime, journalRenumberAccountDeclarations, @@ -884,7 +885,17 @@ journalAddInferredEquityPostings j = journalMapTransactions (transactionAddInfer -- See hledger manual > Inferring cost from equity postings. journalInferCostsFromEquity :: Journal -> Either String Journal journalInferCostsFromEquity j = do - ts <- mapM (transactionInferCostsFromEquity $ jaccounttypes j) $ jtxns j + ts <- mapM (transactionInferCostsFromEquity False $ jaccounttypes j) $ jtxns j + return j{jtxns=ts} + +-- | Do just the internal tagging that is normally done by journalInferCostsFromEquity, +-- identifying equity conversion postings and, in particular, postings which have redundant costs. +-- Tagging the latter is useful as it allows them to be ignored during transaction balancedness checking. +-- And that allows journalInferCostsFromEquity to be postponed till after transaction balancing, +-- when it will have more information (amounts) to work with. +journalMarkRedundantCosts :: Journal -> Either String Journal +journalMarkRedundantCosts j = do + ts <- mapM (transactionInferCostsFromEquity True $ jaccounttypes j) $ jtxns j return j{jtxns=ts} -- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 42f5f2e08..1284170ff 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -225,17 +225,20 @@ transactionAddInferredEquityPostings :: AccountName -> Transaction -> Transactio transactionAddInferredEquityPostings equityAcct t = t{tpostings=concatMap (postingAddInferredEquityPostings equityAcct) $ tpostings t} +type IdxPosting = (Int, Posting) + +-- WARNING: twisty code ahead + -- | Add costs inferred from equity postings in this transaction. -- For every adjacent pair of conversion postings, it will first search the postings -- with costs to see if any match. If so, it will tag these as matched. -- If no postings with costs match, it will then search the postings without costs, -- and will match the first such posting which matches one of the conversion amounts. -- If it finds a match, it will add a cost and then tag it. -type IdxPosting = (Int, Posting) -transactionInferCostsFromEquity :: M.Map AccountName AccountType -> Transaction -> Either String Transaction -transactionInferCostsFromEquity acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do +transactionInferCostsFromEquity :: Bool -> M.Map AccountName AccountType -> Transaction -> Either String Transaction +transactionInferCostsFromEquity dryrun acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do (conversionPairs, stateps) <- partitionPs npostings - f <- transformIndexedPostingsF addCostsToPostings conversionPairs stateps + f <- transformIndexedPostingsF (addCostsToPostings dryrun) conversionPairs stateps return t{tpostings = map (snd . f) npostings} where -- Include indices for postings @@ -258,21 +261,26 @@ transactionInferCostsFromEquity acctTypes t = first (annotateErrorWithTransactio -- and tags the conversion and matched postings. Then update the state by removing the -- matched postings. If there are no matching postings or too much ambiguity, -- return an error string annotated with the conversion postings. - addCostsToPostings :: (IdxPosting, IdxPosting) + -- If the first argument is true, do a dry run instead: identify and tag + -- the costful and conversion postings, but don't add costs. + addCostsToPostings :: Bool -> (IdxPosting, IdxPosting) -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting) - addCostsToPostings ((n1, cp1), (n2, cp2)) = StateT $ \(costps, otherps) -> do + addCostsToPostings dryrun' ((n1, cp1), (n2, cp2)) = StateT $ \(costps, otherps) -> do -- Get the two conversion posting amounts, if possible - ca1 <- postingAmountNoCost cp1 - ca2 <- postingAmountNoCost cp2 + ca1 <- conversionPostingAmountNoCost cp1 + ca2 <- conversionPostingAmountNoCost cp2 let -- The function to add costs and tag postings in the indexed list of postings transformPostingF np costp (n,p) = (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) -- All costful postings which match the conversion posting pair matchingCostPs = mapMaybe (mapM $ costfulPostingIfMatchesBothAmounts ca1 ca2) costps - -- All other postings which match at least one of the conversion posting pair - matchingOtherPs = mapMaybe (mapM $ addCostIfMatchesOneAmount ca1 ca2) otherps + -- All other postings which match at least one of the conversion posting pair. + -- Add a corresponding cost to these postings, unless in dry run mode. + matchingOtherPs + | dryrun' = [(n,(p, a)) | (n,p) <- otherps, let Just a = postingSingleAmount p] + | otherwise = mapMaybe (mapM $ addCostIfMatchesOneAmount ca1 ca2) otherps -- Annotate any errors with the conversion posting pair first (annotateWithPostings [cp1, cp2]) $ @@ -282,7 +290,7 @@ transactionInferCostsFromEquity acctTypes t = first (annotateErrorWithTransactio -- in the state, and return the transformation function with the new state. | [(np, (costp, _))] <- matchingCostPs , Just newcostps <- deleteIdx np costps - -> Right (transformPostingF np costp, (newcostps, otherps)) + -> Right (transformPostingF 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 -- different amount from all the others, and if so add a cost to it, @@ -292,7 +300,7 @@ transactionInferCostsFromEquity acctTypes t = first (annotateErrorWithTransactio , (np, (costp, amt)):nps <- matchingOtherPs , not $ any (amountMatches amt . snd . snd) nps , Just newotherps <- deleteIdx np otherps - -> Right (transformPostingF np costp, (costps, newotherps)) + -> Right (transformPostingF np costp, (costps, if dryrun' then otherps else newotherps)) -- 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:" @@ -315,14 +323,18 @@ transactionInferCostsFromEquity acctTypes t = first (annotateErrorWithTransactio | amountMatches (-a2) a -> Just (newp a1, a1) | otherwise -> Nothing - hasCost p = isJust $ aprice =<< postingSingleAmount p - postingAmountNoCost p = case postingSingleAmount p of + -- Get the single-commodity costless amount from a conversion posting, or raise an error. + conversionPostingAmountNoCost p = case postingSingleAmount p of Just a@Amount{aprice=Nothing} -> Right a - _ -> Left $ annotateWithPostings [p] "The posting must only have a single amount with no cost" + Just Amount{aprice=Just _} -> Left $ annotateWithPostings [p] "Conversion postings must not have a cost:" + Nothing -> Left $ annotateWithPostings [p] "Conversion postings must have a single-commodity amount:" + + -- Get a posting's amount if it is single-commodity. postingSingleAmount p = case amountsRaw (pamount p) of [a] -> Just a _ -> Nothing + hasCost p = isJust $ aprice =<< postingSingleAmount p amountMatches a b = acommodity a == acommodity b && aquantity a == aquantity b isConversion p = M.lookup (paccount p) acctTypes == Just Conversion