lib: --value can select commodity (via direct/reverse prices) (#131)

hledger-lib/Hledger/Data/Amount.hs

@@ -62,8 +62,6 @@ module Hledger.Data.Amount (
   multiplyAmount,
   divideAmountAndPrice,
   multiplyAmountAndPrice,
-  amountValueAtDate,
-  amountApplyValuation,
   amountTotalPriceToUnitPrice,
   -- ** rendering
   amountstyle,
@@ -108,8 +106,6 @@ module Hledger.Data.Amount (
   isZeroMixedAmount,
   isReallyZeroMixedAmount,
   isReallyZeroMixedAmountCost,
-  mixedAmountValueAtDate,
-  mixedAmountApplyValuation,
   mixedAmountTotalPriceToUnitPrice,
   -- ** rendering
   styleMixedAmount,
@@ -133,18 +129,15 @@ import Data.Char (isDigit)
 import Data.Decimal (roundTo, decimalPlaces, normalizeDecimal)
 import Data.Function (on)
 import Data.List
+import qualified Data.Map as M
 import Data.Map (findWithDefault)
 import Data.Maybe
-import Data.Time.Calendar (Day)
--- import Data.Text (Text)
 import qualified Data.Text as T
 import Safe (maximumDef)
 import Text.Printf
-import qualified Data.Map as M
 
 import Hledger.Data.Types
 import Hledger.Data.Commodity
-import Hledger.Data.Prices
 import Hledger.Utils 
 
 
@@ -225,35 +218,6 @@ costOfAmount a@Amount{aquantity=q, aprice=price} =
 amountToCost :: M.Map CommoditySymbol AmountStyle -> Amount -> Amount
 amountToCost styles = styleAmount styles . costOfAmount
 
--- | Find the market value of this amount on the given valuation date
--- in its default valuation commodity (that of the latest applicable 
--- market price before the valuation date).
--- The given market prices are expected to be in parse order.
--- If no default valuation commodity can be found, the amount is left
--- unchanged.
-amountValueAtDate :: Prices -> Day -> Amount -> Amount
-amountValueAtDate prices d a =
-  case priceLookup prices d (acommodity a) of
-    Just v  -> v{aquantity=aquantity v * aquantity a}
-    Nothing -> a
-
--- | Alternate implementation.
--- Apply a specified valuation to this amount, using the provided
--- prices db, commodity styles, period-end/current dates, 
--- and whether this is for a multiperiod report or not.
--- Currently ignores the specified valuation commodity and always uses
--- the default valuation commodity.
-amountApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> Amount -> Amount
-amountApplyValuation prices styles periodend today ismultiperiod v a =
-  -- will use _mc later
-  case v of
-    AtCost    _mc                 -> amountToCost styles a
-    AtEnd     _mc                 -> amountValueAtDate prices periodend a
-    AtNow     _mc                 -> amountValueAtDate prices today     a
-    AtDefault _mc | ismultiperiod -> amountValueAtDate prices periodend a
-    AtDefault _mc                 -> amountValueAtDate prices today     a
-    AtDate d  _mc                 -> amountValueAtDate prices d         a
-
 -- | Replace an amount's TotalPrice, if it has one, with an equivalent UnitPrice.
 -- Has no effect on amounts without one.
 -- Also increases the unit price's display precision to show one extra decimal place,
@@ -739,22 +703,6 @@ cshowMixedAmountOneLineWithoutPrice m = intercalate ", " $ map cshowAmountWithou
 canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
 canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as
 
--- | Find the market value of each component amount on the given date
--- in its default valuation commodity, using the given market prices
--- which are expected to be in parse order. When no default valuation
--- commodity can be found, amounts are left unchanged.
-mixedAmountValueAtDate :: Prices -> Day -> MixedAmount -> MixedAmount
-mixedAmountValueAtDate prices d (Mixed as) = Mixed $ map (amountValueAtDate prices d) as
-
--- Apply a specified valuation to this mixed amount, using the provided
--- prices db, commodity styles, period-end/current dates, 
--- and whether this is for a multiperiod report or not.
--- Currently ignores the specified valuation commodity and always uses
--- the default valuation commodity.
-mixedAmountApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount
-mixedAmountApplyValuation prices styles periodend today ismultiperiod v (Mixed as) =
-  Mixed $ map (amountApplyValuation prices styles periodend today ismultiperiod v) as
-
 -- | Replace each component amount's TotalPrice, if it has one, with an equivalent UnitPrice.
 -- Has no effect on amounts without one. 
 -- Does Decimal division, might be some rounding/irrational number issues.

hledger-lib/Hledger/Data/Posting.hs

@@ -350,29 +350,28 @@ aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.un
 -- Apply a specified valuation to this posting's amount, using the provided
 -- prices db, commodity styles, period-end/current dates, and whether
 -- this is for a multiperiod report or not.
--- Currently ignores the specified valuation commodity and always uses
--- the default valuation commodity.
 postingApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> Posting -> ValuationType -> Posting
 postingApplyValuation prices styles periodend today ismultiperiod p v =
-  -- will use _mc later
   case v of
-    AtCost    _mc                 -> postingToCost styles p
+    AtCost    Nothing            -> postingToCost styles p
-    AtEnd     _mc                 -> postingValueAtDate prices periodend p
+    AtCost    mc                 -> postingValueAtDate prices mc periodend $ postingToCost styles p
-    AtNow     _mc                 -> postingValueAtDate prices today     p
+    AtEnd     mc                 -> postingValueAtDate prices mc periodend p
-    AtDefault _mc | ismultiperiod -> postingValueAtDate prices periodend p
+    AtNow     mc                 -> postingValueAtDate prices mc today     p
-    AtDefault _mc                 -> postingValueAtDate prices today     p
+    AtDefault mc | ismultiperiod -> postingValueAtDate prices mc periodend p
-    AtDate d  _mc                 -> postingValueAtDate prices d         p
+    AtDefault mc                 -> postingValueAtDate prices mc today     p
+    AtDate d  mc                 -> postingValueAtDate prices mc d         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=mixedAmountToCost styles a}
 
--- | Convert this posting's amount to market value in its default
+-- | Convert this posting's amount to market value in the given commodity,
--- valuation commodity on the given date using the given market prices.
+-- or the default valuation commodity, at the given valuation date,
--- If no default valuation commodity can be found, amounts are left unchanged.
+-- using the given market prices.
--- The prices are expected to be in parse order. 
+-- When market prices available on that date are not sufficient to
-postingValueAtDate :: Prices -> Day -> Posting -> Posting
+-- calculate the value, amounts are left unchanged.
-postingValueAtDate prices d p = postingTransformAmount (mixedAmountValueAtDate prices d) p
+postingValueAtDate :: Prices -> Maybe CommoditySymbol -> Day -> Posting -> Posting
+postingValueAtDate prices mc d p = postingTransformAmount (mixedAmountValueAtDate prices mc d) p
 
 -- | Apply a transform function to this posting's amount.
 postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting

hledger-lib/Hledger/Data/Prices.hs

@@ -1,33 +1,45 @@
 {-|
 
-Find historical exchange rates between two commodities.
+Find historical market prices (exchange rates) between commodities,
+convert amounts to value in various ways.
 
 -}
 
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
 
 module Hledger.Data.Prices (
    Prices
   ,nullPrices
   ,toPrices
   ,priceLookup
+  ,amountValueAtDate
+  ,amountApplyValuation
+  ,mixedAmountValueAtDate
+  ,mixedAmountApplyValuation
   ,tests_Prices
 )
 where
 
+import Control.Applicative ((<|>))
 import Data.List
+import qualified Data.Map as M
 import qualified Data.Text as T
 import Data.Time.Calendar (Day)
+import Safe (headMay)
 
 import Hledger.Utils
 import Hledger.Data.Types
+import Hledger.Data.Amount
+import Hledger.Data.Dates (parsedate)
 
 -- | A database of historical market prices for multiple commodites,
 -- allowing fast lookup of exchange rates between commodity pairs on a
 -- given date.
 data Prices = Prices {
-  prPrices :: [MarketPrice]  -- ^ For now, just a list of price declarations sorted by date then parse order.
+  prPrices :: [MarketPrice]  -- ^ For now, just a list of price declarations,
+                             --   sorted by date then parse order, then reversed.
   }
 
 nullPrices = toPrices []
@@ -36,18 +48,136 @@ nullPrices = toPrices []
 toPrices :: [MarketPrice] -> Prices
 toPrices declaredprices = Prices{prPrices = reverse $ sortOn mpdate declaredprices}
 
--- | Find the market value of one unit of the given commodity on the
+-- | Reverse a market price from A to B, so that it becomes an equivalent price from B to A.
--- given date in its default valuation commodity (the commodity of the
+marketPriceInvert :: MarketPrice -> MarketPrice
--- latest applicable price before the valuation date).
+marketPriceInvert p@MarketPrice{mpcommodity, mpamount} =  
--- Returns Nothing if there's no applicable price.
+  p{ mpcommodity = acommodity mpamount
-priceLookup :: Prices -> Day -> CommoditySymbol -> Maybe Amount
+   , mpamount    = setMinimalPrecision mpamount{acommodity=mpcommodity, aquantity=1 / aquantity mpamount}
-priceLookup Prices{..} valuationdate c =
+   }
-  case filter (\MarketPrice{..} -> mpcommodity==c && mpdate<=valuationdate) prPrices of
-    []  -> dbg Nothing
-    ps' -> dbg $ Just $ mpamount $ head ps'
-  where
-    dbg = dbg8 ("using market price for "++T.unpack c)
 
-tests_Prices = tests "Prices" [
+tests_marketPriceInvert = tests "marketPriceInvert" [
+  marketPriceInvert (MarketPrice{mpdate=d "2019-06-01", mpcommodity="A", mpamount=amt "B" 2})
+    `is`            (MarketPrice{mpdate=d "2019-06-01", mpcommodity="B", mpamount=amt "A" 0.5 `withPrecision` 1})
+  ]
+
+d = parsedate
+amt c q = nullamt{acommodity=c, aquantity=q}
+
+-- | Using the market prices in effect at the given date, find the
+-- market value of one unit of a given commodity, in a different
+-- specified valuation commodity, defaulting to the commodity of the
+-- most recent applicable price.
+--
+-- When the valuation commodity is specified, this looks for, in order:
+--
+-- - a direct price, giving the exchange rate from source commodity to
+--   valuation commodity.
+--
+-- - a reverse direct price, giving the exchange rate from valuation
+--   commodity to source commodity, which is inverted.
+--
+-- - (TODO: the shortest chain of prices leading from source commodity
+--   to valuation commodity, which is collapsed into a single
+--   synthetic exchange rate.)
+--
+-- When the valuation commodity is not specified, this looks for the
+-- latest applicable market price, and converts to the commodity
+-- mentioned in that price. Note when valuing amounts over multiple
+-- periods, this default valuation commodity may vary, since it
+-- depends on the presence and parse order of market price
+-- declarations in each period.
+-- 
+-- If no applicable market price or chain of prices can be found, or
+-- if the source commodity and the valuation commodity are the same,
+-- this returns Nothing.
+--
+priceLookup :: Prices -> Day -> Maybe CommoditySymbol -> CommoditySymbol -> Maybe Amount
+priceLookup Prices{prPrices} d mto from
+  | mto == Just from = Nothing
+  | otherwise        = mdirectprice <|> mreverseprice
+  where
+    dbgprice lbl =
+      dbg4With ( ((lbl++" for "++T.unpack from++" at "++show d++": ") ++)
+                 . maybe "none" showAmount )
+
+    -- Key to commodity symbols:
+    -- from  - commodity we are converting from (looking up a price for)
+    -- mto   - commodity we want to convert to, or Nothing meaning use default
+    -- pfrom - commodity that this market price converts from
+    -- pto   - commodity that this market price converts to
+
+    -- prPrices is sorted by date then parse order, reversed. So the
+    -- first price on or before the valuation date is the effective one.
+
+    mdirectprice =
+      dbgprice "direct  market price" $
+      headMay [mpamount | MarketPrice{mpdate, mpcommodity=pfrom, mpamount} <- prPrices
+                        , let pto = acommodity mpamount
+                        , mpdate <= d
+                        , pfrom == from
+                        , maybe True (== pto) mto
+                        ]
+    mreverseprice =
+      dbgprice "reverse market price" $
+      headMay [ priceamt
+              | mp@MarketPrice{mpdate, mpcommodity=pfrom, mpamount} <- prPrices
+              , let pto = acommodity mpamount
+              , mpdate <= d
+              , pto == from
+              , maybe False (== pfrom) mto  -- use reverse prices only when target commodity is explicitly specified
+              , let MarketPrice{mpamount=priceamt} = marketPriceInvert mp
+              ]
+
+tests_priceLookup = tests "priceLookup" [
+   priceLookup (Prices []) (d "2019-06-01") Nothing "" `is` Nothing
+  ]
+   
+-- Apply a specified valuation to this mixed amount, using the provided
+-- prices db, commodity styles, period-end/current dates, 
+-- and whether this is for a multiperiod report or not.
+-- Currently ignores the specified valuation commodity and always uses
+-- the default valuation commodity.
+mixedAmountApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount
+mixedAmountApplyValuation prices styles periodend today ismultiperiod v (Mixed as) =
+  Mixed $ map (amountApplyValuation prices styles periodend today ismultiperiod v) as
+
+-- | Find the market value of each component amount in the given
+-- commodity, or its default valuation commodity, at the given
+-- valuation date, using the given market prices.
+-- When market prices available on that date are not sufficient to
+-- calculate the value, amounts are left unchanged.
+mixedAmountValueAtDate :: Prices -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount
+mixedAmountValueAtDate prices mc d (Mixed as) = Mixed $ map (amountValueAtDate prices mc d) as
+
+-- | Apply a specified valuation to this amount, using the provided
+-- prices db, commodity styles, period-end/current dates, 
+-- and whether this is for a multiperiod report or not.
+amountApplyValuation :: Prices -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> Amount -> Amount
+amountApplyValuation prices styles periodend today ismultiperiod v a =
+  case v of
+    AtCost    Nothing            -> amountToCost styles a
+    AtCost    mc                 -> amountValueAtDate prices mc periodend $ amountToCost styles a
+    AtEnd     mc                 -> amountValueAtDate prices mc periodend a
+    AtNow     mc                 -> amountValueAtDate prices mc today     a
+    AtDefault mc | ismultiperiod -> amountValueAtDate prices mc periodend a
+    AtDefault mc                 -> amountValueAtDate prices mc today     a
+    AtDate d  mc                 -> amountValueAtDate prices mc d         a
+
+-- | Find the market value of this amount in the given valuation
+-- commodity if any, otherwise the default valuation commodity, at the
+-- given valuation date. (The default valuation commodity is the
+-- commodity of the latest applicable market price before the
+-- valuation date.)
+-- If the market prices available on that date are not sufficient to
+-- calculate this value, the amount is left unchanged.
+amountValueAtDate :: Prices -> Maybe CommoditySymbol -> Day -> Amount -> Amount
+amountValueAtDate prices mc d a =
+  case priceLookup prices d mc (acommodity a) of
+    Just v  -> v{aquantity=aquantity v * aquantity a}
+    Nothing -> a
+
+tests_Prices = tests "Prices" [
+   tests_marketPriceInvert
+  ,tests_priceLookup
   ]
 

hledger/Hledger/Cli/CliOptions.hs

@@ -168,15 +168,15 @@ reportflags = [
  --     ,"same as --value=now,COMM (single period reports)"
  --     ,"or --value=end,COMM (multiperiod reports)"
  --     ])
- -- ,flagReq  ["value"]         (\s opts -> Right $ setopt "value" s opts) "TYPE[,COMM]"
+ ,flagReq  ["value"]         (\s opts -> Right $ setopt "value" s opts) "TYPE[,COMM]"
- ,flagReq  ["value"]         (\s opts -> Right $ setopt "value" s opts) "TYPE"
    (unlines
-     ["TYPE is cost, end, now, or YYYY-MM-DD."
+     ["TYPE is cost, end, now or YYYY-MM-DD."
-     ,"Show amounts converted to:"
+     ,"COMM is an optional commodity symbol."
-     ,"- cost commodity using transaction prices"  -- "(then optionally to COMM using market prices at posting date)"
+     ,"Shows amounts converted to:"
-     ,"- default valuation commodity using market prices at period end(s)"  -- "(or COMM)"
+     ,"- cost commodity using transaction prices (then optionally to COMM using market prices at period end(s))"
-     ,"- default valuation commodity using current market prices"
+     ,"- default valuation commodity (or COMM) using market prices at period end(s)"
-     ,"- default valuation commodity using market prices on some date"
+     ,"- default valuation commodity (or COMM) using current market prices"
+     ,"- default valuation commodity (or COMM) using market prices at some date"
      ])
 
   -- generated postings/transactions

hledger/hledger_options.m4.md

@@ -496,16 +496,23 @@ but we don't do that. hledger's -V uses only market prices declared explicitly,
 
 *(experimental, added 201905)*
 
-You can control valuation more precisely with the `--value` option.
+You can control valuation more precisely with the `--value` option:
 
-     --value=TYPE   which type of valuation should be done ? cost|end|now|YYYY-MM-DD
+     --value=TYPE[,COMM]  TYPE is cost, end, now or YYYY-MM-DD.
+                          COMM is an optional commodity symbol.
+                          Shows amounts converted to:
+                          - cost commodity using transaction prices (then optionally to COMM using market prices at period end(s))
+                          - default valuation commodity (or COMM) using market prices at period end(s)
+                          - default valuation commodity (or COMM) using current market prices
+                          - default valuation commodity (or COMM) using market prices at some date
 
-TYPE is one of the keywords shown, or their first letter, or a custom date.
+TYPE is one of the keywords shown, or their first letter, or a date
-Their meanings:
+(which must be 8 digits with `-` or `/` or `.` separators).
+Here they are in more detail:
 
 `--value=cost` (or `c`)
 : Convert amounts to cost, using the prices recorded in transactions.
-  `-B`/`--cost` does this.
+  `-B`/`--cost` is equivalent to this.
 
 `--value=end` (or `e`)
 : Convert amounts to their value in default valuation commodity using market prices 
@@ -514,12 +521,23 @@ Their meanings:
 
 `--value=now` (or `n`)
 : Convert amounts to their value in default valuation commodity using current market prices 
-  (as of when report is generated). `-V`/`--market` does this.
+  (as of when report is generated). `-V`/`--market` is equivalent to this.
 
 `--value=YYYY-MM-DD`
 : Convert amounts to their value in default valuation commodity using market prices 
-  on the given date (which must be 8 digits with `-` or `/` or `.` separators).
+  on this date.  Eg `--value=2019-04-25`.
-  Eg `--value=2019-04-25`.
+
+The default valuation commodity is the commodity mentioned in the most
+recent applicable market price declaration. When all your price
+declarations lead to a single home currency, that will be the default
+valuation currency, which is generally what you want.
+
+To select a different valuation currency, you can write a comma and
+the commodity symbol after the valuation type above.
+<!-- This is like the `-X`/`--exchange` flag. -->
+Note this does not yet follow chains of market prices;
+it can only use market prices leading directly from A to B,
+or prices from B to A (which will be inverted).
 
 Here are the effects of `--value` as seen with `print`: