{-|

Convert amounts to some related value in various ways. This involves
looking up historical market prices (exchange rates) between commodities.

-}

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}

module Hledger.Data.Valuation (
   ConversionOp(..)
  ,ValuationType(..)
  ,PriceOracle
  ,journalPriceOracle
  ,mixedAmountToCost
  ,mixedAmountApplyValuation
  ,mixedAmountValueAtDate
  ,mixedAmountApplyGain
  ,mixedAmountGainAtDate
  ,marketPriceReverse
  ,priceDirectiveToMarketPrice
  ,amountPriceDirectiveFromCost
  ,valuationTypeValuationCommodity
  -- ,priceLookup
  ,tests_Valuation
)
where

import Control.Applicative ((<|>))
import Data.Function ((&), on)
import Data.List (partition, intercalate, sortBy)
import Data.List.Extra (nubSortBy)
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorian)
import Data.MemoUgly (memo)
import GHC.Generics (Generic)
import Safe (headMay, lastMay)

import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Amount
import Hledger.Data.Dates (nulldate)
import Text.Printf (printf)
import Data.Decimal (decimalPlaces, roundTo)


------------------------------------------------------------------------------
-- Types

-- | Which operation to perform on conversion transactions.
-- (There was also an "infer equity postings" operation, but that is now done 
-- earlier, in journal finalisation.)
data ConversionOp = NoConversionOp | ToCost
  deriving (Int -> ConversionOp -> ShowS
[ConversionOp] -> ShowS
ConversionOp -> [Char]
(Int -> ConversionOp -> ShowS)
-> (ConversionOp -> [Char])
-> ([ConversionOp] -> ShowS)
-> Show ConversionOp
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ConversionOp -> ShowS
showsPrec :: Int -> ConversionOp -> ShowS
$cshow :: ConversionOp -> [Char]
show :: ConversionOp -> [Char]
$cshowList :: [ConversionOp] -> ShowS
showList :: [ConversionOp] -> ShowS
Show,ConversionOp -> ConversionOp -> Bool
(ConversionOp -> ConversionOp -> Bool)
-> (ConversionOp -> ConversionOp -> Bool) -> Eq ConversionOp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConversionOp -> ConversionOp -> Bool
== :: ConversionOp -> ConversionOp -> Bool
$c/= :: ConversionOp -> ConversionOp -> Bool
/= :: ConversionOp -> ConversionOp -> Bool
Eq)

-- | What kind of value conversion should be done on amounts ?
-- CLI: --value=then|end|now|DATE[,COMM]
data ValuationType =
    AtThen     (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using market prices at each posting's date
  | AtEnd      (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using market prices at period end(s)
  | AtNow      (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using current market prices
  | AtDate Day (Maybe CommoditySymbol)  -- ^ convert to default or given valuation commodity, using market prices on some date
  deriving (Int -> ValuationType -> ShowS
[ValuationType] -> ShowS
ValuationType -> [Char]
(Int -> ValuationType -> ShowS)
-> (ValuationType -> [Char])
-> ([ValuationType] -> ShowS)
-> Show ValuationType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValuationType -> ShowS
showsPrec :: Int -> ValuationType -> ShowS
$cshow :: ValuationType -> [Char]
show :: ValuationType -> [Char]
$cshowList :: [ValuationType] -> ShowS
showList :: [ValuationType] -> ShowS
Show,ValuationType -> ValuationType -> Bool
(ValuationType -> ValuationType -> Bool)
-> (ValuationType -> ValuationType -> Bool) -> Eq ValuationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ValuationType -> ValuationType -> Bool
== :: ValuationType -> ValuationType -> Bool
$c/= :: ValuationType -> ValuationType -> Bool
/= :: ValuationType -> ValuationType -> Bool
Eq)

valuationTypeValuationCommodity :: ValuationType -> Maybe CommoditySymbol
valuationTypeValuationCommodity :: ValuationType -> Maybe CommoditySymbol
valuationTypeValuationCommodity = \case
    AtThen   (Just CommoditySymbol
c) -> CommoditySymbol -> Maybe CommoditySymbol
forall a. a -> Maybe a
Just CommoditySymbol
c
    AtEnd    (Just CommoditySymbol
c) -> CommoditySymbol -> Maybe CommoditySymbol
forall a. a -> Maybe a
Just CommoditySymbol
c
    AtNow    (Just CommoditySymbol
c) -> CommoditySymbol -> Maybe CommoditySymbol
forall a. a -> Maybe a
Just CommoditySymbol
c
    AtDate Day
_ (Just CommoditySymbol
c) -> CommoditySymbol -> Maybe CommoditySymbol
forall a. a -> Maybe a
Just CommoditySymbol
c
    ValuationType
_                 -> Maybe CommoditySymbol
forall a. Maybe a
Nothing

-- | A price oracle is a magic memoising function that efficiently
-- looks up market prices (exchange rates) from one commodity to
-- another (or if unspecified, to a default valuation commodity) on a
-- given date.
type PriceOracle = (Day, CommoditySymbol, Maybe CommoditySymbol) -> Maybe (CommoditySymbol, Quantity)

-- | Generate a price oracle (memoising price lookup function) from a
-- journal's directive-declared and transaction-inferred market
-- prices. For best performance, generate this only once per journal,
-- reusing it across reports if there are more than one, as
-- compoundBalanceCommand does.
-- The boolean argument is whether to infer market prices from
-- transactions or not.
journalPriceOracle :: Bool -> Journal -> PriceOracle
journalPriceOracle :: Bool -> Journal -> PriceOracle
journalPriceOracle Bool
infer Journal{[PriceDirective]
jpricedirectives :: [PriceDirective]
jpricedirectives :: Journal -> [PriceDirective]
jpricedirectives, [MarketPrice]
jinferredmarketprices :: [MarketPrice]
jinferredmarketprices :: Journal -> [MarketPrice]
jinferredmarketprices} =
  let
    declaredprices :: [MarketPrice]
declaredprices = (PriceDirective -> MarketPrice)
-> [PriceDirective] -> [MarketPrice]
forall a b. (a -> b) -> [a] -> [b]
map PriceDirective -> MarketPrice
priceDirectiveToMarketPrice [PriceDirective]
jpricedirectives
    inferredprices :: [MarketPrice]
inferredprices = if Bool
infer then [MarketPrice]
jinferredmarketprices else []
    makepricegraph :: Day -> PriceGraph
makepricegraph = (Day -> PriceGraph) -> Day -> PriceGraph
forall a b. Ord a => (a -> b) -> a -> b
memo ((Day -> PriceGraph) -> Day -> PriceGraph)
-> (Day -> PriceGraph) -> Day -> PriceGraph
forall a b. (a -> b) -> a -> b
$ [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph
makePriceGraph [MarketPrice]
declaredprices [MarketPrice]
inferredprices
  in
    PriceOracle -> PriceOracle
forall a b. Ord a => (a -> b) -> a -> b
memo (PriceOracle -> PriceOracle) -> PriceOracle -> PriceOracle
forall a b. (a -> b) -> a -> b
$ (Day
 -> CommoditySymbol
 -> Maybe CommoditySymbol
 -> Maybe (CommoditySymbol, Quantity))
-> PriceOracle
forall a b c d. (a -> b -> c -> d) -> (a, b, c) -> d
uncurry3 ((Day
  -> CommoditySymbol
  -> Maybe CommoditySymbol
  -> Maybe (CommoditySymbol, Quantity))
 -> PriceOracle)
-> (Day
    -> CommoditySymbol
    -> Maybe CommoditySymbol
    -> Maybe (CommoditySymbol, Quantity))
-> PriceOracle
forall a b. (a -> b) -> a -> b
$ (Day -> PriceGraph)
-> Day
-> CommoditySymbol
-> Maybe CommoditySymbol
-> Maybe (CommoditySymbol, Quantity)
priceLookup Day -> PriceGraph
makepricegraph

priceDirectiveToMarketPrice :: PriceDirective -> MarketPrice
priceDirectiveToMarketPrice :: PriceDirective -> MarketPrice
priceDirectiveToMarketPrice PriceDirective{CommoditySymbol
Day
Amount
pddate :: Day
pdcommodity :: CommoditySymbol
pdamount :: Amount
pddate :: PriceDirective -> Day
pdcommodity :: PriceDirective -> CommoditySymbol
pdamount :: PriceDirective -> Amount
..} =
  MarketPrice{ mpdate :: Day
mpdate = Day
pddate
             , mpfrom :: CommoditySymbol
mpfrom = CommoditySymbol
pdcommodity
             , mpto :: CommoditySymbol
mpto   = Amount -> CommoditySymbol
acommodity Amount
pdamount
             , mprate :: Quantity
mprate = Amount -> Quantity
aquantity Amount
pdamount
             }

-- | Infer a market price from the given amount and its cost (if any),
-- and make a corresponding price directive on the given date.
-- The price's display precision will be set to show all significant
-- decimal digits; or if they seem to be infinite, defaultPrecisionLimit.
amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective
amountPriceDirectiveFromCost :: Day -> Amount -> Maybe PriceDirective
amountPriceDirectiveFromCost Day
d amt :: Amount
amt@Amount{acommodity :: Amount -> CommoditySymbol
acommodity=CommoditySymbol
fromcomm, aquantity :: Amount -> Quantity
aquantity=Quantity
n} = case Amount -> Maybe AmountPrice
aprice Amount
amt of
    Just (UnitPrice Amount
u)           -> PriceDirective -> Maybe PriceDirective
forall a. a -> Maybe a
Just (PriceDirective -> Maybe PriceDirective)
-> PriceDirective -> Maybe PriceDirective
forall a b. (a -> b) -> a -> b
$ PriceDirective
pd{pdamount=u}
    Just (TotalPrice Amount
t) | Quantity
n Quantity -> Quantity -> Bool
forall a. Eq a => a -> a -> Bool
/= Quantity
0 -> PriceDirective -> Maybe PriceDirective
forall a. a -> Maybe a
Just (PriceDirective -> Maybe PriceDirective)
-> PriceDirective -> Maybe PriceDirective
forall a b. (a -> b) -> a -> b
$ PriceDirective
pd{pdamount=u}
      where u :: Amount
u = Maybe Word8 -> Amount -> Amount
amountSetFullPrecisionOr Maybe Word8
forall a. Maybe a
Nothing (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ Quantity -> Amount -> Amount
divideAmount Quantity
n Amount
t
    Maybe AmountPrice
_                            -> Maybe PriceDirective
forall a. Maybe a
Nothing
  where
    pd :: PriceDirective
pd = PriceDirective{pddate :: Day
pddate = Day
d, pdcommodity :: CommoditySymbol
pdcommodity = CommoditySymbol
fromcomm, pdamount :: Amount
pdamount = Amount
nullamt}

------------------------------------------------------------------------------
-- Converting things to value

-- | Convert all component amounts to cost/selling price if requested, and style them.
mixedAmountToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> MixedAmount -> MixedAmount
mixedAmountToCost :: Map CommoditySymbol AmountStyle
-> ConversionOp -> MixedAmount -> MixedAmount
mixedAmountToCost Map CommoditySymbol AmountStyle
styles ConversionOp
cost = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (Map CommoditySymbol AmountStyle -> ConversionOp -> Amount -> Amount
amountToCost Map CommoditySymbol AmountStyle
styles ConversionOp
cost)

-- | Apply a specified valuation to this mixed amount, using the
-- provided price oracle, commodity styles, and reference dates.
-- See amountApplyValuation.
mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount
mixedAmountApplyValuation :: PriceOracle
-> Map CommoditySymbol AmountStyle
-> Day
-> Day
-> Day
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyValuation PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Day
periodlast Day
today Day
postingdate ValuationType
v =
  (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (PriceOracle
-> Map CommoditySymbol AmountStyle
-> Day
-> Day
-> Day
-> ValuationType
-> Amount
-> Amount
amountApplyValuation PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Day
periodlast Day
today Day
postingdate ValuationType
v)

-- | Convert an Amount to its cost if requested, and style it appropriately.
amountToCost :: M.Map CommoditySymbol AmountStyle -> ConversionOp -> Amount -> Amount
amountToCost :: Map CommoditySymbol AmountStyle -> ConversionOp -> Amount -> Amount
amountToCost Map CommoditySymbol AmountStyle
styles ConversionOp
ToCost         = Map CommoditySymbol AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts Map CommoditySymbol AmountStyle
styles (Amount -> Amount) -> (Amount -> Amount) -> Amount -> Amount
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Amount -> Amount
amountCost
amountToCost Map CommoditySymbol AmountStyle
_      ConversionOp
NoConversionOp = Amount -> Amount
forall a. a -> a
id

-- | Apply a specified valuation to this amount, using the provided
-- price oracle, and reference dates. Also fix up its display style
-- using the provided commodity styles.
--
-- When the valuation requires converting to another commodity, a
-- valuation (conversion) date is chosen based on the valuation type
-- and the provided reference dates. It will be one of:
--
-- - the date of the posting itself (--value=then)
--
-- - the provided "period end" date - this is typically the last day
--   of a subperiod (--value=end with a multi-period report), or of
--   the specified report period or the journal (--value=end with a
--   single-period report).
--
-- - the provided "today" date (--value=now).
--
-- - a fixed date specified by the ValuationType itself
--   (--value=DATE).
--
-- This is all a bit complicated. See the reference doc at
-- https://hledger.org/hledger.html#effect-of-valuation-on-reports
-- (hledger_options.m4.md "Effect of valuation on reports"), and #1083.
--
amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> Amount -> Amount
amountApplyValuation :: PriceOracle
-> Map CommoditySymbol AmountStyle
-> Day
-> Day
-> Day
-> ValuationType
-> Amount
-> Amount
amountApplyValuation PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Day
periodlast Day
today Day
postingdate ValuationType
v Amount
a =
  case ValuationType
v of
    AtThen    Maybe CommoditySymbol
mc      -> PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> Amount
-> Amount
amountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mc Day
postingdate Amount
a
    AtEnd     Maybe CommoditySymbol
mc      -> PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> Amount
-> Amount
amountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mc Day
periodlast Amount
a
    AtNow     Maybe CommoditySymbol
mc      -> PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> Amount
-> Amount
amountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mc Day
today Amount
a
    AtDate Day
d  Maybe CommoditySymbol
mc      -> PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> Amount
-> Amount
amountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mc Day
d Amount
a

-- | 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 price oracle.
-- When market prices available on that date are not sufficient to
-- calculate the value, amounts are left unchanged.
mixedAmountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount
mixedAmountValueAtDate :: PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> MixedAmount
-> MixedAmount
mixedAmountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mc Day
d = (Amount -> Amount) -> MixedAmount -> MixedAmount
mapMixedAmount (PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> Amount
-> Amount
amountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mc Day
d)

-- | 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.)
--
-- The returned amount will have its commodity's canonical style applied,
-- (with soft display rounding).
--
-- If the market prices available on that date are not sufficient to
-- calculate this value, the amount is left unchanged.
--
amountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Amount -> Amount
amountValueAtDate :: PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> Amount
-> Amount
amountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mto Day
d Amount
a =
  let lbl :: [Char] -> ShowS
lbl = [Char] -> [Char] -> ShowS
lbl_ [Char]
"amountValueAtDate" in
  case PriceOracle
priceoracle (Day
d, Amount -> CommoditySymbol
acommodity Amount
a, Maybe CommoditySymbol
mto) of
    Maybe (CommoditySymbol, Quantity)
Nothing           -> Amount
a
    Just (CommoditySymbol
comm, Quantity
rate) ->
      Amount
nullamt{acommodity=comm, aquantity=rate * aquantity a}

      -- Manage style and precision of the new amount. Initially:
      --  rate is a Decimal with the internal precision of the original market price declaration.
      --  aquantity is a Decimal with a's internal precision.
      --  The calculated value's internal precision may be different from these.
      --  Its display precision will be that of nullamt (0).
      -- Now apply the standard display style for comm (if there is one)
      Amount -> (Amount -> Amount) -> Amount
forall a b. a -> (a -> b) -> b
& Map CommoditySymbol AmountStyle -> Amount -> Amount
forall a. HasAmounts a => Map CommoditySymbol AmountStyle -> a -> a
styleAmounts Map CommoditySymbol AmountStyle
styles
      -- set the display precision to match the internal precision (showing all digits),
      -- unnormalised (don't strip trailing zeros);
      -- but if it looks like an infinite decimal, limit the precision to 8.
      Amount -> (Amount -> Amount) -> Amount
forall a b. a -> (a -> b) -> b
& Maybe Word8 -> Amount -> Amount
amountSetFullPrecisionOr Maybe Word8
forall a. Maybe a
Nothing
      Amount -> (Amount -> Amount) -> Amount
forall a b. a -> (a -> b) -> b
& (Amount -> [Char]) -> Amount -> Amount
forall a. Show a => (a -> [Char]) -> a -> a
dbg9With ([Char] -> ShowS
lbl [Char]
"calculated value"ShowS -> (Amount -> [Char]) -> Amount -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Amount -> [Char]
showAmount)

-- | Calculate the gain of each component amount, that is the difference
-- between the valued amount and the value of the cost basis (see
-- mixedAmountApplyValuation).
--
-- If the commodity we are valuing in is not the same as the commodity of the
-- cost, this will value the cost at the same date as the primary amount. This
-- may not be what you want; for example you may want the cost valued at the
-- posting date. If so, let us know and we can change this behaviour.
mixedAmountApplyGain :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Day -> ValuationType -> MixedAmount -> MixedAmount
mixedAmountApplyGain :: PriceOracle
-> Map CommoditySymbol AmountStyle
-> Day
-> Day
-> Day
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyGain PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Day
periodlast Day
today Day
postingdate ValuationType
v MixedAmount
ma =
  PriceOracle
-> Map CommoditySymbol AmountStyle
-> Day
-> Day
-> Day
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyValuation PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Day
periodlast Day
today Day
postingdate ValuationType
v (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
ma MixedAmount -> MixedAmount -> MixedAmount
`maMinus` MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
ma

-- | Calculate the gain of each component amount, that is the
-- difference between the valued amount and the value of the cost basis.
--
-- If the commodity we are valuing in is not the same as the commodity of the
-- cost, this will value the cost at the same date as the primary amount. This
-- may not be what you want; for example you may want the cost valued at the
-- posting date. If so, let us know and we can change this behaviour.
mixedAmountGainAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount
mixedAmountGainAtDate :: PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> MixedAmount
-> MixedAmount
mixedAmountGainAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mto Day
d MixedAmount
ma =
  PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> MixedAmount
-> MixedAmount
mixedAmountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mto Day
d (MixedAmount -> MixedAmount) -> MixedAmount -> MixedAmount
forall a b. (a -> b) -> a -> b
$ MixedAmount
ma MixedAmount -> MixedAmount -> MixedAmount
`maMinus` MixedAmount -> MixedAmount
mixedAmountCost MixedAmount
ma

------------------------------------------------------------------------------
-- Market price lookup

-- | Given a memoising price graph generator, a valuation date, a
-- source commodity and an optional valuation commodity, find the
-- value on that date of one unit of the source commodity in the
-- valuation commodity, or in a default valuation commodity. Returns
-- the valuation commodity that was specified or chosen, and the
-- quantity of it that one unit of the source commodity is worth. Or
-- if no applicable market price can be found or calculated, or if the
-- source commodity and the valuation commodity are the same, returns
-- Nothing.
--
-- See makePriceGraph for how prices are determined.
-- Note that both market prices and default valuation commodities can
-- vary with valuation date, since that determines which market prices
-- are visible.
--
priceLookup :: (Day -> PriceGraph) -> Day -> CommoditySymbol -> Maybe CommoditySymbol -> Maybe (CommoditySymbol, Quantity)
priceLookup :: (Day -> PriceGraph)
-> Day
-> CommoditySymbol
-> Maybe CommoditySymbol
-> Maybe (CommoditySymbol, Quantity)
priceLookup Day -> PriceGraph
makepricegraph Day
d CommoditySymbol
from Maybe CommoditySymbol
mto =
  -- trace ("priceLookup ("++show d++", "++show from++", "++show mto++")") $
  let
    PriceGraph{pgEdges :: PriceGraph -> [MarketPrice]
pgEdges=[MarketPrice]
forwardprices
              ,pgEdgesRev :: PriceGraph -> [MarketPrice]
pgEdgesRev=[MarketPrice]
allprices
              ,pgDefaultValuationCommodities :: PriceGraph -> Map CommoditySymbol CommoditySymbol
pgDefaultValuationCommodities=Map CommoditySymbol CommoditySymbol
defaultdests
              } =
      Int -> [Char] -> PriceGraph -> PriceGraph
forall a. Int -> [Char] -> a -> a
traceOrLogAt Int
1 ([Char]
"valuation date: "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Day -> [Char]
forall a. Show a => a -> [Char]
show Day
d) (PriceGraph -> PriceGraph) -> PriceGraph -> PriceGraph
forall a b. (a -> b) -> a -> b
$ Day -> PriceGraph
makepricegraph Day
d
    mto' :: Maybe CommoditySymbol
mto' = Maybe CommoditySymbol
mto Maybe CommoditySymbol
-> Maybe CommoditySymbol -> Maybe CommoditySymbol
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe CommoditySymbol
mdefaultto
      where
        mdefaultto :: Maybe CommoditySymbol
mdefaultto = [Char] -> Maybe CommoditySymbol -> Maybe CommoditySymbol
forall a. Show a => [Char] -> a -> a
dbg1 ([Char]
"default valuation commodity for "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++CommoditySymbol -> [Char]
T.unpack CommoditySymbol
from) (Maybe CommoditySymbol -> Maybe CommoditySymbol)
-> Maybe CommoditySymbol -> Maybe CommoditySymbol
forall a b. (a -> b) -> a -> b
$
                     CommoditySymbol
-> Map CommoditySymbol CommoditySymbol -> Maybe CommoditySymbol
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup CommoditySymbol
from Map CommoditySymbol CommoditySymbol
defaultdests
  in
    case Maybe CommoditySymbol
mto' of
      Maybe CommoditySymbol
Nothing            -> Maybe (CommoditySymbol, Quantity)
forall a. Maybe a
Nothing
      Just CommoditySymbol
to | CommoditySymbol
toCommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
==CommoditySymbol
from -> Maybe (CommoditySymbol, Quantity)
forall a. Maybe a
Nothing
      Just CommoditySymbol
to            ->
        -- We have a commodity to convert to. Find the most direct price available,
        -- according to the rules described in makePriceGraph.
        let msg :: [Char]
msg = [Char] -> CommoditySymbol -> CommoditySymbol -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"seeking %s to %s price" (CommoditySymbol -> CommoditySymbol
showCommoditySymbol CommoditySymbol
from) (CommoditySymbol -> CommoditySymbol
showCommoditySymbol CommoditySymbol
to)
        in case 
          (Int -> [Char] -> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a. Int -> [Char] -> a -> a
traceOrLogAt Int
2 ([Char]
msg[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" using forward prices") (Maybe [MarketPrice] -> Maybe [MarketPrice])
-> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a b. (a -> b) -> a -> b
$ 
            CommoditySymbol
-> CommoditySymbol -> [MarketPrice] -> Maybe [MarketPrice]
pricesShortestPath CommoditySymbol
from CommoditySymbol
to [MarketPrice]
forwardprices)
          Maybe [MarketPrice] -> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a. Maybe a -> Maybe a -> Maybe a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 
          (Int -> [Char] -> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a. Int -> [Char] -> a -> a
traceOrLogAt Int
2 ([Char]
msg[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
" using forward and reverse prices") (Maybe [MarketPrice] -> Maybe [MarketPrice])
-> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a b. (a -> b) -> a -> b
$ 
            CommoditySymbol
-> CommoditySymbol -> [MarketPrice] -> Maybe [MarketPrice]
pricesShortestPath CommoditySymbol
from CommoditySymbol
to [MarketPrice]
allprices)
        of
          Maybe [MarketPrice]
Nothing -> Maybe (CommoditySymbol, Quantity)
forall a. Maybe a
Nothing
          Just [] -> Maybe (CommoditySymbol, Quantity)
forall a. Maybe a
Nothing
          Just [MarketPrice]
ps -> (CommoditySymbol, Quantity) -> Maybe (CommoditySymbol, Quantity)
forall a. a -> Maybe a
Just (MarketPrice -> CommoditySymbol
mpto (MarketPrice -> CommoditySymbol) -> MarketPrice -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ [MarketPrice] -> MarketPrice
forall a. HasCallStack => [a] -> a
last [MarketPrice]
ps, Quantity
rate)
            where
              rates :: [Quantity]
rates = (MarketPrice -> Quantity) -> [MarketPrice] -> [Quantity]
forall a b. (a -> b) -> [a] -> [b]
map MarketPrice -> Quantity
mprate [MarketPrice]
ps
              rate :: Quantity
rate =
                -- aggregate all the prices into one
                [Quantity] -> Quantity
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
product [Quantity]
rates
                -- product (Decimal's Num instance) normalises, stripping trailing zeros.
                -- Here we undo that (by restoring the old max precision with roundTo), 
                -- so that amountValueAtDate can see the original internal precision,
                -- to use as the display precision of calculated value amounts.
                -- (This can add more than the original number of trailing zeros to some prices,
                -- making them seem more precise than they were, but it seems harmless here.)
                Quantity -> (Quantity -> Quantity) -> Quantity
forall a b. a -> (a -> b) -> b
& Word8 -> Quantity -> Quantity
forall i. Integral i => Word8 -> DecimalRaw i -> DecimalRaw i
roundTo ([Word8] -> Word8
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Word8] -> Word8) -> [Word8] -> Word8
forall a b. (a -> b) -> a -> b
$ (Quantity -> Word8) -> [Quantity] -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Quantity -> Word8
forall i. DecimalRaw i -> Word8
decimalPlaces [Quantity]
rates)

tests_priceLookup :: TestTree
tests_priceLookup =
  let
    p :: Integer
-> Int
-> Int
-> CommoditySymbol
-> Quantity
-> CommoditySymbol
-> MarketPrice
p Integer
y Int
m Int
d CommoditySymbol
from Quantity
q CommoditySymbol
to = MarketPrice{mpdate :: Day
mpdate=Integer -> Int -> Int -> Day
fromGregorian Integer
y Int
m Int
d, mpfrom :: CommoditySymbol
mpfrom=CommoditySymbol
from, mpto :: CommoditySymbol
mpto=CommoditySymbol
to, mprate :: Quantity
mprate=Quantity
q}
    ps1 :: [MarketPrice]
ps1 = [
       Integer
-> Int
-> Int
-> CommoditySymbol
-> Quantity
-> CommoditySymbol
-> MarketPrice
p Integer
2000 Int
01 Int
01 CommoditySymbol
"A" Quantity
10 CommoditySymbol
"B"
      ,Integer
-> Int
-> Int
-> CommoditySymbol
-> Quantity
-> CommoditySymbol
-> MarketPrice
p Integer
2000 Int
01 Int
01 CommoditySymbol
"B" Quantity
10 CommoditySymbol
"C"
      ,Integer
-> Int
-> Int
-> CommoditySymbol
-> Quantity
-> CommoditySymbol
-> MarketPrice
p Integer
2000 Int
01 Int
01 CommoditySymbol
"C" Quantity
10 CommoditySymbol
"D"
      ,Integer
-> Int
-> Int
-> CommoditySymbol
-> Quantity
-> CommoditySymbol
-> MarketPrice
p Integer
2000 Int
01 Int
01 CommoditySymbol
"E"  Quantity
2 CommoditySymbol
"D"
      ,Integer
-> Int
-> Int
-> CommoditySymbol
-> Quantity
-> CommoditySymbol
-> MarketPrice
p Integer
2001 Int
01 Int
01 CommoditySymbol
"A" Quantity
11 CommoditySymbol
"B"
      ]
    makepricegraph :: Day -> PriceGraph
makepricegraph = [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph
makePriceGraph [MarketPrice]
ps1 []
  in [Char] -> Assertion -> TestTree
testCase [Char]
"priceLookup" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    (Day -> PriceGraph)
-> Day
-> CommoditySymbol
-> Maybe CommoditySymbol
-> Maybe (CommoditySymbol, Quantity)
priceLookup Day -> PriceGraph
makepricegraph (Integer -> Int -> Int -> Day
fromGregorian Integer
1999 Int
01 Int
01) CommoditySymbol
"A" Maybe CommoditySymbol
forall a. Maybe a
Nothing    Maybe (CommoditySymbol, Quantity)
-> Maybe (CommoditySymbol, Quantity) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= Maybe (CommoditySymbol, Quantity)
forall a. Maybe a
Nothing
    (Day -> PriceGraph)
-> Day
-> CommoditySymbol
-> Maybe CommoditySymbol
-> Maybe (CommoditySymbol, Quantity)
priceLookup Day -> PriceGraph
makepricegraph (Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
01 Int
01) CommoditySymbol
"A" Maybe CommoditySymbol
forall a. Maybe a
Nothing    Maybe (CommoditySymbol, Quantity)
-> Maybe (CommoditySymbol, Quantity) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (CommoditySymbol, Quantity) -> Maybe (CommoditySymbol, Quantity)
forall a. a -> Maybe a
Just (CommoditySymbol
"B",Quantity
10)
    (Day -> PriceGraph)
-> Day
-> CommoditySymbol
-> Maybe CommoditySymbol
-> Maybe (CommoditySymbol, Quantity)
priceLookup Day -> PriceGraph
makepricegraph (Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
01 Int
01) CommoditySymbol
"B" (CommoditySymbol -> Maybe CommoditySymbol
forall a. a -> Maybe a
Just CommoditySymbol
"A") Maybe (CommoditySymbol, Quantity)
-> Maybe (CommoditySymbol, Quantity) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (CommoditySymbol, Quantity) -> Maybe (CommoditySymbol, Quantity)
forall a. a -> Maybe a
Just (CommoditySymbol
"A",Quantity
0.1)
    (Day -> PriceGraph)
-> Day
-> CommoditySymbol
-> Maybe CommoditySymbol
-> Maybe (CommoditySymbol, Quantity)
priceLookup Day -> PriceGraph
makepricegraph (Integer -> Int -> Int -> Day
fromGregorian Integer
2000 Int
01 Int
01) CommoditySymbol
"A" (CommoditySymbol -> Maybe CommoditySymbol
forall a. a -> Maybe a
Just CommoditySymbol
"E") Maybe (CommoditySymbol, Quantity)
-> Maybe (CommoditySymbol, Quantity) -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= (CommoditySymbol, Quantity) -> Maybe (CommoditySymbol, Quantity)
forall a. a -> Maybe a
Just (CommoditySymbol
"E",Quantity
500)

------------------------------------------------------------------------------
-- Market price graph
-- built directly with MarketPrices for now, probably space-inefficient

type Edge = MarketPrice
type Path = [Edge]

data PriceGraph = PriceGraph {
   PriceGraph -> Day
pgDate :: Day
    -- ^ The date on which these prices are in effect.
  ,PriceGraph -> [MarketPrice]
pgEdges :: [Edge]
    -- ^ "Forward" exchange rates between commodity pairs, either
    --   declared by P directives or inferred from transaction prices,
    --   forming the edges of a directed graph.  
  ,PriceGraph -> [MarketPrice]
pgEdgesRev :: [Edge]
    -- ^ The same edges, plus any additional edges that can be
    --   inferred by reversing them and inverting the rates.
    --
    --   In both of these there will be at most one edge between each
    --   directed pair of commodities, eg there can be one USD->EUR and one EUR->USD.
  ,PriceGraph -> Map CommoditySymbol CommoditySymbol
pgDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol
    -- ^ The default valuation commodity for each source commodity.
    --   These are used when a valuation commodity is not specified
    --   (-V). They are the destination commodity of each source commodity's
    --   latest (declared or inferred, but not reverse) market price
    --   (on the date of this graph).
  }
  deriving (Int -> PriceGraph -> ShowS
[PriceGraph] -> ShowS
PriceGraph -> [Char]
(Int -> PriceGraph -> ShowS)
-> (PriceGraph -> [Char])
-> ([PriceGraph] -> ShowS)
-> Show PriceGraph
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PriceGraph -> ShowS
showsPrec :: Int -> PriceGraph -> ShowS
$cshow :: PriceGraph -> [Char]
show :: PriceGraph -> [Char]
$cshowList :: [PriceGraph] -> ShowS
showList :: [PriceGraph] -> ShowS
Show,(forall x. PriceGraph -> Rep PriceGraph x)
-> (forall x. Rep PriceGraph x -> PriceGraph) -> Generic PriceGraph
forall x. Rep PriceGraph x -> PriceGraph
forall x. PriceGraph -> Rep PriceGraph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PriceGraph -> Rep PriceGraph x
from :: forall x. PriceGraph -> Rep PriceGraph x
$cto :: forall x. Rep PriceGraph x -> PriceGraph
to :: forall x. Rep PriceGraph x -> PriceGraph
Generic)

-- | Find the shortest path and corresponding conversion rate, if any, 
-- from one commodity to another using the provided market prices which
-- form the edges of a directed graph. There should be at most one edge
-- between each directed pair of commodities, eg there can be one
-- USD->EUR price and one EUR->USD price.
pricesShortestPath :: CommoditySymbol -> CommoditySymbol -> [Edge] -> Maybe Path
pricesShortestPath :: CommoditySymbol
-> CommoditySymbol -> [MarketPrice] -> Maybe [MarketPrice]
pricesShortestPath CommoditySymbol
start CommoditySymbol
end [MarketPrice]
edges =
  -- at --debug=2 +, print the pretty path and also the detailed prices
  let label :: [Char]
label = [Char] -> CommoditySymbol -> CommoditySymbol -> [Char]
forall r. PrintfType r => [Char] -> r
printf [Char]
"shortest path from %s to %s: " (CommoditySymbol -> CommoditySymbol
showCommoditySymbol CommoditySymbol
start) (CommoditySymbol -> CommoditySymbol
showCommoditySymbol CommoditySymbol
end) in
  ([MarketPrice] -> [MarketPrice])
-> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([MarketPrice] -> [Char]) -> [MarketPrice] -> [MarketPrice]
forall a. Show a => (a -> [Char]) -> a -> a
dbg2With (([Char]
"price chain:\n"[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++)ShowS -> ([MarketPrice] -> [Char]) -> [MarketPrice] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.[MarketPrice] -> [Char]
forall a. Show a => a -> [Char]
pshow)) (Maybe [MarketPrice] -> Maybe [MarketPrice])
-> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a b. (a -> b) -> a -> b
$ 
  (Maybe [MarketPrice] -> [Char])
-> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a. Show a => (a -> [Char]) -> a -> a
dbg2With (([Char]
label[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++)ShowS
-> (Maybe [MarketPrice] -> [Char]) -> Maybe [MarketPrice] -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.([Char]
-> ([MarketPrice] -> [Char]) -> Maybe [MarketPrice] -> [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [Char]
"none found" ([Char] -> [MarketPrice] -> [Char]
pshowpath [Char]
""))) (Maybe [MarketPrice] -> Maybe [MarketPrice])
-> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a b. (a -> b) -> a -> b
$

  [([MarketPrice], [MarketPrice])] -> Maybe [MarketPrice]
find [([],[MarketPrice]
edges)]

  where
    -- Find the first and shortest complete path using a breadth-first search.
    find :: [(Path,[Edge])] -> Maybe Path
    find :: [([MarketPrice], [MarketPrice])] -> Maybe [MarketPrice]
find [([MarketPrice], [MarketPrice])]
paths =
      case (([MarketPrice], [MarketPrice])
 -> [([MarketPrice], [MarketPrice])])
-> [([MarketPrice], [MarketPrice])]
-> [([MarketPrice], [MarketPrice])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([MarketPrice], [MarketPrice]) -> [([MarketPrice], [MarketPrice])]
extend [([MarketPrice], [MarketPrice])]
paths of
        [] -> Maybe [MarketPrice]
forall a. Maybe a
Nothing 
        [([MarketPrice], [MarketPrice])]
_ | Int
pathlength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxpathlength -> 
          -- XXX This is unusual:
          -- 1. A warning, not an error, which we usually avoid
          -- 2. Not a debug message (when triggered, we always print it)
          -- 3. Printed either to stdout or (eg in hledger-ui) to the debug log file.
          -- This is the only place we use traceOrLog like this.
          -- Also before 1.32.2, traceOrLog was doing the opposite of what it should [#2134].
          [Char] -> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a. [Char] -> a -> a
traceOrLog ([Char]
"gave up searching for a price chain at length "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Int -> [Char]
forall a. Show a => a -> [Char]
show Int
maxpathlength[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
", please report a bug")
          Maybe [MarketPrice]
forall a. Maybe a
Nothing
          where 
            pathlength :: Int
pathlength = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
-> (([MarketPrice], [MarketPrice]) -> Int)
-> Maybe ([MarketPrice], [MarketPrice])
-> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ([MarketPrice] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([MarketPrice] -> Int)
-> (([MarketPrice], [MarketPrice]) -> [MarketPrice])
-> ([MarketPrice], [MarketPrice])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([MarketPrice], [MarketPrice]) -> [MarketPrice]
forall a b. (a, b) -> a
fst) ([([MarketPrice], [MarketPrice])]
-> Maybe ([MarketPrice], [MarketPrice])
forall a. [a] -> Maybe a
headMay [([MarketPrice], [MarketPrice])]
paths)
            maxpathlength :: Int
maxpathlength = Int
1000
        [([MarketPrice], [MarketPrice])]
paths' -> 
          case [[MarketPrice]]
completepaths of
                [MarketPrice]
p:[[MarketPrice]]
_ -> [MarketPrice] -> Maybe [MarketPrice]
forall a. a -> Maybe a
Just [MarketPrice]
p  -- the left-most complete path at this length
                []  -> [([MarketPrice], [MarketPrice])] -> Maybe [MarketPrice]
find [([MarketPrice], [MarketPrice])]
paths'
          where completepaths :: [[MarketPrice]]
completepaths = [[MarketPrice]
p | ([MarketPrice]
p,[MarketPrice]
_) <- [([MarketPrice], [MarketPrice])]
paths', (MarketPrice -> CommoditySymbol
mpto (MarketPrice -> CommoditySymbol)
-> Maybe MarketPrice -> Maybe CommoditySymbol
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [MarketPrice] -> Maybe MarketPrice
forall a. [a] -> Maybe a
lastMay [MarketPrice]
p) Maybe CommoditySymbol -> Maybe CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CommoditySymbol -> Maybe CommoditySymbol
forall a. a -> Maybe a
Just CommoditySymbol
end]

    -- Use all applicable edges from those provided to extend this path by one step,
    -- returning zero or more new (path, remaining edges) pairs.
    extend :: (Path,[Edge]) -> [(Path,[Edge])]
    extend :: ([MarketPrice], [MarketPrice]) -> [([MarketPrice], [MarketPrice])]
extend ([MarketPrice]
path,[MarketPrice]
unusededges) =
      let
        pathnodes :: [CommoditySymbol]
pathnodes = CommoditySymbol
start CommoditySymbol -> [CommoditySymbol] -> [CommoditySymbol]
forall a. a -> [a] -> [a]
: (MarketPrice -> CommoditySymbol)
-> [MarketPrice] -> [CommoditySymbol]
forall a b. (a -> b) -> [a] -> [b]
map MarketPrice -> CommoditySymbol
mpto [MarketPrice]
path
        pathend :: CommoditySymbol
pathend = CommoditySymbol
-> (MarketPrice -> CommoditySymbol)
-> Maybe MarketPrice
-> CommoditySymbol
forall b a. b -> (a -> b) -> Maybe a -> b
maybe CommoditySymbol
start MarketPrice -> CommoditySymbol
mpto (Maybe MarketPrice -> CommoditySymbol)
-> Maybe MarketPrice -> CommoditySymbol
forall a b. (a -> b) -> a -> b
$ [MarketPrice] -> Maybe MarketPrice
forall a. [a] -> Maybe a
lastMay [MarketPrice]
path
        ([MarketPrice]
nextedges,[MarketPrice]
remainingedges) = (MarketPrice -> Bool)
-> [MarketPrice] -> ([MarketPrice], [MarketPrice])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
==CommoditySymbol
pathend)(CommoditySymbol -> Bool)
-> (MarketPrice -> CommoditySymbol) -> MarketPrice -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MarketPrice -> CommoditySymbol
mpfrom) [MarketPrice]
unusededges
      in
        [ ([MarketPrice]
path', [MarketPrice]
remainingedges')
        | MarketPrice
e <- [MarketPrice]
nextedges
        , let path' :: [MarketPrice]
path' = [Char] -> [MarketPrice] -> [MarketPrice]
dbgpath [Char]
"trying" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$ [MarketPrice]
path [MarketPrice] -> [MarketPrice] -> [MarketPrice]
forall a. [a] -> [a] -> [a]
++ [MarketPrice
e]  -- PERF prepend ?
        , let pathnodes' :: [CommoditySymbol]
pathnodes' = MarketPrice -> CommoditySymbol
mpto MarketPrice
e CommoditySymbol -> [CommoditySymbol] -> [CommoditySymbol]
forall a. a -> [a] -> [a]
: [CommoditySymbol]
pathnodes
        , let remainingedges' :: [MarketPrice]
remainingedges' = [MarketPrice
r | MarketPrice
r <- [MarketPrice]
remainingedges, MarketPrice -> CommoditySymbol
mpto MarketPrice
r CommoditySymbol -> [CommoditySymbol] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CommoditySymbol]
pathnodes' ]
        ]

-- debug helpers
dbgpath :: [Char] -> [MarketPrice] -> [MarketPrice]
dbgpath  [Char]
label = ([MarketPrice] -> [Char]) -> [MarketPrice] -> [MarketPrice]
forall a. Show a => (a -> [Char]) -> a -> a
dbg2With ([Char] -> [MarketPrice] -> [Char]
pshowpath [Char]
label)
-- dbgedges label = dbg2With (pshowedges label)
pshowpath :: [Char] -> [MarketPrice] -> [Char]
pshowpath [Char]
label = \case
  []      -> [Char] -> ShowS
prefix [Char]
label [Char]
""
  p :: [MarketPrice]
p@(MarketPrice
e:[MarketPrice]
_) -> [Char] -> ShowS
prefix [Char]
label ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ CommoditySymbol -> [Char]
pshownode (MarketPrice -> CommoditySymbol
mpfrom MarketPrice
e) [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
">" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char] -> [[Char]] -> [Char]
forall a. [a] -> [[a]] -> [a]
intercalate [Char]
">" ((MarketPrice -> [Char]) -> [MarketPrice] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map (CommoditySymbol -> [Char]
pshownode (CommoditySymbol -> [Char])
-> (MarketPrice -> CommoditySymbol) -> MarketPrice -> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MarketPrice -> CommoditySymbol
mpto) [MarketPrice]
p)
-- pshowedges label = prefix label . intercalate ", " . map (pshowedge "")
-- pshowedge label MarketPrice{..} = pshowedge' label mpfrom mpto
-- pshowedge' label from to = prefix label $ pshownode from ++ ">" ++ pshownode to
pshownode :: CommoditySymbol -> [Char]
pshownode = CommoditySymbol -> [Char]
T.unpack (CommoditySymbol -> [Char])
-> (CommoditySymbol -> CommoditySymbol)
-> CommoditySymbol
-> [Char]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CommoditySymbol -> CommoditySymbol
showCommoditySymbol
prefix :: [Char] -> ShowS
prefix [Char]
l = if [Char] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Char]
l then ([Char]
""[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++) else (([Char]
l[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++[Char]
": ")[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++)

-- | A snapshot of the known exchange rates between commodity pairs at a given date.
-- This is a home-made version, more tailored to our needs.
-- | Build the graph of commodity conversion prices for a given day.
-- Converts a list of declared market prices in parse order, and a
-- list of transaction-inferred market prices in parse order, to:
--
-- 1. a graph of all known exchange rates declared or inferred from 
-- one commodity to another in effect on that day
--
-- 2. a second graph which includes any additional exchange rates
-- that can be inferred by reversing known rates
--
-- 3. a map of each commodity's default valuation commodity, if any.
--
-- These allow price lookup and valuation to be performed as
-- described in hledger.m4.md -> Valuation:
--
-- "hledger looks for a market price (exchange rate) from commodity A
-- to commodity B in one or more of these ways, in this order of
-- preference:
--
-- 1. A *declared market price* or *inferred market price*:
--    A's latest market price in B on or before the valuation date
--    as declared by a P directive, or (with the `--infer-market-prices` flag)
--    inferred from transaction prices.
--   
-- 2. A *reverse market price*:
--    the inverse of a declared or inferred market price from B to A.
-- 
-- 3. A *a forward chain of market prices*:
--    a synthetic price formed by combining the shortest chain of
--    "forward" (only 1 above) market prices, leading from A to B.
--
-- 4. A *any chain of market prices*:
--    a chain of any market prices, including both forward and
--    reverse prices (1 and 2 above), leading from A to B."
--
-- and: "For each commodity A, hledger picks a default valuation
-- commodity as follows, in this order of preference:
--
-- 1. The price commodity from the latest declared market price for A
--    on or before valuation date.
--
-- 2. The price commodity from the latest declared market price for A
--    on any date. (Allows conversion to proceed if there are inferred
--    prices before the valuation date.)
--
-- 3. If there are no P directives at all (any commodity or date), and
--    the `--infer-market-prices` flag is used, then the price commodity from
--    the latest transaction price for A on or before valuation date."
--
makePriceGraph :: [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph
makePriceGraph :: [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph
makePriceGraph [MarketPrice]
alldeclaredprices [MarketPrice]
allinferredprices Day
d =
  [Char] -> PriceGraph -> PriceGraph
forall a. Show a => [Char] -> a -> a
dbg9 ([Char]
"makePriceGraph "[Char] -> ShowS
forall a. [a] -> [a] -> [a]
++Day -> [Char]
forall a. Show a => a -> [Char]
show Day
d) (PriceGraph -> PriceGraph) -> PriceGraph -> PriceGraph
forall a b. (a -> b) -> a -> b
$
  PriceGraph{
     pgDate :: Day
pgDate = Day
d
    ,pgEdges :: [MarketPrice]
pgEdges=[MarketPrice]
forwardprices
    ,pgEdgesRev :: [MarketPrice]
pgEdgesRev=[MarketPrice]
allprices
    ,pgDefaultValuationCommodities :: Map CommoditySymbol CommoditySymbol
pgDefaultValuationCommodities=Map CommoditySymbol CommoditySymbol
defaultdests
    }
  where
    -- XXX logic duplicated in Hledger.Cli.Commands.Prices.prices, keep synced

    -- prices in effect on date d, either declared or inferred
    visibledeclaredprices :: [MarketPrice]
visibledeclaredprices = [Char] -> [MarketPrice] -> [MarketPrice]
forall a. Show a => [Char] -> a -> a
dbg9 [Char]
"visibledeclaredprices" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$ (MarketPrice -> Bool) -> [MarketPrice] -> [MarketPrice]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<=Day
d)(Day -> Bool) -> (MarketPrice -> Day) -> MarketPrice -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MarketPrice -> Day
mpdate) [MarketPrice]
alldeclaredprices
    visibleinferredprices :: [MarketPrice]
visibleinferredprices = [Char] -> [MarketPrice] -> [MarketPrice]
forall a. Show a => [Char] -> a -> a
dbg9 [Char]
"visibleinferredprices" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$ (MarketPrice -> Bool) -> [MarketPrice] -> [MarketPrice]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Day -> Day -> Bool
forall a. Ord a => a -> a -> Bool
<=Day
d)(Day -> Bool) -> (MarketPrice -> Day) -> MarketPrice -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.MarketPrice -> Day
mpdate) [MarketPrice]
allinferredprices
    forwardprices :: [MarketPrice]
forwardprices = [MarketPrice] -> [MarketPrice] -> [MarketPrice]
effectiveMarketPrices [MarketPrice]
visibledeclaredprices [MarketPrice]
visibleinferredprices

    -- infer any additional reverse prices not already declared or inferred
    reverseprices :: [MarketPrice]
reverseprices = [Char] -> [MarketPrice] -> [MarketPrice]
forall a. Show a => [Char] -> a -> a
dbg9 [Char]
"additional reverse prices" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$
      [MarketPrice
p | p :: MarketPrice
p@MarketPrice{Quantity
CommoditySymbol
Day
mpdate :: MarketPrice -> Day
mpfrom :: MarketPrice -> CommoditySymbol
mpto :: MarketPrice -> CommoditySymbol
mprate :: MarketPrice -> Quantity
mpdate :: Day
mpfrom :: CommoditySymbol
mpto :: CommoditySymbol
mprate :: Quantity
..} <- (MarketPrice -> MarketPrice) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> [a] -> [b]
map MarketPrice -> MarketPrice
marketPriceReverse [MarketPrice]
forwardprices
         , Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (CommoditySymbol
mpfrom,CommoditySymbol
mpto) (CommoditySymbol, CommoditySymbol)
-> Set (CommoditySymbol, CommoditySymbol) -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set (CommoditySymbol, CommoditySymbol)
forwardpairs
      ]
      where
        forwardpairs :: Set (CommoditySymbol, CommoditySymbol)
forwardpairs = [(CommoditySymbol, CommoditySymbol)]
-> Set (CommoditySymbol, CommoditySymbol)
forall a. Ord a => [a] -> Set a
S.fromList [(CommoditySymbol
mpfrom,CommoditySymbol
mpto) | MarketPrice{Quantity
CommoditySymbol
Day
mpdate :: MarketPrice -> Day
mpfrom :: MarketPrice -> CommoditySymbol
mpto :: MarketPrice -> CommoditySymbol
mprate :: MarketPrice -> Quantity
mpfrom :: CommoditySymbol
mpto :: CommoditySymbol
mpdate :: Day
mprate :: Quantity
..} <- [MarketPrice]
forwardprices]
    allprices :: [MarketPrice]
allprices = [MarketPrice]
forwardprices [MarketPrice] -> [MarketPrice] -> [MarketPrice]
forall a. [a] -> [a] -> [a]
++ [MarketPrice]
reverseprices

    -- determine a default valuation commodity for each source commodity
    -- somewhat but not quite like effectiveMarketPrices
    defaultdests :: Map CommoditySymbol CommoditySymbol
defaultdests = [(CommoditySymbol, CommoditySymbol)]
-> Map CommoditySymbol CommoditySymbol
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(CommoditySymbol
mpfrom,CommoditySymbol
mpto) | MarketPrice{Quantity
CommoditySymbol
Day
mpdate :: MarketPrice -> Day
mpfrom :: MarketPrice -> CommoditySymbol
mpto :: MarketPrice -> CommoditySymbol
mprate :: MarketPrice -> Quantity
mpfrom :: CommoditySymbol
mpto :: CommoditySymbol
mpdate :: Day
mprate :: Quantity
..} <- [MarketPrice]
pricesfordefaultcomms]
      where
        pricesfordefaultcomms :: [MarketPrice]
pricesfordefaultcomms = [Char] -> [MarketPrice] -> [MarketPrice]
forall a. Show a => [Char] -> a -> a
dbg9 [Char]
"prices for choosing default valuation commodities, by date then parse order" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$
          [MarketPrice]
ps
          [MarketPrice]
-> ([MarketPrice] -> [(Integer, MarketPrice)])
-> [(Integer, MarketPrice)]
forall a b. a -> (a -> b) -> b
& [Integer] -> [MarketPrice] -> [(Integer, MarketPrice)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..]  -- label items with their parse order
          [(Integer, MarketPrice)]
-> ([(Integer, MarketPrice)] -> [(Integer, MarketPrice)])
-> [(Integer, MarketPrice)]
forall a b. a -> (a -> b) -> b
& ((Integer, MarketPrice) -> (Integer, MarketPrice) -> Ordering)
-> [(Integer, MarketPrice)] -> [(Integer, MarketPrice)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ((Day, Integer) -> (Day, Integer) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Day, Integer) -> (Day, Integer) -> Ordering)
-> ((Integer, MarketPrice) -> (Day, Integer))
-> (Integer, MarketPrice)
-> (Integer, MarketPrice)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(Integer
parseorder,MarketPrice{Quantity
CommoditySymbol
Day
mpdate :: MarketPrice -> Day
mpfrom :: MarketPrice -> CommoditySymbol
mpto :: MarketPrice -> CommoditySymbol
mprate :: MarketPrice -> Quantity
mpdate :: Day
mpfrom :: CommoditySymbol
mpto :: CommoditySymbol
mprate :: Quantity
..})->(Day
mpdate,Integer
parseorder)))  -- sort by increasing date then increasing parse order
          [(Integer, MarketPrice)]
-> ([(Integer, MarketPrice)] -> [MarketPrice]) -> [MarketPrice]
forall a b. a -> (a -> b) -> b
& ((Integer, MarketPrice) -> MarketPrice)
-> [(Integer, MarketPrice)] -> [MarketPrice]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, MarketPrice) -> MarketPrice
forall a b. (a, b) -> b
snd    -- discard labels
          where
            ps :: [MarketPrice]
ps | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [MarketPrice] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MarketPrice]
visibledeclaredprices = [MarketPrice]
visibledeclaredprices
               | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [MarketPrice] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [MarketPrice]
alldeclaredprices     = [MarketPrice]
alldeclaredprices
               | Bool
otherwise                        = [MarketPrice]
visibleinferredprices  -- will be null without --infer-market-prices

-- | Given a list of P-declared market prices in parse order and a
-- list of transaction-inferred market prices in parse order, select
-- just the latest prices that are in effect for each commodity pair.
-- That is, for each commodity pair, the latest price by date then
-- parse order, with declared prices having precedence over inferred
-- prices on the same day.
effectiveMarketPrices :: [MarketPrice] -> [MarketPrice] -> [MarketPrice]
effectiveMarketPrices :: [MarketPrice] -> [MarketPrice] -> [MarketPrice]
effectiveMarketPrices [MarketPrice]
declaredprices [MarketPrice]
inferredprices =
  let
    -- label each item with its same-day precedence, then parse order
    declaredprices' :: [(Integer, Integer, MarketPrice)]
declaredprices' = [(Integer
1, Integer
i, MarketPrice
p) | (Integer
i,MarketPrice
p) <- [Integer] -> [MarketPrice] -> [(Integer, MarketPrice)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [MarketPrice]
declaredprices]
    inferredprices' :: [(Integer, Integer, MarketPrice)]
inferredprices' = [(Integer
0, Integer
i, MarketPrice
p) | (Integer
i,MarketPrice
p) <- [Integer] -> [MarketPrice] -> [(Integer, MarketPrice)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Integer
1..] [MarketPrice]
inferredprices]
  in
    [Char] -> [MarketPrice] -> [MarketPrice]
forall a. Show a => [Char] -> a -> a
dbg9 [Char]
"effective forward prices" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$
    -- combine
    [(Integer, Integer, MarketPrice)]
declaredprices' [(Integer, Integer, MarketPrice)]
-> [(Integer, Integer, MarketPrice)]
-> [(Integer, Integer, MarketPrice)]
forall a. [a] -> [a] -> [a]
++ [(Integer, Integer, MarketPrice)]
inferredprices'
    -- sort by decreasing date then decreasing precedence then decreasing parse order
    [(Integer, Integer, MarketPrice)]
-> ([(Integer, Integer, MarketPrice)]
    -> [(Integer, Integer, MarketPrice)])
-> [(Integer, Integer, MarketPrice)]
forall a b. a -> (a -> b) -> b
& ((Integer, Integer, MarketPrice)
 -> (Integer, Integer, MarketPrice) -> Ordering)
-> [(Integer, Integer, MarketPrice)]
-> [(Integer, Integer, MarketPrice)]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (((Day, Integer, Integer) -> (Day, Integer, Integer) -> Ordering)
-> (Day, Integer, Integer) -> (Day, Integer, Integer) -> Ordering
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Day, Integer, Integer) -> (Day, Integer, Integer) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((Day, Integer, Integer) -> (Day, Integer, Integer) -> Ordering)
-> ((Integer, Integer, MarketPrice) -> (Day, Integer, Integer))
-> (Integer, Integer, MarketPrice)
-> (Integer, Integer, MarketPrice)
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(Integer
precedence,Integer
parseorder,MarketPrice
mp)->(MarketPrice -> Day
mpdate MarketPrice
mp,Integer
precedence,Integer
parseorder)))
    -- discard the sorting labels
    [(Integer, Integer, MarketPrice)]
-> ([(Integer, Integer, MarketPrice)] -> [MarketPrice])
-> [MarketPrice]
forall a b. a -> (a -> b) -> b
& ((Integer, Integer, MarketPrice) -> MarketPrice)
-> [(Integer, Integer, MarketPrice)] -> [MarketPrice]
forall a b. (a -> b) -> [a] -> [b]
map (Integer, Integer, MarketPrice) -> MarketPrice
forall {a} {b} {c}. (a, b, c) -> c
third3
    -- keep only the first (ie the newest, highest precedence, latest parsed) price for each pair
    [MarketPrice] -> ([MarketPrice] -> [MarketPrice]) -> [MarketPrice]
forall a b. a -> (a -> b) -> b
& (MarketPrice -> MarketPrice -> Ordering)
-> [MarketPrice] -> [MarketPrice]
forall a. (a -> a -> Ordering) -> [a] -> [a]
nubSortBy ((CommoditySymbol, CommoditySymbol)
-> (CommoditySymbol, CommoditySymbol) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ((CommoditySymbol, CommoditySymbol)
 -> (CommoditySymbol, CommoditySymbol) -> Ordering)
-> (MarketPrice -> (CommoditySymbol, CommoditySymbol))
-> MarketPrice
-> MarketPrice
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (\(MarketPrice{Quantity
CommoditySymbol
Day
mpdate :: MarketPrice -> Day
mpfrom :: MarketPrice -> CommoditySymbol
mpto :: MarketPrice -> CommoditySymbol
mprate :: MarketPrice -> Quantity
mpdate :: Day
mpfrom :: CommoditySymbol
mpto :: CommoditySymbol
mprate :: Quantity
..})->(CommoditySymbol
mpfrom,CommoditySymbol
mpto)))

marketPriceReverse :: MarketPrice -> MarketPrice
marketPriceReverse :: MarketPrice -> MarketPrice
marketPriceReverse mp :: MarketPrice
mp@MarketPrice{Quantity
CommoditySymbol
Day
mpdate :: MarketPrice -> Day
mpfrom :: MarketPrice -> CommoditySymbol
mpto :: MarketPrice -> CommoditySymbol
mprate :: MarketPrice -> Quantity
mpdate :: Day
mpfrom :: CommoditySymbol
mpto :: CommoditySymbol
mprate :: Quantity
..} = 
  MarketPrice
mp{mpfrom=mpto, mpto=mpfrom, mprate=if mprate==0 then 0 else 1/mprate}  -- PARTIAL: /

nullmarketprice :: MarketPrice
nullmarketprice :: MarketPrice
nullmarketprice = MarketPrice {
   mpdate :: Day
mpdate=Day
nulldate
  ,mpfrom :: CommoditySymbol
mpfrom=CommoditySymbol
""
  ,mpto :: CommoditySymbol
mpto=CommoditySymbol
""
  ,mprate :: Quantity
mprate=Quantity
0
  }

------------------------------------------------------------------------------

tests_Valuation :: TestTree
tests_Valuation = [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Valuation" [
   TestTree
tests_priceLookup
  ,[Char] -> Assertion -> TestTree
testCase [Char]
"marketPriceReverse" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
    MarketPrice -> MarketPrice
marketPriceReverse MarketPrice
nullmarketprice{mprate=2} MarketPrice -> MarketPrice -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= MarketPrice
nullmarketprice{mprate=0.5}
    MarketPrice -> MarketPrice
marketPriceReverse MarketPrice
nullmarketprice MarketPrice -> MarketPrice -> Assertion
forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= MarketPrice
nullmarketprice  -- the reverse of a 0 price is a 0 price


  ]