{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DeriveGeneric #-}
module Hledger.Data.Valuation (
ValuationType(..)
,PriceOracle
,journalPriceOracle
,unsupportedValueThenError
,mixedAmountApplyValuation
,mixedAmountValueAtDate
,marketPriceReverse
,priceDirectiveToMarketPrice
,tests_Valuation
)
where
import Control.Applicative ((<|>))
import Data.Foldable (asum)
import Data.Function ((&), on)
import Data.List ( (\\), sortBy )
import Data.List.Extra (nubSortBy)
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Maybe ( fromMaybe )
import qualified Data.Text as T
import Data.Time.Calendar (Day, fromGregorian)
import Data.MemoUgly (memo)
import GHC.Generics (Generic)
import Safe (lastMay)
import Hledger.Utils
import Hledger.Data.Types
import Hledger.Data.Amount
import Hledger.Data.Dates (nulldate)
data ValuationType =
AtCost (Maybe CommoditySymbol)
| AtThen (Maybe CommoditySymbol)
| AtEnd (Maybe CommoditySymbol)
| AtNow (Maybe CommoditySymbol)
| AtDate Day (Maybe CommoditySymbol)
| AtDefault (Maybe CommoditySymbol)
deriving (Int -> ValuationType -> ShowS
[ValuationType] -> ShowS
ValuationType -> String
(Int -> ValuationType -> ShowS)
-> (ValuationType -> String)
-> ([ValuationType] -> ShowS)
-> Show ValuationType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ValuationType] -> ShowS
$cshowList :: [ValuationType] -> ShowS
show :: ValuationType -> String
$cshow :: ValuationType -> String
showsPrec :: Int -> ValuationType -> ShowS
$cshowsPrec :: Int -> ValuationType -> ShowS
Show,ValuationType -> ValuationType -> Bool
(ValuationType -> ValuationType -> Bool)
-> (ValuationType -> ValuationType -> Bool) -> Eq ValuationType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ValuationType -> ValuationType -> Bool
$c/= :: ValuationType -> ValuationType -> Bool
== :: ValuationType -> ValuationType -> Bool
$c== :: ValuationType -> ValuationType -> Bool
Eq)
type PriceOracle = (Day, CommoditySymbol, Maybe CommoditySymbol) -> Maybe (CommoditySymbol, Quantity)
journalPriceOracle :: Bool -> Journal -> PriceOracle
journalPriceOracle :: Bool -> Journal -> PriceOracle
journalPriceOracle Bool
infer Journal{[PriceDirective]
jpricedirectives :: Journal -> [PriceDirective]
jpricedirectives :: [PriceDirective]
jpricedirectives, [MarketPrice]
jinferredmarketprices :: Journal -> [MarketPrice]
jinferredmarketprices :: [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
pdamount :: PriceDirective -> Amount
pdcommodity :: PriceDirective -> CommoditySymbol
pddate :: PriceDirective -> Day
pdamount :: Amount
pdcommodity :: CommoditySymbol
pddate :: Day
..} =
MarketPrice :: Day
-> CommoditySymbol -> CommoditySymbol -> Quantity -> MarketPrice
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
}
mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount
mixedAmountApplyValuation :: PriceOracle
-> Map CommoditySymbol AmountStyle
-> Day
-> Maybe Day
-> Day
-> Bool
-> ValuationType
-> MixedAmount
-> MixedAmount
mixedAmountApplyValuation PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Day
periodlast Maybe Day
mreportlast Day
today Bool
ismultiperiod ValuationType
v (Mixed [Amount]
as) =
[Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount) -> [Amount] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map (PriceOracle
-> Map CommoditySymbol AmountStyle
-> Day
-> Maybe Day
-> Day
-> Bool
-> ValuationType
-> Amount
-> Amount
amountApplyValuation PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Day
periodlast Maybe Day
mreportlast Day
today Bool
ismultiperiod ValuationType
v) [Amount]
as
amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Maybe Day -> Day -> Bool -> ValuationType -> Amount -> Amount
amountApplyValuation :: PriceOracle
-> Map CommoditySymbol AmountStyle
-> Day
-> Maybe Day
-> Day
-> Bool
-> ValuationType
-> Amount
-> Amount
amountApplyValuation PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Day
periodlast Maybe Day
mreportlast Day
today Bool
ismultiperiod ValuationType
v Amount
a =
case ValuationType
v of
AtCost Maybe CommoditySymbol
Nothing -> Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount Map CommoditySymbol AmountStyle
styles (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
amountCost Amount
a
AtCost 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 -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount Map CommoditySymbol AmountStyle
styles (Amount -> Amount) -> Amount -> Amount
forall a b. (a -> b) -> a -> b
$ Amount -> Amount
amountCost Amount
a
AtThen Maybe CommoditySymbol
_mc -> String -> Amount
forall a. String -> a
error' String
unsupportedValueThenError
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
AtDefault Maybe CommoditySymbol
mc | Bool
ismultiperiod -> PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> Amount
-> Amount
amountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mc Day
periodlast Amount
a
AtDefault Maybe CommoditySymbol
mc -> PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> Amount
-> Amount
amountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mc (Day -> Maybe Day -> Day
forall a. a -> Maybe a -> a
fromMaybe Day
today Maybe Day
mreportlast) 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
unsupportedValueThenError :: String
unsupportedValueThenError :: String
unsupportedValueThenError = String
"Sorry, --value=then is not yet supported for this kind of report."
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 (Mixed [Amount]
as) = [Amount] -> MixedAmount
Mixed ([Amount] -> MixedAmount) -> [Amount] -> MixedAmount
forall a b. (a -> b) -> a -> b
$ (Amount -> Amount) -> [Amount] -> [Amount]
forall a b. (a -> b) -> [a] -> [b]
map (PriceOracle
-> Map CommoditySymbol AmountStyle
-> Maybe CommoditySymbol
-> Day
-> Amount
-> Amount
amountValueAtDate PriceOracle
priceoracle Map CommoditySymbol AmountStyle
styles Maybe CommoditySymbol
mc Day
d) [Amount]
as
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) ->
Map CommoditySymbol AmountStyle -> Amount -> Amount
styleAmount Map CommoditySymbol AmountStyle
styles
Amount
amount{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}
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 =
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 -> String -> PriceGraph -> PriceGraph
forall a. Int -> String -> a -> a
traceAt Int
1 (String
"valuation date: "String -> ShowS
forall a. [a] -> [a] -> [a]
++Day -> String
forall a. Show a => a -> String
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 (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe CommoditySymbol
mdefaultto
where
mdefaultto :: Maybe CommoditySymbol
mdefaultto = String -> Maybe CommoditySymbol -> Maybe CommoditySymbol
forall a. Show a => String -> a -> a
dbg1 (String
"default valuation commodity for "String -> ShowS
forall a. [a] -> [a] -> [a]
++CommoditySymbol -> String
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 ->
case
[MarketPrice]
-> CommoditySymbol -> CommoditySymbol -> Maybe [MarketPrice]
pricesShortestPath [MarketPrice]
forwardprices CommoditySymbol
from CommoditySymbol
to Maybe [MarketPrice] -> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
[MarketPrice]
-> CommoditySymbol -> CommoditySymbol -> Maybe [MarketPrice]
pricesShortestPath [MarketPrice]
allprices CommoditySymbol
from CommoditySymbol
to
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. [a] -> a
last [MarketPrice]
ps, [Quantity] -> Quantity
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 :: Day
-> CommoditySymbol -> CommoditySymbol -> Quantity -> MarketPrice
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 String -> Assertion -> TestTree
test String
"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)
type Edge = MarketPrice
type Path = [Edge]
data PriceGraph = PriceGraph {
PriceGraph -> Day
pgDate :: Day
,PriceGraph -> [MarketPrice]
pgEdges :: [Edge]
,PriceGraph -> [MarketPrice]
pgEdgesRev :: [Edge]
,PriceGraph -> Map CommoditySymbol CommoditySymbol
pgDefaultValuationCommodities :: M.Map CommoditySymbol CommoditySymbol
}
deriving (Int -> PriceGraph -> ShowS
[PriceGraph] -> ShowS
PriceGraph -> String
(Int -> PriceGraph -> ShowS)
-> (PriceGraph -> String)
-> ([PriceGraph] -> ShowS)
-> Show PriceGraph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PriceGraph] -> ShowS
$cshowList :: [PriceGraph] -> ShowS
show :: PriceGraph -> String
$cshow :: PriceGraph -> String
showsPrec :: Int -> PriceGraph -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep PriceGraph x -> PriceGraph
$cfrom :: forall x. PriceGraph -> Rep PriceGraph x
Generic)
pricesShortestPath :: [Edge] -> CommoditySymbol -> CommoditySymbol -> Maybe Path
pricesShortestPath :: [MarketPrice]
-> CommoditySymbol -> CommoditySymbol -> Maybe [MarketPrice]
pricesShortestPath [MarketPrice]
edges CommoditySymbol
start CommoditySymbol
end =
String -> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a. Show a => String -> a -> a
dbg1 (String
"shortest price path for "String -> ShowS
forall a. [a] -> [a] -> [a]
++CommoditySymbol -> String
T.unpack CommoditySymbol
startString -> ShowS
forall a. [a] -> [a] -> [a]
++String
" -> "String -> ShowS
forall a. [a] -> [a] -> [a]
++CommoditySymbol -> String
T.unpack CommoditySymbol
end) (Maybe [MarketPrice] -> Maybe [MarketPrice])
-> Maybe [MarketPrice] -> Maybe [MarketPrice]
forall a b. (a -> b) -> a -> b
$
[Maybe [MarketPrice]] -> Maybe [MarketPrice]
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum ([Maybe [MarketPrice]] -> Maybe [MarketPrice])
-> [Maybe [MarketPrice]] -> Maybe [MarketPrice]
forall a b. (a -> b) -> a -> b
$ ([MarketPrice] -> Maybe [MarketPrice])
-> [[MarketPrice]] -> [Maybe [MarketPrice]]
forall a b. (a -> b) -> [a] -> [b]
map (CommoditySymbol
-> [MarketPrice] -> [MarketPrice] -> Maybe [MarketPrice]
findPath CommoditySymbol
end [MarketPrice]
edgesremaining) [[MarketPrice]]
initialpaths
where
initialpaths :: [[MarketPrice]]
initialpaths = String -> [[MarketPrice]] -> [[MarketPrice]]
forall a. Show a => String -> a -> a
dbg9 String
"initial price paths" ([[MarketPrice]] -> [[MarketPrice]])
-> [[MarketPrice]] -> [[MarketPrice]]
forall a b. (a -> b) -> a -> b
$ [[MarketPrice
p] | MarketPrice
p <- [MarketPrice]
edges, MarketPrice -> CommoditySymbol
mpfrom MarketPrice
p CommoditySymbol -> CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CommoditySymbol
start]
edgesremaining :: [MarketPrice]
edgesremaining = String -> [MarketPrice] -> [MarketPrice]
forall a. Show a => String -> a -> a
dbg9 String
"initial edges remaining" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$ [MarketPrice]
edges [MarketPrice] -> [MarketPrice] -> [MarketPrice]
forall a. Eq a => [a] -> [a] -> [a]
\\ [[MarketPrice]] -> [MarketPrice]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[MarketPrice]]
initialpaths
findPath :: CommoditySymbol -> [Edge] -> Path -> Maybe Path
findPath :: CommoditySymbol
-> [MarketPrice] -> [MarketPrice] -> Maybe [MarketPrice]
findPath CommoditySymbol
end [MarketPrice]
_ [MarketPrice]
path | Maybe CommoditySymbol
mpathend Maybe CommoditySymbol -> Maybe CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== CommoditySymbol -> Maybe CommoditySymbol
forall a. a -> Maybe a
Just CommoditySymbol
end = [MarketPrice] -> Maybe [MarketPrice]
forall a. a -> Maybe a
Just [MarketPrice]
path
where
mpathend :: Maybe CommoditySymbol
mpathend = 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]
path
findPath CommoditySymbol
_ [] [MarketPrice]
_ = Maybe [MarketPrice]
forall a. Maybe a
Nothing
findPath CommoditySymbol
end [MarketPrice]
edgesremaining [MarketPrice]
path =
[Maybe [MarketPrice]] -> Maybe [MarketPrice]
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum [
CommoditySymbol
-> [MarketPrice] -> [MarketPrice] -> Maybe [MarketPrice]
findPath CommoditySymbol
end [MarketPrice]
edgesremaining' [MarketPrice]
path'
| MarketPrice
e <- [MarketPrice]
nextedges
, let path' :: [MarketPrice]
path' = [MarketPrice]
path[MarketPrice] -> [MarketPrice] -> [MarketPrice]
forall a. [a] -> [a] -> [a]
++[MarketPrice
e]
, let edgesremaining' :: [MarketPrice]
edgesremaining' = (MarketPrice -> Bool) -> [MarketPrice] -> [MarketPrice]
forall a. (a -> Bool) -> [a] -> [a]
filter (MarketPrice -> MarketPrice -> Bool
forall a. Eq a => a -> a -> Bool
/=MarketPrice
e) [MarketPrice]
edgesremaining
]
where
nextedges :: [MarketPrice]
nextedges = [ MarketPrice
e | MarketPrice
e <- [MarketPrice]
edgesremaining, CommoditySymbol -> Maybe CommoditySymbol
forall a. a -> Maybe a
Just (MarketPrice -> CommoditySymbol
mpfrom MarketPrice
e) Maybe CommoditySymbol -> Maybe CommoditySymbol -> Bool
forall a. Eq a => a -> a -> Bool
== Maybe CommoditySymbol
mpathend ]
where
mpathend :: Maybe CommoditySymbol
mpathend = 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]
path
makePriceGraph :: [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph
makePriceGraph :: [MarketPrice] -> [MarketPrice] -> Day -> PriceGraph
makePriceGraph [MarketPrice]
alldeclaredprices [MarketPrice]
allinferredprices Day
d =
String -> PriceGraph -> PriceGraph
forall a. Show a => String -> a -> a
dbg9 (String
"makePriceGraph "String -> ShowS
forall a. [a] -> [a] -> [a]
++Day -> String
forall a. Show a => a -> String
show Day
d) (PriceGraph -> PriceGraph) -> PriceGraph -> PriceGraph
forall a b. (a -> b) -> a -> b
$
PriceGraph :: Day
-> [MarketPrice]
-> [MarketPrice]
-> Map CommoditySymbol CommoditySymbol
-> PriceGraph
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
visibledeclaredprices :: [MarketPrice]
visibledeclaredprices = String -> [MarketPrice] -> [MarketPrice]
forall a. Show a => String -> a -> a
dbg2 String
"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 = String -> [MarketPrice] -> [MarketPrice]
forall a. Show a => String -> a -> a
dbg2 String
"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
reverseprices :: [MarketPrice]
reverseprices = String -> [MarketPrice] -> [MarketPrice]
forall a. Show a => String -> a -> a
dbg2 String
"additional reverse prices" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$
[MarketPrice
p | p :: MarketPrice
p@MarketPrice{Quantity
CommoditySymbol
Day
mprate :: Quantity
mpto :: CommoditySymbol
mpfrom :: CommoditySymbol
mpdate :: Day
mprate :: MarketPrice -> Quantity
mpto :: MarketPrice -> CommoditySymbol
mpfrom :: MarketPrice -> CommoditySymbol
mpdate :: MarketPrice -> Day
..} <- (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
mprate :: Quantity
mpdate :: Day
mpto :: CommoditySymbol
mpfrom :: CommoditySymbol
mprate :: MarketPrice -> Quantity
mpto :: MarketPrice -> CommoditySymbol
mpfrom :: MarketPrice -> CommoditySymbol
mpdate :: MarketPrice -> Day
..} <- [MarketPrice]
forwardprices]
allprices :: [MarketPrice]
allprices = [MarketPrice]
forwardprices [MarketPrice] -> [MarketPrice] -> [MarketPrice]
forall a. [a] -> [a] -> [a]
++ [MarketPrice]
reverseprices
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
mprate :: Quantity
mpdate :: Day
mpto :: CommoditySymbol
mpfrom :: CommoditySymbol
mprate :: MarketPrice -> Quantity
mpto :: MarketPrice -> CommoditySymbol
mpfrom :: MarketPrice -> CommoditySymbol
mpdate :: MarketPrice -> Day
..} <- [MarketPrice]
pricesfordefaultcomms]
where
pricesfordefaultcomms :: [MarketPrice]
pricesfordefaultcomms = String -> [MarketPrice] -> [MarketPrice]
forall a. Show a => String -> a -> a
dbg2 String
"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..]
[(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
mprate :: Quantity
mpto :: CommoditySymbol
mpfrom :: CommoditySymbol
mpdate :: Day
mprate :: MarketPrice -> Quantity
mpto :: MarketPrice -> CommoditySymbol
mpfrom :: MarketPrice -> CommoditySymbol
mpdate :: MarketPrice -> Day
..})->(Day
mpdate,Integer
parseorder)))
[(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
where
ps :: [MarketPrice]
ps | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [MarketPrice] -> 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 (t :: * -> *) a. Foldable t => t a -> Bool
null [MarketPrice]
alldeclaredprices = [MarketPrice]
alldeclaredprices
| Bool
otherwise = [MarketPrice]
visibleinferredprices
effectiveMarketPrices :: [MarketPrice] -> [MarketPrice] -> [MarketPrice]
effectiveMarketPrices :: [MarketPrice] -> [MarketPrice] -> [MarketPrice]
effectiveMarketPrices [MarketPrice]
declaredprices [MarketPrice]
inferredprices =
let
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
String -> [MarketPrice] -> [MarketPrice]
forall a. Show a => String -> a -> a
dbg2 String
"effective forward prices" ([MarketPrice] -> [MarketPrice]) -> [MarketPrice] -> [MarketPrice]
forall a b. (a -> b) -> a -> b
$
[(Integer, Integer, MarketPrice)]
declaredprices' [(Integer, Integer, MarketPrice)]
-> [(Integer, Integer, MarketPrice)]
-> [(Integer, Integer, MarketPrice)]
forall a. [a] -> [a] -> [a]
++ [(Integer, Integer, MarketPrice)]
inferredprices'
[(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)))
[(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
[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
mprate :: Quantity
mpto :: CommoditySymbol
mpfrom :: CommoditySymbol
mpdate :: Day
mprate :: MarketPrice -> Quantity
mpto :: MarketPrice -> CommoditySymbol
mpfrom :: MarketPrice -> CommoditySymbol
mpdate :: MarketPrice -> Day
..})->(CommoditySymbol
mpfrom,CommoditySymbol
mpto)))
marketPriceReverse :: MarketPrice -> MarketPrice
marketPriceReverse :: MarketPrice -> MarketPrice
marketPriceReverse mp :: MarketPrice
mp@MarketPrice{Quantity
CommoditySymbol
Day
mprate :: Quantity
mpto :: CommoditySymbol
mpfrom :: CommoditySymbol
mpdate :: Day
mprate :: MarketPrice -> Quantity
mpto :: MarketPrice -> CommoditySymbol
mpfrom :: MarketPrice -> CommoditySymbol
mpdate :: MarketPrice -> Day
..} =
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}
nullmarketprice :: MarketPrice
nullmarketprice :: MarketPrice
nullmarketprice = MarketPrice :: Day
-> CommoditySymbol -> CommoditySymbol -> Quantity -> MarketPrice
MarketPrice {
mpdate :: Day
mpdate=Day
nulldate
,mpfrom :: CommoditySymbol
mpfrom=CommoditySymbol
""
,mpto :: CommoditySymbol
mpto=CommoditySymbol
""
,mprate :: Quantity
mprate=Quantity
0
}
tests_Valuation :: TestTree
tests_Valuation = String -> [TestTree] -> TestTree
tests String
"Valuation" [
TestTree
tests_priceLookup
,String -> Assertion -> TestTree
test String
"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
]