diff --git a/hledger-lib/Hledger/Data/Journal.hs b/hledger-lib/Hledger/Data/Journal.hs index e4ab359f5..aab480658 100644 --- a/hledger-lib/Hledger/Data/Journal.hs +++ b/hledger-lib/Hledger/Data/Journal.hs @@ -26,6 +26,7 @@ module Hledger.Data.Journal ( journalCommodityStyles, journalToCost, journalAddInferredEquityPostings, + journalAddPricesFromEquity, journalReverse, journalSetLastReadTime, journalPivot, @@ -949,6 +950,10 @@ journalAddInferredEquityPostings j = journalMapTransactions (transactionAddInfer where equityAcct = journalConversionAccount j +-- | Add inferred transaction prices from equity postings. +journalAddPricesFromEquity :: Journal -> Journal +journalAddPricesFromEquity j = journalMapTransactions (transactionAddPricesFromEquity $ jaccounttypes j) j + -- -- | Get this journal's unique, display-preference-canonicalised commodities, by symbol. -- journalCanonicalCommodities :: Journal -> M.Map String CommoditySymbol -- journalCanonicalCommodities j = canonicaliseCommodities $ journalAmountCommodities j diff --git a/hledger-lib/Hledger/Data/Posting.hs b/hledger-lib/Hledger/Data/Posting.hs index 66ba84a45..bd2e3782c 100644 --- a/hledger-lib/Hledger/Data/Posting.hs +++ b/hledger-lib/Hledger/Data/Posting.hs @@ -420,13 +420,19 @@ postingApplyValuation priceoracle styles periodlast today v p = -- | Maybe convert this 'Posting's amount to cost, and apply apply appropriate -- amount styles. -postingToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Posting -> Posting -postingToCost _ NoConversionOp p = p -postingToCost styles ToCost p = postingTransformAmount (styleMixedAmount styles . mixedAmountCost) 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 -- | 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 = taggedPosting : concatMap conversionPostings priceAmounts +postingAddInferredEquityPostings equityAcct p + | ("_matched-transaction-price","") `elem` ptags p = [p] + | otherwise = taggedPosting : concatMap conversionPostings priceAmounts where taggedPosting | null priceAmounts = p diff --git a/hledger-lib/Hledger/Data/Transaction.hs b/hledger-lib/Hledger/Data/Transaction.hs index 4ce0ce0d7..9f31ce281 100644 --- a/hledger-lib/Hledger/Data/Transaction.hs +++ b/hledger-lib/Hledger/Data/Transaction.hs @@ -27,6 +27,7 @@ module Hledger.Data.Transaction , transactionApplyValuation , transactionToCost , transactionAddInferredEquityPostings +, transactionAddPricesFromEquity , transactionApplyAliases , transactionMapPostings , transactionMapPostingAmounts @@ -47,7 +48,8 @@ module Hledger.Data.Transaction , tests_Transaction ) where -import Data.Maybe (fromMaybe) +import Data.Bifunctor (second) +import Data.Maybe (fromMaybe, mapMaybe) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Lazy as TL @@ -210,13 +212,42 @@ transactionApplyValuation priceoracle styles periodlast today v = -- | Maybe convert this 'Transaction's amounts to cost and apply the -- appropriate amount styles. transactionToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Transaction -> Transaction -transactionToCost styles cost = transactionMapPostings (postingToCost styles cost) +transactionToCost styles cost t = t{tpostings = mapMaybe (postingToCost styles cost) $ tpostings t} -- | Add inferred equity postings to a 'Transaction' using transaction prices. transactionAddInferredEquityPostings :: AccountName -> Transaction -> Transaction 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 + 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","")]) + npostings = zip [0..] $ tpostings t + + 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 + -- | 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. transactionApplyAliases :: [AccountAlias] -> Transaction -> Either RegexError Transaction diff --git a/hledger-lib/Hledger/Read/Common.hs b/hledger-lib/Hledger/Read/Common.hs index b1adbec0f..077621124 100644 --- a/hledger-lib/Hledger/Read/Common.hs +++ b/hledger-lib/Hledger/Read/Common.hs @@ -197,7 +197,7 @@ rawOptsToInputOpts day rawopts = commodity_styles = either err id $ commodityStyleFromRawOpts rawopts where err e = error' $ "could not parse commodity-style: '" ++ e ++ "'" -- PARTIAL: - in InputOpts{ + in definputopts{ -- files_ = listofstringopt "file" rawopts mformat_ = Nothing ,mrules_file_ = maybestringopt "rules-file" rawopts @@ -210,6 +210,7 @@ rawOptsToInputOpts day rawopts = ,reportspan_ = DateSpan (queryStartDate False datequery) (queryEndDate False datequery) ,auto_ = boolopt "auto" rawopts ,infer_equity_ = boolopt "infer-equity" rawopts && conversionop_ ropts /= Just ToCost + ,infer_costs_ = boolopt "infer-costs" rawopts ,balancingopts_ = defbalancingopts{ ignore_assertions_ = boolopt "ignore-assertions" rawopts , infer_transaction_prices_ = not noinferprice @@ -305,7 +306,7 @@ initialiseAndParseJournal parser iopts f txt = -- - check all commodities have been declared if in strict mode -- journalFinalise :: InputOpts -> FilePath -> Text -> ParsedJournal -> ExceptT String IO Journal -journalFinalise iopts@InputOpts{auto_,infer_equity_,balancingopts_,strict_,_ioDay} f txt pj = do +journalFinalise iopts@InputOpts{..} f txt pj = do t <- liftIO getPOSIXTime liftEither $ do j <- pj{jglobalcommoditystyles=fromMaybe mempty $ commodity_styles_ balancingopts_} @@ -320,6 +321,7 @@ journalFinalise iopts@InputOpts{auto_,infer_equity_,balancingopts_,strict_,_ioDa 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 <&> journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions when strict_ $ do diff --git a/hledger-lib/Hledger/Read/InputOptions.hs b/hledger-lib/Hledger/Read/InputOptions.hs index 4373dd4fb..9365951c7 100644 --- a/hledger-lib/Hledger/Read/InputOptions.hs +++ b/hledger-lib/Hledger/Read/InputOptions.hs @@ -37,6 +37,7 @@ data InputOpts = InputOpts { ,reportspan_ :: DateSpan -- ^ a dirty hack keeping the query dates in InputOpts. This rightfully lives in ReportSpec, but is duplicated here. ,auto_ :: Bool -- ^ generate automatic postings when journal is parsed ,infer_equity_ :: Bool -- ^ generate automatic equity postings from transaction prices + ,infer_costs_ :: Bool -- ^ infer transaction prices from equity conversion postings ,balancingopts_ :: BalancingOpts -- ^ options for balancing transactions ,strict_ :: Bool -- ^ do extra error checking (eg, all posted accounts are declared, no prices are inferred) ,_ioDay :: Day -- ^ today's date, for use with forecast transactions XXX this duplicates _rsDay, and should eventually be removed when it's not needed anymore. @@ -55,6 +56,7 @@ definputopts = InputOpts , reportspan_ = nulldatespan , auto_ = False , infer_equity_ = False + , infer_costs_ = False , balancingopts_ = defbalancingopts , strict_ = False , _ioDay = nulldate diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 6a21b388e..230be5c72 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -183,6 +183,8 @@ reportflags = [ ]) ,flagNone ["infer-equity"] (setboolopt "infer-equity") "in conversion transactions, replace costs (transaction prices) with equity postings, to keep the transactions balanced" + ,flagNone ["infer-costs"] (setboolopt "infer-costs") + "infer costs (transaction prices) from manual conversion postings" -- history of this flag so far, lest we be confused: -- originally --infer-value diff --git a/hledger/test/journal/transaction-prices.test b/hledger/test/journal/transaction-prices.test index d0352b5ad..29edf96ef 100644 --- a/hledger/test/journal/transaction-prices.test +++ b/hledger/test/journal/transaction-prices.test @@ -355,6 +355,72 @@ Transactions in equity:conversion and subaccounts: €-100 €-100 >>>=0 +# 29. Infer cost when equity postings are present +hledger -f- print --cost --infer-costs +<<< +2011/01/01 + expenses:foreign currency €100 + equity:conversion €-100 + equity:conversion $135 + assets +>>> +2011-01-01 + expenses:foreign currency $135 + assets + +>>>=0 + +# 30. Infer cost and show it when equity postings are present +hledger -f- print --show-costs --infer-costs +<<< +2011/01/01 + expenses:foreign currency €100 + equity:conversion €-100 + equity:conversion $135 + assets +>>> +2011-01-01 + expenses:foreign currency €100 @@ $135 + equity:conversion €-100 + equity:conversion $135 + assets + +>>>=0 + +# 31. Do not infer equity postings when they are specified manually +hledger -f- print --show-costs --infer-equity --infer-costs +<<< +2011/01/01 + expenses:foreign currency €100 + equity:conversion €-100 + equity:conversion $135 + assets +>>> +2011-01-01 + expenses:foreign currency €100 @@ $135 + equity:conversion €-100 + equity:conversion $135 + assets + +>>>=0 + +# 32. Inferred equity postings with non-standard conversion account +hledger -f- print --cost --infer-costs +<<< +account whoopwhoop ; type:V + +2011/01/01 + expenses:foreign currency €100 + whoopwhoop €-100 + whoopwhoop $135 + assets +>>> +2011-01-01 + expenses:foreign currency $135 + assets + +>>>=0 + # # when the *cost-basis* balance has exactly two commodities, both # # unpriced, infer an implicit conversion price for the first one in terms # # of the second.