imp: cost: Allow matching equity conversion equity postings to

transaction prices.

When given --infer-costs, hledger will now separately infer transaction
prices for different prices. Given a pair of adjacent conversion
postings, hledger will check if there is a single posting with a
transaction price which matches both the amounts. If so, it associates
those conversion postings to that priced post.

If it can't find any transaction price postings which match, it will
find the first non-transaction price post which matches one of the two
amounts, and will add a transaction price to that, and associate them.

Author: Xitian9

hledger-lib/Hledger/Data/Balancing.hs

@@ -97,16 +97,18 @@ transactionCheckBalanced BalancingOpts{commodity_styles_} t = errs
 
     -- check for mixed signs, detecting nonzeros at display precision
     canonicalise = maybe id canonicaliseMixedAmount commodity_styles_
+    postingBalancingAmount p
+      | "_price-matched" `elem` map fst (ptags p) = mixedAmountStripPrices $ pamount p
+      | otherwise                                 = mixedAmountCost $ pamount p
     signsOk ps =
-      case filter (not.mixedAmountLooksZero) $ map (canonicalise.mixedAmountCost.pamount) ps of
+      case filter (not.mixedAmountLooksZero) $ map (canonicalise.postingBalancingAmount) ps of
         nonzeros | length nonzeros >= 2
                    -> length (nubSort $ mapMaybe isNegativeMixedAmount nonzeros) > 1
         _          -> True
     (rsignsok, bvsignsok)       = (signsOk rps, signsOk bvps)
 
     -- check for zero sum, at display precision
-    (rsum, bvsum)               = (sumPostings rps, sumPostings bvps)
-    (rsumcost, bvsumcost)       = (mixedAmountCost rsum, mixedAmountCost bvsum)
+    (rsumcost, bvsumcost)       = (foldMap postingBalancingAmount rps, foldMap postingBalancingAmount bvps)
     (rsumdisplay, bvsumdisplay) = (canonicalise rsumcost, canonicalise bvsumcost)
     (rsumok, bvsumok)           = (mixedAmountLooksZero rsumdisplay, mixedAmountLooksZero bvsumdisplay)
 

hledger-lib/Hledger/Data/Journal.hs

@@ -951,8 +951,10 @@ journalAddInferredEquityPostings j = journalMapTransactions (transactionAddInfer
     equityAcct = journalConversionAccount j
 
 -- | Add inferred transaction prices from equity postings.
-journalAddPricesFromEquity :: Journal -> Journal
-journalAddPricesFromEquity j = journalMapTransactions (transactionAddPricesFromEquity $ jaccounttypes j) j
+journalAddPricesFromEquity :: Journal -> Either String Journal
+journalAddPricesFromEquity j = do
+    ts <- mapM (transactionAddPricesFromEquity $ jaccounttypes j) $ jtxns j
+    return j{jtxns=ts}
 
 -- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol.
 -- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol

hledger-lib/Hledger/Data/Posting.hs

@@ -423,22 +423,23 @@ postingApplyValuation priceoracle styles periodlast today v p =
 postingToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Posting -> Maybe Posting
 postingToCost _      NoConversionOp p = Just p
 postingToCost styles ToCost         p
-  | ("_matched-conversion-posting","") `elem` ptags p = Nothing
-  | otherwise = Just $ postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p
+    -- If this is a conversion posting with a matched transaction price posting, ignore it
+    | "_conversion-matched" `elem` map fst (ptags p) && noCost = Nothing
+    | otherwise = Just $ postingTransformAmount (styleMixedAmount styles . mixedAmountCost) p
+  where
+    noCost = null . filter (isJust . aprice) . amountsRaw $ pamount p
 
 -- | Generate inferred equity postings from a 'Posting' using transaction prices.
 -- Make sure not to generate equity postings when there are already matched
 -- conversion postings.
 postingAddInferredEquityPostings :: Text -> Posting -> [Posting]
 postingAddInferredEquityPostings equityAcct p
-    | ("_matched-transaction-price","") `elem` ptags p = [p]
+    | "_price-matched" `elem` map fst (ptags p) = [p]
     | otherwise = taggedPosting : concatMap conversionPostings priceAmounts
   where
     taggedPosting
       | null priceAmounts = p
-      | otherwise         = p{ pcomment = pcomment p `commentAddTag` priceTag
-                             , ptags = priceTag : ptags p
-                             }
+      | otherwise         = p{ ptags = ("_price-matched","") : ptags p }
     conversionPostings amt = case aprice amt of
         Nothing -> []
         Just _  -> [ cp{ paccount = accountPrefix <> amtCommodity
@@ -453,15 +454,14 @@ postingAddInferredEquityPostings equityAcct p
         amtCommodity  = commodity amt
         costCommodity = commodity cost
         cp = p{ pcomment = pcomment p `commentAddTag` ("generated-posting","")
-              , ptags = [("generated-posting", ""), ("_generated-posting", "")]
+              , ptags = [("_conversion-matched", ""), ("generated-posting", ""), ("_generated-posting", "")]
               , pbalanceassertion = Nothing
               , poriginal = Nothing
               }
         accountPrefix = mconcat [ equityAcct, ":", T.intercalate "-" $ sort [amtCommodity, costCommodity], ":"]
         -- Take the commodity of an amount and collapse consecutive spaces to a single space
         commodity = T.unwords . filter (not . T.null) . T.words . acommodity
 
-    priceTag = ("cost", T.strip . wbToText $ foldMap showAmountPrice priceAmounts)
     priceAmounts = filter (isJust . aprice) . amountsRaw $ pamount p
 
 -- | Make a market price equivalent to this posting's amount's unit

hledger-lib/Hledger/Data/Transaction.hs

@@ -7,8 +7,10 @@ tags.
 
 -}
 
+{-# LANGUAGE MultiWayIf        #-}
 {-# LANGUAGE NamedFieldPuns    #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TupleSections     #-}
 
 module Hledger.Data.Transaction
 ( -- * Transaction
@@ -44,18 +46,23 @@ module Hledger.Data.Transaction
 , showTransactionOneLineAmounts
 , showTransactionLineFirstPart
 , transactionFile
+  -- * transaction errors
+, annotateErrorWithTransaction
   -- * tests
 , tests_Transaction
 ) where
 
-import Data.Bifunctor (second)
-import Data.Maybe (fromMaybe, mapMaybe)
+import Control.Monad.Trans.State (StateT(..), evalStateT)
+import Data.Bifunctor (first)
+import Data.Foldable (foldrM)
+import Data.Maybe (fromMaybe, isJust, mapMaybe)
+import Data.Semigroup (Endo(..))
 import Data.Text (Text)
+import qualified Data.Map as M
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as TL
 import qualified Data.Text.Lazy.Builder as TB
 import Data.Time.Calendar (Day, fromGregorian)
-import qualified Data.Map as M
 
 import Hledger.Utils
 import Hledger.Data.Types
@@ -219,34 +226,120 @@ transactionAddInferredEquityPostings :: AccountName -> Transaction -> Transactio
 transactionAddInferredEquityPostings equityAcct t =
     t{tpostings=concatMap (postingAddInferredEquityPostings equityAcct) $ tpostings t}
 
--- | Add inferred transaction prices from equity postings. The transaction
--- price will be added to the first posting whose amount is the negation of one
--- of the (exactly) two conversion postings, if it exists.
-transactionAddPricesFromEquity :: M.Map AccountName AccountType -> Transaction -> Transaction
-transactionAddPricesFromEquity acctTypes t
-    | [(n1, cp1), (n2, cp2)] <- conversionps                                  -- Exactly two conversion postings with indices
-    , Just ca1 <- maybePostingAmount cp1, Just ca2 <- maybePostingAmount cp2  -- Each conversion posting has exactly one amount
-    , (np,pricep):_ <- mapMaybe (maybeAddPrice ca1 ca2) npostings             -- Get the first posting which matches one of the conversion postings
-    , let subPosting (n, p) = if n == np then pricep else if n == n1 then cp1 else if n == n2 then cp2 else p
-    = t{tpostings = map subPosting npostings}
-    | otherwise = t
+-- | Add inferred transaction prices from equity postings. For every adjacent
+-- pair of conversion postings, it will first search the postings with
+-- transaction prices to see if any match. If so, it will tag it as matched.
+-- If no postings with transaction prices match, it will then search the
+-- postings without transaction prices, and will match the first such posting
+-- which matches one of the conversion amounts. If it finds a match, it will
+-- add a transaction price and then tag it.
+type IdxPosting = (Int, Posting)
+transactionAddPricesFromEquity :: M.Map AccountName AccountType -> Transaction -> Either String Transaction
+transactionAddPricesFromEquity acctTypes t = first (annotateErrorWithTransaction t . T.unpack) $ do
+    (conversionPairs, stateps) <- partitionPs npostings
+    f <- transformIndexedPostingsF addPricesToPostings conversionPairs stateps
+    return t{tpostings = map (snd . f) npostings}
   where
-    maybeAddPrice a1 a2 (n,p)
-        | Just a <- mpamt, amountMatches (-a1) a = Just (n, markPosting p{pamount = mixedAmount a{aprice = Just $ TotalPrice a2}})
-        | Just a <- mpamt, amountMatches (-a2) a = Just (n, markPosting p{pamount = mixedAmount a{aprice = Just $ TotalPrice a1}})
-        | otherwise = Nothing
-      where
-        mpamt = maybePostingAmount p
-
-    conversionps = map (second (`postingAddTags` [("_matched-conversion-posting","")]))
-                 $ filter (\(_,p) -> M.lookup (paccount p) acctTypes == Just Conversion) npostings
-    markPosting = (`postingAddTags` [("_matched-transaction-price","")])
+    -- Include indices for postings
     npostings = zip [0..] $ tpostings t
+    transformIndexedPostingsF f = evalStateT . fmap (appEndo . foldMap Endo) . traverse f
+
+    -- Sort postings into pairs of conversion postings, transaction price postings, and other postings
+    partitionPs = fmap fst . foldrM select (([], ([], [])), Nothing)
+    select np@(_, p) ((cs, others@(ps, os)), Nothing)
+      | isConversion p = Right ((cs, others),      Just np)
+      | hasPrice p     = Right ((cs, (np:ps, os)), Nothing)
+      | otherwise      = Right ((cs, (ps, np:os)), Nothing)
+    select np@(_, p) ((cs, others), Just last)
+      | isConversion p = Right (((last, np):cs, others), Nothing)
+      | otherwise      = Left "Conversion postings must occur in adjacent pairs"
+
+    -- 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
+    -- prices to the posting which matches the conversion postings if necessary, 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.
+    addPricesToPostings :: (IdxPosting, IdxPosting)
+                        -> StateT ([IdxPosting], [IdxPosting]) (Either Text) (IdxPosting -> IdxPosting)
+    addPricesToPostings ((n1, cp1), (n2, cp2)) = StateT $ \(priceps, otherps) -> do
+        -- Get the two conversion posting amounts, if possible
+        ca1 <- postingAmountNoPrice cp1
+        ca2 <- postingAmountNoPrice cp2
+        let -- The function to add transaction prices and tag postings in the indexed list of postings
+            transformPostingF np pricep = \(n, p) ->
+                (n, if | n == np            -> pricep `postingAddTags` [("_price-matched","")]
+                       | n == n1 || n == n2 -> p      `postingAddTags` [("_conversion-matched","")]
+                       | otherwise          -> p)
+            -- All priced postings which match the conversion posting pair
+            matchingPricePs = mapMaybe (mapM $ pricedPostingIfMatchesBothAmounts ca1 ca2) priceps
+            -- All other postings which match at least one of the conversion posting pair
+            matchingOtherPs = mapMaybe (mapM $ addPriceIfMatchesOneAmount ca1 ca2) otherps
+
+        -- Annotate any errors with the conversion posting pair
+        first (annotateWithPostings [cp1, cp2]) $
+            if -- If a single transaction price posting matches the conversion postings,
+               -- delete it from the list of priced postings in the state, delete the
+               -- first matching unpriced posting from the list of non-priced postings
+               -- in the state, and return the transformation function with the new state.
+               | [(np, (pricep, _))] <- matchingPricePs
+               , Just newpriceps <- deleteIdx np priceps
+                   -> Right (transformPostingF np pricep, (newpriceps, otherps))
+               -- If no transaction price postings match the conversion postings, but some
+               -- of the unpriced postings match, check that the first such posting has a
+               -- different amount from all the others, and if so add a transaction price to
+               -- it, then delete it from the list of non-priced postings in the state, and
+               -- return the transformation function with the new state.
+               | [] <- matchingPricePs
+               , (np, (pricep, amt)):nps <- matchingOtherPs
+               , not $ any (amountMatches amt . snd . snd) nps
+               , Just newotherps <- deleteIdx np otherps
+                   -> Right (transformPostingF np pricep, (priceps, 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:"
+
+    -- If a posting with transaction price matches both the conversion amounts, return it along
+    -- with the matching amount which must be present in another non-conversion posting.
+    pricedPostingIfMatchesBothAmounts :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
+    pricedPostingIfMatchesBothAmounts 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)
+           | otherwise -> Nothing
+
+    -- Add a transaction price to a posting if it matches (negative) one of the
+    -- supplied conversion amounts, adding the other amount as the price
+    addPriceIfMatchesOneAmount :: Amount -> Amount -> Posting -> Maybe (Posting, Amount)
+    addPriceIfMatchesOneAmount a1 a2 p = do
+        a <- postingSingleAmount p
+        let newp price = p{pamount = mixedAmount a{aprice = Just $ TotalPrice price}}
+        if | amountMatches (-a1) a -> Just (newp a2, a2)
+           | amountMatches (-a2) a -> Just (newp a1, a1)
+           | otherwise             -> Nothing
+
+    hasPrice p = isJust $ aprice =<< postingSingleAmount p
+    postingAmountNoPrice 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 transaction price"
+    postingSingleAmount p = case amountsRaw (pamount p) of
+        [a] -> Just a
+        _   -> Nothing
 
-    maybePostingAmount p = case amountsRaw $ pamount p of
-        [a@Amount{aprice=Nothing}] -> Just a
-        _                          -> Nothing
     amountMatches a b = acommodity a == acommodity b && aquantity a == aquantity b
+    isConversion p = M.lookup (paccount p) acctTypes == Just Conversion
+
+    -- Delete a posting from the indexed list of postings based on either its
+    -- index or its posting amount.
+    -- Note: traversing the whole list to delete a single match is generally not efficient,
+    -- but given that a transaction probably doesn't have more than four postings, it should
+    -- 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
+    -- idea, are still too small for there to be an advantage.
+    deleteIdx n = deleteUniqueMatch ((n==) . fst)
+    deleteUniqueMatch p (x:xs) | p x       = if any p xs then Nothing else Just xs
+                               | otherwise = (x:) <$> deleteUniqueMatch p xs
+    deleteUniqueMatch _ []                 = Nothing
+    annotateWithPostings xs str = T.unlines $ str : postingsAsLines False xs
 
 -- | Apply some account aliases to all posting account names in the transaction, as described by accountNameApplyAliases.
 -- This can fail due to a bad replacement pattern in a regular expression alias.
@@ -268,6 +361,13 @@ transactionMapPostingAmounts f  = transactionMapPostings (postingTransformAmount
 transactionFile :: Transaction -> FilePath
 transactionFile Transaction{tsourcepos} = sourceName $ fst tsourcepos
 
+-- Add transaction information to an error message.
+annotateErrorWithTransaction :: Transaction -> String -> String
+annotateErrorWithTransaction t s =
+  unlines [ sourcePosPairPretty $ tsourcepos t, s
+          , T.unpack . T.stripEnd $ showTransaction t
+          ]
+
 -- tests
 
 tests_Transaction :: TestTree

hledger-lib/Hledger/Read/Common.hs

@@ -320,9 +320,9 @@ journalFinalise iopts@InputOpts{..} f txt pj = do
       >>= (if auto_ && not (null $ jtxnmodifiers pj)
               then journalAddAutoPostings _ioDay balancingopts_  -- Add auto postings if enabled, and account tags if needed
               else pure)
-      >>= journalBalanceTransactions balancingopts_      -- Balance all transactions and maybe check balance assertions.
-      <$> (if infer_costs_  then journalAddPricesFromEquity else id)        -- Add inferred transaction prices from equity postings, if present
-      <&> (if infer_equity_ then journalAddInferredEquityPostings else id)  -- Add inferred equity postings, after balancing transactions and generating auto postings
+      >>= (if infer_costs_  then journalAddPricesFromEquity else pure)      -- Add inferred transaction prices from equity postings, if present
+      >>= journalBalanceTransactions balancingopts_                         -- Balance all transactions and maybe check balance assertions.
+      <&> (if infer_equity_ then journalAddInferredEquityPostings else id)  -- Add inferred equity postings, after balancing and generating auto postings
       <&> journalInferMarketPricesFromTransactions       -- infer market prices from commodity-exchanging transactions
     when strict_ $ do
       journalCheckAccounts j                     -- If in strict mode, check all postings are to declared accounts

hledger/Hledger/Cli/Commands/Close.hs

@@ -14,6 +14,7 @@ import Data.Maybe (fromMaybe)
 import qualified Data.Text as T
 import qualified Data.Text.IO as T
 import Data.Time.Calendar (addDays)
+import Lens.Micro ((^.))
 import System.Console.CmdArgs.Explicit as C
 
 import Hledger
@@ -48,7 +49,7 @@ closemode = hledgerCommandMode
 
 -- debugger, beware: close is incredibly devious. simple rules combine to make a horrid maze.
 -- tests are in hledger/test/close.test.
-close CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do
+close copts@CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do
   let
     -- show opening entry, closing entry, or (default) both ?
     (opening, closing) =
@@ -101,7 +102,7 @@ close CliOpts{rawopts_=rawopts, reportspec_=rspec'} j = do
     openingdate = addDays 1 closingdate
 
     -- should we show the amount(s) on the equity posting(s) ?
-    explicit = boolopt "explicit" rawopts
+    explicit = boolopt "explicit" rawopts || copts ^. infer_costs
 
     -- the balances to close
     (acctbals',_) = balanceReport rspec j

hledger/Hledger/Cli/Commands/Print.hs

@@ -75,23 +75,20 @@ printEntries opts@CliOpts{reportspec_=rspec} j =
 
 entriesReportAsText :: CliOpts -> EntriesReport -> TL.Text
 entriesReportAsText opts =
-    TB.toLazyText . foldMap (TB.fromText . showTransaction . maybeStripPrices . whichtxn)
+    TB.toLazyText . foldMap (TB.fromText . showTransaction . whichtxn)
   where
     whichtxn
       -- With -x, use the fully-inferred txn with all amounts & txn prices explicit.
       | boolopt "explicit" (rawopts_ opts) = id
+      -- With --show-costs, make txn prices explicit.
+      | opts ^. infer_costs = id
       -- Or also, if any of -B/-V/-X/--value are active.
       -- Because of #551, and because of print -V valuing only one
       -- posting when there's an implicit txn price.
       -- So -B/-V/-X/--value implies -x. Is this ok ?
       | has (value . _Just) opts = id
       -- By default, use the original as-written-in-the-journal txn.
       | otherwise = originalTransaction
-    maybeStripPrices
-      -- Strip prices when inferring equity, unless the show_costs_  is set
-      | opts ^. infer_equity && not (opts ^. show_costs) =
-          transactionTransformPostings postingStripPrices
-      | otherwise = id
 
 -- Replace this transaction's postings with the original postings if any, but keep the
 -- current possibly rewritten account names, and the inferred values of any auto postings