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

;lib: Prices: refactor

Browse Source
This commit is contained in:
Simon Michael 2019-06-14 15:20:21 -07:00
parent 7dd0c5783a
commit 83030a09de
1 changed files with 47 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

91
hledger-lib/Hledger/Data/Prices.hs
View File

@ -89,6 +89,53 @@ amountValueAtDate pricedirectives styles mto d a =
Nothing -> a Nothing -> a
Just (comm, rate) -> styleAmount styles $ amount{acommodity=comm, aquantity=rate * aquantity a} Just (comm, rate) -> 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 -- Market price lookup
@ -185,50 +232,6 @@ priceLookup pricedirectives d from mto =
-- log a message and a Maybe Quantity, hiding Just/Nothing and limiting decimal places -- log a message and a Maybe Quantity, hiding Just/Nothing and limiting decimal places
dbg msg = dbg4With (((msg++": ")++) . maybe "" (show . roundTo 8)) dbg msg = dbg4With (((msg++": ")++) . maybe "" (show . roundTo 8))
-- | 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}
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- fgl helpers -- fgl helpers