slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

;lib: pricesAtDate: refactor

Browse Source
This commit is contained in:
Simon Michael 2019-08-01 18:27:32 +02:00
parent c14f22b975
commit 7177f533b2
1 changed files with 54 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
hledger-lib/Hledger/Data/Valuation.hs
View File

@ -99,53 +99,6 @@ amountValueAtDate pricedirectives styles mto d a =
styleAmount styles
amount{acommodity=comm, aquantity=rate * aquantity a}
------------------------------------------------------------------------------
-- Building a price graph
-- | Convert a list of market price directives in parse order to a
-- graph of all prices in effect on a given day, allowing efficient
-- lookup of exchange rates between commodity pairs.
pricesAtDate :: [PriceDirective] -> Day -> PriceGraph
pricesAtDate pricedirectives d = PriceGraph{prGraph=g, prNodemap=m, prDeclaredPairs=dps}
where
-- build the graph and associated node map
(g :: Gr CommoditySymbol Quantity, m :: NodeMap CommoditySymbol) =
mkMapGraph
(dbg5 "g nodelabels" $ sort allcomms) -- this must include all nodes mentioned in edges
(dbg5 "g edges" $ [(mpfrom, mpto, mprate) | MarketPrice{..} <- prices])
where
prices = declaredprices ++ reverseprices
allcomms = map mpfrom prices
-- get the latest (on or before date d) declared price for each commodity pair
declaredprices :: [MarketPrice] =
dbg5 "declaredprices" $
nubSortBy (compare `on` (\(MarketPrice{..})->(mpfrom,mpto))) $ -- keep only the first (ie newest and latest parsed) price for each pair
map snd $ -- discard the parse order label
sortBy (flip compare `on` (\(parseorder,mp)->(mpdate mp,parseorder))) $ -- sort with newest dates and latest parse order first
zip [1..] $ -- label with parse order
map priceDirectiveToMarketPrice $
filter ((<=d).pddate) pricedirectives -- consider only price declarations up to the valuation date
-- infer additional reverse prices where not already declared
reverseprices =
dbg5 "reverseprices" $
map marketPriceReverse declaredprices \\ declaredprices
-- remember which edges correspond to declared prices
dps = [(node m mpfrom, node m mpto) | MarketPrice{..} <- declaredprices ]
priceDirectiveToMarketPrice :: PriceDirective -> MarketPrice
priceDirectiveToMarketPrice PriceDirective{..} =
MarketPrice{ mpdate = pddate
, mpfrom = pdcommodity
, mpto = acommodity pdamount
, mprate = aquantity pdamount
}
marketPriceReverse :: MarketPrice -> MarketPrice
marketPriceReverse mp@MarketPrice{..} = mp{mpfrom=mpto, mpto=mpfrom, mprate=1/mprate}
------------------------------------------------------------------------------
-- Market price lookup
@ -242,6 +195,60 @@ priceLookup pricedirectives d from mto =
-- log a message and a Maybe Quantity, hiding Just/Nothing and limiting decimal places
dbg msg = dbg4With (((msg++": ")++) . maybe "" (show . roundTo 8))
------------------------------------------------------------------------------
-- Building the price graph (network of commodity conversions) on a given day.
-- | Convert a list of market price directives in parse order to a
-- graph of all prices in effect on a given day, allowing efficient
-- lookup of exchange rates between commodity pairs.
pricesAtDate :: [PriceDirective] -> Day -> PriceGraph
pricesAtDate pricedirectives d = PriceGraph{prGraph=g, prNodemap=m, prDeclaredPairs=dps}
where
declaredprices = latestPriceForEachPairOn pricedirectives d
-- infer additional reverse prices where not already declared
reverseprices =
dbg5 "reverseprices" $
map marketPriceReverse declaredprices \\ declaredprices
-- build the graph and associated node map
-- (g :: Gr CommoditySymbol Quantity, m :: NodeMap CommoditySymbol) =
(g, m) =
mkMapGraph
(dbg5 "g nodelabels" $ sort allcomms) -- this must include all nodes mentioned in edges
(dbg5 "g edges" $ [(mpfrom, mpto, mprate) | MarketPrice{..} <- prices])
:: (Gr CommoditySymbol Quantity, NodeMap CommoditySymbol)
where
prices = declaredprices ++ reverseprices
allcomms = map mpfrom prices
-- remember which edges correspond to declared prices
dps = [(node m mpfrom, node m mpto) | MarketPrice{..} <- declaredprices ]
-- From a list of price directives in parse order, get the latest
-- price declared on or before date d for each commodity pair.
latestPriceForEachPairOn :: [PriceDirective] -> Day -> [MarketPrice]
latestPriceForEachPairOn pricedirectives d =
dbg5 "latestPriceForEachPairOn" $
nubSortBy (compare `on` (\(MarketPrice{..})->(mpfrom,mpto))) $ -- keep only the first (ie newest and latest parsed) price for each pair
map snd $ -- discard the parse order label
sortBy (flip compare `on` (\(parseorder,mp)->(mpdate mp,parseorder))) $ -- sort with newest dates and latest parse order first
zip [1..] $ -- label with parse order
map priceDirectiveToMarketPrice $
filter ((<=d).pddate) pricedirectives -- consider only price declarations up to the valuation date
priceDirectiveToMarketPrice :: PriceDirective -> MarketPrice
priceDirectiveToMarketPrice PriceDirective{..} =
MarketPrice{ mpdate = pddate
, mpfrom = pdcommodity
, mpto = acommodity pdamount
, mprate = aquantity pdamount
}
marketPriceReverse :: MarketPrice -> MarketPrice
marketPriceReverse mp@MarketPrice{..} = mp{mpfrom=mpto, mpto=mpfrom, mprate=1/mprate}
------------------------------------------------------------------------------
-- fgl helpers