lib,cli,ui: Introduce *ApplyCostValuation functions, which perform both

costing and valuation.

This currently is given a dummy NoCost argument and is equivalent to
"maybe id (*ApplyValuation ...)", but provides a constant interface so
that internal behaviour can be changed freely.

hledger-lib/Hledger/Data/Posting.hs

@@ -64,6 +64,7 @@ module Hledger.Data.Posting (
   -- * misc.
   showComment,
   postingTransformAmount,
+  postingApplyCostValuation,
   postingApplyValuation,
   postingToCost,
   tests_Posting
@@ -330,17 +331,24 @@ aliasReplace (BasicAlias old new) a
 aliasReplace (RegexAlias re repl) a =
   fmap T.pack . regexReplace re repl $ T.unpack a -- XXX
 
+-- | Apply a specified costing and valuation to this posting's amount,
+-- using the provided price oracle, commodity styles, and reference dates.
+-- Costing is done first if requested, and after that any valuation.
+-- See amountApplyValuation and amountCost.
+postingApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Posting -> Posting
+postingApplyCostValuation priceoracle styles periodlast today cost v p =
+    postingTransformAmount (mixedAmountApplyCostValuation priceoracle styles periodlast today (postingDate p) cost v) p
+
 -- | Apply a specified valuation to this posting's amount, using the
--- provided price oracle, commodity styles, reference dates, and
--- whether this is for a multiperiod report or not. See
--- amountApplyValuation.
+-- provided price oracle, commodity styles, and reference dates.
+-- See amountApplyValuation.
 postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Posting -> Posting
 postingApplyValuation priceoracle styles periodlast today v p =
     postingTransformAmount (mixedAmountApplyValuation priceoracle styles periodlast today (postingDate p) v) p
 
 -- | Convert this posting's amount to cost, and apply the appropriate amount styles.
 postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
-postingToCost styles p@Posting{pamount=a} = p{pamount=styleMixedAmount styles $ mixedAmountCost a}
+postingToCost styles = postingTransformAmount (styleMixedAmount styles . mixedAmountCost)
 
 -- | Apply a transform function to this posting's amount.
 postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting

hledger-lib/Hledger/Data/Transaction.hs

@@ -32,6 +32,7 @@ module Hledger.Data.Transaction (
   balanceTransaction,
   balanceTransactionHelper,
   transactionTransformPostings,
+  transactionApplyCostValuation,
   transactionApplyValuation,
   transactionToCost,
   transactionApplyAliases,
@@ -590,10 +591,16 @@ postingSetTransaction t p = p{ptransaction=Just t}
 transactionTransformPostings :: (Posting -> Posting) -> Transaction -> Transaction
 transactionTransformPostings f t@Transaction{tpostings=ps} = t{tpostings=map f ps}
 
+-- | Apply a specified costing and valuation to this transaction's amounts,
+-- using the provided price oracle, commodity styles, and reference dates.
+-- See amountApplyValuation and amountCost.
+transactionApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Costing -> Maybe ValuationType -> Transaction -> Transaction
+transactionApplyCostValuation priceoracle styles periodlast today cost v =
+  transactionTransformPostings (postingApplyCostValuation priceoracle styles periodlast today cost v)
+
 -- | Apply a specified valuation to this transaction's amounts, using
--- the provided price oracle, commodity styles, reference dates, and
--- whether this is for a multiperiod report or not. See
--- amountApplyValuation.
+-- the provided price oracle, commodity styles, and reference dates.
+-- See amountApplyValuation.
 transactionApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> ValuationType -> Transaction -> Transaction
 transactionApplyValuation priceoracle styles periodlast today v =
   transactionTransformPostings (postingApplyValuation priceoracle styles periodlast today v)

hledger-lib/Hledger/Data/Valuation.hs

@@ -13,11 +13,13 @@ looking up historical market prices (exchange rates) between commodities.
 {-# LANGUAGE DeriveGeneric #-}
 
 module Hledger.Data.Valuation (
-   ValuationType(..)
+   Costing(..)
+  ,ValuationType(..)
   ,PriceOracle
   ,journalPriceOracle
   -- ,amountApplyValuation
   -- ,amountValueAtDate
+  ,mixedAmountApplyCostValuation
   ,mixedAmountApplyValuation
   ,mixedAmountValueAtDate
   ,marketPriceReverse
@@ -51,6 +53,10 @@ import Text.Printf (printf)
 ------------------------------------------------------------------------------
 -- Types
 
+-- | Whether to convert amounts to cost.
+data Costing = Cost | NoCost
+  deriving (Show,Eq)
+
 -- | What kind of value conversion should be done on amounts ?
 -- CLI: --value=cost|then|end|now|DATE[,COMM]
 data ValuationType =
@@ -94,9 +100,21 @@ priceDirectiveToMarketPrice PriceDirective{..} =
 ------------------------------------------------------------------------------
 -- Converting things to value
 
+-- | Apply a specified costing and valuation to this mixed amount,
+-- using the provided price oracle, commodity styles, and reference dates.
+-- Costing is done first if requested, and after that any valuation.
+-- See amountApplyValuation and amountCost.
+mixedAmountApplyCostValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> Costing -> Maybe ValuationType -> MixedAmount -> MixedAmount
+mixedAmountApplyCostValuation priceoracle styles periodlast today postingdate cost v =
+    valuation  -- . costing
+  where
+    valuation = maybe id (mixedAmountApplyValuation priceoracle styles periodlast today postingdate) v
+    costing = case cost of
+        Cost   -> styleMixedAmount styles . mixedAmountCost
+        NoCost -> id
+
 -- | Apply a specified valuation to this mixed amount, using the
--- provided price oracle, commodity styles, reference dates, and
--- whether this is for a multiperiod report or not.
+-- provided price oracle, commodity styles, and reference dates.
 -- See amountApplyValuation.
 mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount
 mixedAmountApplyValuation priceoracle styles periodlast today postingdate v =

hledger-lib/Hledger/Reports/AccountTransactionsReport.hs

@@ -111,7 +111,7 @@ accountTransactionsReport rspec@ReportSpec{rsOpts=ropts} j reportq thisacctq = i
     periodlast =
       fromMaybe (error' "journalApplyValuation: expected a non-empty journal") $ -- XXX shouldn't happen
       reportPeriodOrJournalLastDay rspec j
-    tval = maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) $ value_ ropts
+    tval = transactionApplyCostValuation prices styles periodlast (rsToday rspec) NoCost $ value_ ropts
     ts4 =
       ptraceAtWith 5 (("ts4:\n"++).pshowTransactions) $
       map tval ts3

hledger-lib/Hledger/Reports/EntriesReport.hs

@@ -40,11 +40,8 @@ entriesReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j@Journal{..} =
     -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
     tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
       where
-        pvalue = maybe id
-          (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec))
-          value_
-          where
-            periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
+        pvalue = postingApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) NoCost value_
+          where periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
 
 tests_EntriesReport = tests "EntriesReport" [
   tests "entriesReport" [

hledger-lib/Hledger/Reports/MultiBalanceReport.hs

@@ -574,17 +574,17 @@ cumulativeSum value start = snd . M.mapAccumWithKey accumValued start
 -- MultiBalanceReport.
 postingAndAccountValuations :: ReportSpec -> Journal -> PriceOracle
                             -> (DateSpan -> Posting -> Posting, DateSpan -> Account -> Account)
-postingAndAccountValuations rspec@ReportSpec{rsOpts=ropts} j priceoracle =
-  case value_ ropts of
-    Nothing -> (const id, const id)
-    Just v  -> if changingValuation ropts then (const id, avalue' v) else (pvalue' v, const id)
+postingAndAccountValuations rspec@ReportSpec{rsOpts=ropts} j priceoracle
+    | changingValuation ropts = (const id, avalue' NoCost mv)
+    | otherwise               = (pvalue' NoCost mv, const id)
   where
-    avalue' v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)}
-      where value = mixedAmountApplyValuation priceoracle styles (end span) (rsToday rspec) (error "multiBalanceReport: did not expect amount valuation to be called ") v  -- PARTIAL: should not happen
-    pvalue' v span = postingApplyValuation priceoracle styles (end span) (rsToday rspec) v
+    avalue' c v span a = a{aibalance = value (aibalance a), aebalance = value (aebalance a)}
+      where value = mixedAmountApplyCostValuation priceoracle styles (end span) (rsToday rspec) (error "multiBalanceReport: did not expect amount valuation to be called ") c v  -- PARTIAL: should not happen
+    pvalue' c v span = postingApplyCostValuation priceoracle styles (end span) (rsToday rspec) c v
     end = fromMaybe (error "multiBalanceReport: expected all spans to have an end date")  -- XXX should not happen
         . fmap (addDays (-1)) . spanEnd
     styles = journalCommodityStyles j
+    mv = value_ ropts
 
 -- tests
 

hledger-lib/Hledger/Reports/PostingsReport.hs

@@ -76,7 +76,7 @@ postingsReport rspec@ReportSpec{rsOpts=ropts@ReportOpts{..}} j = items
       (precedingps, reportps) = matchedPostingsBeforeAndDuring rspec j reportspan
 
       -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
-      pvalue periodlast = maybe id (postingApplyValuation priceoracle styles periodlast (rsToday rspec)) value_
+      pvalue periodlast = postingApplyCostValuation priceoracle styles periodlast (rsToday rspec) NoCost value_
 
       -- Postings, or summary postings with their subperiod's end date, to be displayed.
       displayps :: [(Posting, Maybe Day)]

hledger-ui/Hledger/UI/TransactionScreen.hs

@@ -81,7 +81,7 @@ tsDraw UIState{aopts=UIOpts{cliopts_=copts@CliOpts{reportspec_=rspec@ReportSpec{
 
       render . defaultLayout toplabel bottomlabel . str
         . T.unpack . showTransactionOneLineAmounts
-        $ maybe id (transactionApplyValuation prices styles periodlast (rsToday rspec)) (value_ ropts) t
+        $ transactionApplyCostValuation prices styles periodlast (rsToday rspec) NoCost (value_ ropts) t
         -- (if real_ ropts then filterTransactionPostings (Real True) else id) -- filter postings by --real
       where
         toplabel =

hledger/Hledger/Cli/Commands/Roi.hs

@@ -61,13 +61,8 @@ roi CliOpts{rawopts_=rawopts, reportspec_=rspec@ReportSpec{rsOpts=ReportOpts{..}
   d <- getCurrentDay
   -- We may be converting posting amounts to value, per hledger_options.m4.md "Effect of --value on reports".
   let
-    tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
-      where
-        pvalue = maybe id
-          (postingApplyValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec))
-          value_
-          where
-            periodlast  = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
+    tvalue = transactionApplyCostValuation (journalPriceOracle infer_value_ j) (journalCommodityStyles j) periodlast (rsToday rspec) NoCost value_
+      where periodlast = fromMaybe (rsToday rspec) $ reportPeriodOrJournalLastDay rspec j
   let
     ropts = rsOpts rspec
     showCashFlow = boolopt "cashflow" rawopts