    {-|

    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
      -- ,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)

    ------------------------------------------------------------------------------
    -- 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)

    -- | 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
                 }

    -- | Make one or more `MarketPrice` from an 'Amount' and its price directives.
    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
    fromq} = case Amount -> Maybe AmountPrice
    aprice Amount
    amt of
        Just (UnitPrice Amount
    pa)               -> 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 :: Amount
    pdamount=Amount
    pa}
        Just (TotalPrice Amount
    pa) | Quantity
    fromq 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 :: Amount
    pdamount=Quantity
    fromq Quantity -> Amount -> Amount
    `divideAmountExtraPrecision` Amount
    pa}
        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}

        divideAmountExtraPrecision :: Quantity -> Amount -> Amount
    divideAmountExtraPrecision Quantity
    n Amount
    a = (Quantity
    n Quantity -> Amount -> Amount
    `divideAmount` Amount
    a) { astyle :: AmountStyle
    astyle = AmountStyle
    style' }
          where
            style' :: AmountStyle
    style' = (Amount -> AmountStyle
    astyle Amount
    a) { asprecision :: AmountPrecision
    asprecision = AmountPrecision
    precision' }
            precision' :: AmountPrecision
    precision' = case AmountStyle -> AmountPrecision
    asprecision (Amount -> AmountStyle
    astyle Amount
    a) of
                              AmountPrecision
    NaturalPrecision -> AmountPrecision
    NaturalPrecision
                              Precision Word8
    p      -> Word8 -> AmountPrecision
    Precision (Word8 -> AmountPrecision) -> Word8 -> AmountPrecision
    forall a b. (a -> b) -> a -> b
    $ (Int -> Word8
    forall a. Integral a => Int -> a
    numDigitsInt (Int -> Word8) -> Int -> Word8
    forall a b. (a -> b) -> a -> b
    $ Quantity -> Int
    forall b. Integral b => Quantity -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    truncate Quantity
    n) Word8 -> Word8 -> Word8
    forall a. Num a => a -> a -> a
    + Word8
    p

    ------------------------------------------------------------------------------
    -- 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
    styleAmount 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,
    -- but with the precision adjusted to show all significant decimal digits
    -- up to a maximum of 8. (experimental)
    --
    -- 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 =
      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) ->
          -- setNaturalPrecisionUpTo 8 $  -- XXX force higher precision in case amount appears to be zero ?
                                          -- Make default display style use precision 2 instead of 0 ?
                                          -- Leave as is for now; mentioned in manual.
          Map CommoditySymbol AmountStyle -> Amount -> Amount
    styleAmount Map CommoditySymbol AmountStyle
    styles
          Amount
    nullamt{acommodity :: CommoditySymbol
    acommodity=CommoditySymbol
    comm, aquantity :: Quantity
    aquantity=Quantity
    rate Quantity -> Quantity -> Quantity
    forall a. Num a => a -> a -> a
    * Amount -> Quantity
    aquantity Amount
    a}

    -- | 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] -> Quantity
    forall a. Num a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    product ([Quantity] -> Quantity) -> [Quantity] -> Quantity
    forall a b. (a -> b) -> a -> b
    $ (MarketPrice -> Quantity) -> [MarketPrice] -> [Quantity]
    forall a b. (a -> b) -> [a] -> [b]
    map MarketPrice -> Quantity
    mprate [MarketPrice]
    ps)

    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 ->
              [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
        -- 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 :: CommoditySymbol
    mpfrom=CommoditySymbol
    mpto, mpto :: CommoditySymbol
    mpto=CommoditySymbol
    mpfrom, mprate :: Quantity
    mprate=if Quantity
    mprateQuantity -> Quantity -> Bool
    forall a. Eq a => a -> a -> Bool
    ==Quantity
    0 then Quantity
    0 else Quantity
    1Quantity -> Quantity -> Quantity
    forall a. Fractional a => a -> a -> a
    /Quantity
    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 :: Quantity
    mprate=Quantity
    2} MarketPrice -> MarketPrice -> Assertion
    forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
    @?= MarketPrice
    nullmarketprice{mprate :: Quantity
    mprate=Quantity
    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

      ]