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

;valuation: refactor

Browse Source
This commit is contained in:
Simon Michael 2020-06-14 15:48:16 -07:00
parent a384041f7c
commit 6e36ede9aa
3 changed files with 18 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
hledger-lib/Hledger/Data/Journal.hs
View File

@ -186,7 +186,7 @@ instance Semigroup Journal where
,jcommodities = jcommodities j1 <> jcommodities j2
,jinferredcommodities = jinferredcommodities j1 <> jinferredcommodities j2
,jpricedirectives = jpricedirectives j1 <> jpricedirectives j2
,jtransactionimpliedmarketprices = jtransactionimpliedmarketprices j1 <> jtransactionimpliedmarketprices j2
,jimpliedmarketprices = jimpliedmarketprices j1 <> jimpliedmarketprices j2
,jtxnmodifiers = jtxnmodifiers j1 <> jtxnmodifiers j2
,jperiodictxns = jperiodictxns j1 <> jperiodictxns j2
,jtxns = jtxns j1 <> jtxns j2
@ -212,7 +212,7 @@ nulljournal = Journal {
,jcommodities = M.empty
,jinferredcommodities = M.empty
,jpricedirectives = []
,jtransactionimpliedmarketprices = []
,jimpliedmarketprices = []
,jtxnmodifiers = []
,jperiodictxns = []
,jtxns = []
@ -1044,8 +1044,8 @@ canonicalStyleFrom ss@(s:_) =
-- been balanced and posting amounts have appropriate prices attached.
journalInferMarketPricesFromTransactions :: Journal -> Journal
journalInferMarketPricesFromTransactions j =
j{jtransactionimpliedmarketprices =
dbg4 "jtransactionimpliedmarketprices" $
j{jimpliedmarketprices =
dbg4 "jimpliedmarketprices" $
mapMaybe postingImpliedMarketPrice $ journalPostings j
}

2
hledger-lib/Hledger/Data/Types.hs
View File

@ -472,7 +472,7 @@ data Journal = Journal {
,jcommodities :: M.Map CommoditySymbol Commodity -- ^ commodities and formats declared by commodity directives
,jinferredcommodities :: M.Map CommoditySymbol AmountStyle -- ^ commodities and formats inferred from journal amounts TODO misnamed - jusedstyles
,jpricedirectives :: [PriceDirective] -- ^ Declarations of market prices by P directives, in parse order (after journal finalisation)
,jtransactionimpliedmarketprices :: [MarketPrice] -- ^ Market prices implied by transactions, in parse order (after journal finalisation)
,jimpliedmarketprices :: [MarketPrice] -- ^ Market prices implied by transactions, in parse order (after journal finalisation)
,jtxnmodifiers :: [TransactionModifier]
,jperiodictxns :: [PeriodicTransaction]
,jtxns :: [Transaction]

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

@ -195,12 +195,12 @@ amountValueAtDate priceoracle styles mto d a =
-- you should generate this only once per journal, reusing it across
-- reports if there are more than one (as in compoundBalanceCommand).
journalPriceOracle :: Journal -> PriceOracle
journalPriceOracle Journal{jpricedirectives, jtransactionimpliedmarketprices} =
journalPriceOracle Journal{jpricedirectives, jimpliedmarketprices} =
-- traceStack "journalPriceOracle" $
let
pricesatdate =
memo $
pricesAtDate jpricedirectives jtransactionimpliedmarketprices
pricesAtDate jpricedirectives jimpliedmarketprices
in
memo $
uncurry3 $
@ -310,13 +310,13 @@ tests_priceLookup =
-- graph of the effective exchange rates between commodity pairs on
-- the given day.
pricesAtDate :: [PriceDirective] -> [MarketPrice] -> Day -> PriceGraph
pricesAtDate pricedirectives transactionimpliedmarketprices d =
pricesAtDate pricedirectives impliedmarketprices d =
-- trace ("pricesAtDate ("++show d++")") $
PriceGraph{prGraph=g, prNodemap=m, prDefaultValuationCommodities=defaultdests}
where
-- prices in effect on date d, either declared or implied
declaredandimpliedprices = dbg5 "declaredandimpliedprices" $
latestPriceForEachPairOn pricedirectives transactionimpliedmarketprices d
latestPriceForEachPairOn pricedirectives impliedmarketprices d
-- infer any additional reverse prices not already declared or implied
reverseprices =
@ -345,18 +345,18 @@ pricesAtDate pricedirectives transactionimpliedmarketprices d =
-- latest declared or transaction-implied price dated on or before
-- that day, with declared prices taking precedence.
latestPriceForEachPairOn :: [PriceDirective] -> [MarketPrice] -> Day -> [MarketPrice]
latestPriceForEachPairOn pricedirectives transactionimpliedmarketprices d =
latestPriceForEachPairOn pricedirectives impliedmarketprices d =
dbg5 "latestPriceForEachPairOn" $
let
-- consider only declarations/transactions before the valuation date
declaredprices = map priceDirectiveToMarketPrice $ filter ((<=d).pddate) pricedirectives
transactionimpliedmarketprices' = filter ((<=d).mpdate) transactionimpliedmarketprices
impliedmarketprices' = filter ((<=d).mpdate) impliedmarketprices
-- label the items with their precedence and then their parse order
declaredprices' = [(1, i, p) | (i,p) <- zip [1..] declaredprices]
transactionimpliedmarketprices'' = [(0, i, p) | (i,p) <- zip [1..] transactionimpliedmarketprices']
impliedmarketprices'' = [(0, i, p) | (i,p) <- zip [1..] impliedmarketprices']
in
-- combine
declaredprices' ++ transactionimpliedmarketprices''
declaredprices' ++ impliedmarketprices''
-- sort by newest date then highest precedence then latest parse order
& sortBy (flip compare `on` (\(precedence,parseorder,mp)->(mpdate mp,precedence,parseorder)))
-- discard the sorting labels