mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-26 03:42:25 +03:00
memoise market valuation, making it fast (#999)
This commit is contained in:
Simon Michael
parent
4beb416070
commit
1cbbe8f43d
@ -319,6 +319,7 @@ accountNameApplyAliases aliases a = accountNameWithPostingType atype aname'
|
||||
-- | Memoising version of accountNameApplyAliases, maybe overkill.
|
||||
accountNameApplyAliasesMemo :: [AccountAlias] -> AccountName -> AccountName
|
||||
accountNameApplyAliasesMemo aliases = memo (accountNameApplyAliases aliases)
|
||||
-- XXX re-test this memoisation
|
||||
|
||||
-- aliasMatches :: AccountAlias -> AccountName -> Bool
|
||||
-- aliasMatches (BasicAlias old _) a = old `isAccountNamePrefixOf` a
|
||||
@ -331,18 +332,18 @@ aliasReplace (BasicAlias old new) a
|
||||
aliasReplace (RegexAlias re repl) a = T.pack $ regexReplaceCIMemo re repl $ T.unpack a -- XXX
|
||||
|
||||
-- Apply a specified valuation to this posting's amount, using the provided
|
||||
-- prices db, commodity styles, period-end/current dates, and whether
|
||||
-- price oracle, commodity styles, period-end/current dates, and whether
|
||||
-- this is for a multiperiod report or not.
|
||||
postingApplyValuation :: [PriceDirective] -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> Posting -> ValuationType -> Posting
|
||||
postingApplyValuation prices styles periodend today ismultiperiod p v =
|
||||
postingApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> Posting -> ValuationType -> Posting
|
||||
postingApplyValuation priceoracle styles periodend today ismultiperiod p v =
|
||||
case v of
|
||||
AtCost Nothing -> postingToCost styles p
|
||||
AtCost mc -> postingValueAtDate prices styles mc periodend $ postingToCost styles p
|
||||
AtEnd mc -> postingValueAtDate prices styles mc periodend p
|
||||
AtNow mc -> postingValueAtDate prices styles mc today p
|
||||
AtDefault mc | ismultiperiod -> postingValueAtDate prices styles mc periodend p
|
||||
AtDefault mc -> postingValueAtDate prices styles mc today p
|
||||
AtDate d mc -> postingValueAtDate prices styles mc d p
|
||||
AtCost mc -> postingValueAtDate priceoracle styles mc periodend $ postingToCost styles p
|
||||
AtEnd mc -> postingValueAtDate priceoracle styles mc periodend p
|
||||
AtNow mc -> postingValueAtDate priceoracle styles mc today p
|
||||
AtDefault mc | ismultiperiod -> postingValueAtDate priceoracle styles mc periodend p
|
||||
AtDefault mc -> postingValueAtDate priceoracle styles mc today p
|
||||
AtDate d mc -> postingValueAtDate priceoracle styles mc d p
|
||||
|
||||
-- | Convert this posting's amount to cost, and apply the appropriate amount styles.
|
||||
postingToCost :: M.Map CommoditySymbol AmountStyle -> Posting -> Posting
|
||||
@ -350,11 +351,11 @@ postingToCost styles p@Posting{pamount=a} = p{pamount=mixedAmountToCost styles a
|
||||
|
||||
-- | Convert this posting's amount to market value in the given commodity,
|
||||
-- or the default valuation commodity, at the given valuation date,
|
||||
-- using the given market prices.
|
||||
-- using the given market price oracle.
|
||||
-- When market prices available on that date are not sufficient to
|
||||
-- calculate the value, amounts are left unchanged.
|
||||
postingValueAtDate :: [PriceDirective] -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Posting -> Posting
|
||||
postingValueAtDate prices styles mc d p = postingTransformAmount (mixedAmountValueAtDate prices styles mc d) p
|
||||
postingValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Posting -> Posting
|
||||
postingValueAtDate priceoracle styles mc d p = postingTransformAmount (mixedAmountValueAtDate priceoracle styles mc d) p
|
||||
|
||||
-- | Apply a transform function to this posting's amount.
|
||||
postingTransformAmount :: (MixedAmount -> MixedAmount) -> Posting -> Posting
|
||||
|
||||
@ -468,6 +468,11 @@ data PriceGraph = PriceGraph {
|
||||
|
||||
instance NFData PriceGraph
|
||||
|
||||
-- | A price oracle is a magic function that looks up market prices
|
||||
-- (exchange rates) from one commodity to another (or if unspecified,
|
||||
-- to a default valuation commodity) on a given date, somewhat efficiently.
|
||||
type PriceOracle = (Day, CommoditySymbol, Maybe CommoditySymbol) -> Maybe (CommoditySymbol, Quantity)
|
||||
|
||||
-- | What kind of value conversion should be done on amounts ?
|
||||
-- UI: --value=cost|end|now|DATE[,COMM]
|
||||
data ValuationType =
|
||||
|
||||
@ -11,8 +11,9 @@ looking up historical market prices (exchange rates) between commodities.
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
module Hledger.Data.Valuation (
|
||||
amountValueAtDate
|
||||
,amountApplyValuation
|
||||
journalPriceOracle
|
||||
-- ,amountValueAtDate
|
||||
-- ,amountApplyValuation
|
||||
,mixedAmountValueAtDate
|
||||
,mixedAmountApplyValuation
|
||||
,marketPriceReverse
|
||||
@ -32,6 +33,7 @@ import qualified Data.Map as M
|
||||
import Data.Maybe
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Calendar (Day)
|
||||
import Data.MemoUgly (memo)
|
||||
import Safe (headMay)
|
||||
|
||||
import Hledger.Utils
|
||||
@ -44,37 +46,39 @@ tests_Valuation = tests "Valuation" [
|
||||
tests_priceLookup
|
||||
]
|
||||
|
||||
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Valuation
|
||||
|
||||
-- Apply a specified valuation to this mixed amount, using the provided
|
||||
-- prices db, commodity styles, period-end/current dates,
|
||||
-- | Apply a specified valuation to this mixed amount, using the provided
|
||||
-- price oracle, commodity styles, period-end/current dates,
|
||||
-- and whether this is for a multiperiod report or not.
|
||||
mixedAmountApplyValuation :: [PriceDirective] -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount
|
||||
mixedAmountApplyValuation prices styles periodend today ismultiperiod v (Mixed as) =
|
||||
Mixed $ map (amountApplyValuation prices styles periodend today ismultiperiod v) as
|
||||
mixedAmountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> MixedAmount -> MixedAmount
|
||||
mixedAmountApplyValuation priceoracle styles periodend today ismultiperiod v (Mixed as) =
|
||||
Mixed $ map (amountApplyValuation priceoracle styles periodend today ismultiperiod v) as
|
||||
|
||||
-- | Apply a specified valuation to this amount, using the provided
|
||||
-- price oracle, commodity styles, period-end/current dates,
|
||||
-- and whether this is for a multiperiod report or not.
|
||||
amountApplyValuation :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> Amount -> Amount
|
||||
amountApplyValuation priceoracle styles periodend today ismultiperiod v a =
|
||||
case v of
|
||||
AtCost Nothing -> amountToCost styles a
|
||||
AtCost mc -> amountValueAtDate priceoracle styles mc periodend $ amountToCost styles a
|
||||
AtEnd mc -> amountValueAtDate priceoracle styles mc periodend a
|
||||
AtNow mc -> amountValueAtDate priceoracle styles mc today a
|
||||
AtDefault mc | ismultiperiod -> amountValueAtDate priceoracle styles mc periodend a
|
||||
AtDefault mc -> amountValueAtDate priceoracle styles mc today a
|
||||
AtDate d mc -> amountValueAtDate priceoracle styles mc d 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 prices.
|
||||
-- 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 :: [PriceDirective] -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount
|
||||
mixedAmountValueAtDate prices styles mc d (Mixed as) = Mixed $ map (amountValueAtDate prices styles mc d) as
|
||||
|
||||
-- | Apply a specified valuation to this amount, using the provided
|
||||
-- prices db, commodity styles, period-end/current dates,
|
||||
-- and whether this is for a multiperiod report or not.
|
||||
amountApplyValuation :: [PriceDirective] -> M.Map CommoditySymbol AmountStyle -> Day -> Day -> Bool -> ValuationType -> Amount -> Amount
|
||||
amountApplyValuation prices styles periodend today ismultiperiod v a =
|
||||
case v of
|
||||
AtCost Nothing -> amountToCost styles a
|
||||
AtCost mc -> amountValueAtDate prices styles mc periodend $ amountToCost styles a
|
||||
AtEnd mc -> amountValueAtDate prices styles mc periodend a
|
||||
AtNow mc -> amountValueAtDate prices styles mc today a
|
||||
AtDefault mc | ismultiperiod -> amountValueAtDate prices styles mc periodend a
|
||||
AtDefault mc -> amountValueAtDate prices styles mc today a
|
||||
AtDate d mc -> amountValueAtDate prices styles mc d a
|
||||
mixedAmountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> MixedAmount -> MixedAmount
|
||||
mixedAmountValueAtDate priceoracle styles mc d (Mixed as) = Mixed $ map (amountValueAtDate priceoracle styles mc d) as
|
||||
|
||||
-- | Find the market value of this amount in the given valuation
|
||||
-- commodity if any, otherwise the default valuation commodity, at the
|
||||
@ -88,9 +92,9 @@ amountApplyValuation prices styles periodend today ismultiperiod v a =
|
||||
--
|
||||
-- If the market prices available on that date are not sufficient to
|
||||
-- calculate this value, the amount is left unchanged.
|
||||
amountValueAtDate :: [PriceDirective] -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Amount -> Amount
|
||||
amountValueAtDate pricedirectives styles mto d a =
|
||||
case priceLookup pricedirectives d (acommodity a) mto of
|
||||
amountValueAtDate :: PriceOracle -> M.Map CommoditySymbol AmountStyle -> Maybe CommoditySymbol -> Day -> Amount -> Amount
|
||||
amountValueAtDate priceoracle styles mto d a =
|
||||
case priceoracle (d, acommodity a, mto) of
|
||||
Nothing -> a
|
||||
Just (comm, rate) ->
|
||||
-- setNaturalPrecisionUpTo 8 $ -- XXX force higher precision in case amount appears to be zero ?
|
||||
@ -102,24 +106,21 @@ amountValueAtDate pricedirectives styles mto d a =
|
||||
------------------------------------------------------------------------------
|
||||
-- Market price lookup
|
||||
|
||||
tests_priceLookup =
|
||||
-- From a journal's market price directives, generate a memoising function
|
||||
-- that efficiently looks up exchange rates between commodities on any date.
|
||||
-- For best results, 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} =
|
||||
-- traceStack "journalPriceOracle" $
|
||||
let
|
||||
d = parsedate
|
||||
a q c = amount{acommodity=c, aquantity=q}
|
||||
p date from q to = PriceDirective{pddate=d date, pdcommodity=from, pdamount=a q to}
|
||||
ps1 = [
|
||||
p "2000/01/01" "A" 10 "B"
|
||||
,p "2000/01/01" "B" 10 "C"
|
||||
,p "2000/01/01" "C" 10 "D"
|
||||
,p "2000/01/01" "E" 2 "D"
|
||||
,p "2001/01/01" "A" 11 "B"
|
||||
]
|
||||
in tests "priceLookup" [
|
||||
priceLookup ps1 (d "1999/01/01") "A" Nothing `is` Nothing
|
||||
,priceLookup ps1 (d "2000/01/01") "A" Nothing `is` Just ("B",10)
|
||||
,priceLookup ps1 (d "2000/01/01") "B" (Just "A") `is` Just ("A",0.1)
|
||||
,priceLookup ps1 (d "2000/01/01") "A" (Just "E") `is` Just ("E",500)
|
||||
]
|
||||
pricesatdate =
|
||||
memo $
|
||||
pricesAtDate jpricedirectives
|
||||
in
|
||||
memo $
|
||||
uncurry3 $
|
||||
priceLookup pricesatdate
|
||||
|
||||
-- | Given a list of price directives in parse order, find the market
|
||||
-- value at the given date of one unit of a given source commodity, in
|
||||
@ -152,16 +153,13 @@ tests_priceLookup =
|
||||
-- prices can be found, or the source commodity and the valuation
|
||||
-- commodity are the same, returns Nothing.
|
||||
--
|
||||
-- A 'PriceGraph' is built each time this is called, which is probably
|
||||
-- wasteful when looking up multiple prices on the same day; it could
|
||||
-- be built at a higher level, or memoised.
|
||||
--
|
||||
priceLookup :: [PriceDirective] -> Day -> CommoditySymbol -> Maybe CommoditySymbol -> Maybe (CommoditySymbol, Quantity)
|
||||
priceLookup pricedirectives d from mto =
|
||||
priceLookup :: (Day -> PriceGraph) -> Day -> CommoditySymbol -> Maybe CommoditySymbol -> Maybe (CommoditySymbol, Quantity)
|
||||
priceLookup pricesatdate d from mto =
|
||||
-- trace ("priceLookup ("++show d++", "++show from++", "++show mto++")") $
|
||||
let
|
||||
-- build a graph of the commodity exchange rates in effect on this day
|
||||
-- XXX should hide these fgl details better
|
||||
PriceGraph{prGraph=g, prNodemap=m, prDeclaredPairs=dps} = pricesAtDate pricedirectives d
|
||||
PriceGraph{prGraph=g, prNodemap=m, prDeclaredPairs=dps} = pricesatdate d
|
||||
fromnode = node m from
|
||||
mto' = mto <|> mdefaultto
|
||||
where
|
||||
@ -195,6 +193,26 @@ 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))
|
||||
|
||||
tests_priceLookup =
|
||||
let
|
||||
d = parsedate
|
||||
a q c = amount{acommodity=c, aquantity=q}
|
||||
p date from q to = PriceDirective{pddate=d date, pdcommodity=from, pdamount=a q to}
|
||||
ps1 = [
|
||||
p "2000/01/01" "A" 10 "B"
|
||||
,p "2000/01/01" "B" 10 "C"
|
||||
,p "2000/01/01" "C" 10 "D"
|
||||
,p "2000/01/01" "E" 2 "D"
|
||||
,p "2001/01/01" "A" 11 "B"
|
||||
]
|
||||
pricesatdate = pricesAtDate ps1
|
||||
in tests "priceLookup" [
|
||||
priceLookup pricesatdate (d "1999/01/01") "A" Nothing `is` Nothing
|
||||
,priceLookup pricesatdate (d "2000/01/01") "A" Nothing `is` Just ("B",10)
|
||||
,priceLookup pricesatdate (d "2000/01/01") "B" (Just "A") `is` Just ("A",0.1)
|
||||
,priceLookup pricesatdate (d "2000/01/01") "A" (Just "E") `is` Just ("E",500)
|
||||
]
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Building the price graph (network of commodity conversions) on a given day.
|
||||
|
||||
@ -202,7 +220,9 @@ priceLookup pricedirectives d from mto =
|
||||
-- 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}
|
||||
pricesAtDate pricedirectives d =
|
||||
-- trace ("pricesAtDate ("++show d++")") $
|
||||
PriceGraph{prGraph=g, prNodemap=m, prDeclaredPairs=dps}
|
||||
where
|
||||
declaredprices = latestPriceForEachPairOn pricedirectives d
|
||||
|
||||
@ -212,7 +232,6 @@ pricesAtDate pricedirectives d = PriceGraph{prGraph=g, prNodemap=m, prDeclaredPa
|
||||
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
|
||||
@ -237,7 +256,6 @@ latestPriceForEachPairOn pricedirectives d =
|
||||
map priceDirectiveToMarketPrice $
|
||||
filter ((<=d).pddate) pricedirectives -- consider only price declarations up to the valuation date
|
||||
|
||||
|
||||
priceDirectiveToMarketPrice :: PriceDirective -> MarketPrice
|
||||
priceDirectiveToMarketPrice PriceDirective{..} =
|
||||
MarketPrice{ mpdate = pddate
|
||||
|
||||
@ -552,7 +552,7 @@ modifiedaccountnamep = do
|
||||
a <- lift accountnamep
|
||||
return $!
|
||||
accountNameApplyAliases aliases $
|
||||
-- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference
|
||||
-- XXX accountNameApplyAliasesMemo ? doesn't seem to make a difference (retest that function)
|
||||
joinAccountNames parent
|
||||
a
|
||||
|
||||
|
||||
@ -80,11 +80,12 @@ balanceReport ropts@ReportOpts{..} q j@Journal{..} =
|
||||
accttree = ledgerRootAccount $ ledgerFromJournal q $ journalSelectingAmountFromOpts ropts j
|
||||
|
||||
-- For other kinds of valuation, convert the summed amounts to value.
|
||||
priceoracle = journalPriceOracle j
|
||||
valuedaccttree = mapAccounts valueaccount accttree
|
||||
where
|
||||
valueaccount a@Account{..} = a{aebalance=val aebalance, aibalance=val aibalance}
|
||||
where
|
||||
val = maybe id (mixedAmountApplyValuation jpricedirectives styles periodlastday today multiperiod) value_
|
||||
val = maybe id (mixedAmountApplyValuation priceoracle styles periodlastday today multiperiod) value_
|
||||
where
|
||||
periodlastday =
|
||||
fromMaybe (error' "balanceReport: expected a non-empty journal") $ -- XXX shouldn't happen
|
||||
|
||||
@ -40,7 +40,8 @@ entriesReport ropts@ReportOpts{..} q j@Journal{..} =
|
||||
datefn = transactionDateFn ropts
|
||||
styles = journalCommodityStyles j
|
||||
tvalue t@Transaction{..} = t{tpostings=map pvalue tpostings}
|
||||
pvalue p = maybe p (postingApplyValuation jpricedirectives styles end today False p) value_
|
||||
priceoracle = journalPriceOracle j
|
||||
pvalue p = maybe p (postingApplyValuation priceoracle styles end today False p) value_
|
||||
where
|
||||
today = fromMaybe (error' "erValue: ReportOpts today_ is unset so could not satisfy --value=now") today_
|
||||
end = fromMaybe (postingDate p) mperiodorjournallastday
|
||||
|
||||
@ -9,6 +9,7 @@ module Hledger.Reports.MultiBalanceReport (
|
||||
MultiBalanceReport(..),
|
||||
MultiBalanceReportRow,
|
||||
multiBalanceReport,
|
||||
multiBalanceReportWith,
|
||||
balanceReportFromMultiBalanceReport,
|
||||
mbrNegate,
|
||||
mbrNormaliseSign,
|
||||
@ -94,9 +95,16 @@ type ClippedAccountName = AccountName
|
||||
-- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts
|
||||
-- (see ReportOpts and CompoundBalanceCommand).
|
||||
-- hledger's most powerful and useful report, used by the balance
|
||||
-- command (in multiperiod mode) and by the bs/cf/is commands.
|
||||
-- command (in multiperiod mode) and (via multiBalanceReport') by the bs/cf/is commands.
|
||||
multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport
|
||||
multiBalanceReport ropts@ReportOpts{..} q j@Journal{..} =
|
||||
multiBalanceReport ropts q j = multiBalanceReportWith ropts q j (journalPriceOracle j)
|
||||
|
||||
-- | A helper for multiBalanceReport. This one takes an extra argument, a
|
||||
-- PriceOracle to be used for looking up market prices. Commands which
|
||||
-- run multiple reports (bs etc.) can generate the price oracle just once
|
||||
-- for efficiency, passing it to each report by calling this function directly.
|
||||
multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> MultiBalanceReport
|
||||
multiBalanceReportWith ropts@ReportOpts{..} q j@Journal{..} priceoracle =
|
||||
(if invert_ then mbrNegate else id) $
|
||||
MultiBalanceReport (colspans, sortedrows, totalsrow)
|
||||
where
|
||||
@ -252,7 +260,7 @@ multiBalanceReport ropts@ReportOpts{..} q j@Journal{..} =
|
||||
CumulativeChange -> drop 1 $ scanl (+) 0 changes
|
||||
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes
|
||||
-- The row amounts valued according to --value if needed.
|
||||
, let val end = maybe id (mixedAmountApplyValuation jpricedirectives styles end today multiperiod) value_
|
||||
, let val end = maybe id (mixedAmountApplyValuation priceoracle styles end today multiperiod) value_
|
||||
, let valuedrowbals = dbg1 "valuedrowbals" $ [val periodlastday amt | (amt,periodlastday) <- zip rowbals lastdays]
|
||||
-- The total and average for the row, and their values.
|
||||
-- Total for a cumulative/historical report is always zero.
|
||||
|
||||
@ -99,7 +99,8 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
|
||||
reportPeriodOrJournalLastDay ropts j
|
||||
multiperiod = interval_ /= NoInterval
|
||||
showempty = empty_ || average_
|
||||
pvalue p end = maybe p (postingApplyValuation jpricedirectives styles end today multiperiod p) value_
|
||||
priceoracle = journalPriceOracle j
|
||||
pvalue p end = maybe p (postingApplyValuation priceoracle styles end today multiperiod p) value_
|
||||
|
||||
-- Postings, or summary postings with their subperiod's end date, to be displayed.
|
||||
displayps :: [(Posting, Maybe Day)]
|
||||
@ -121,7 +122,7 @@ postingsReport ropts@ReportOpts{..} q j@Journal{..} =
|
||||
-- For --value=end/now/DATE, convert the initial running total/average to value.
|
||||
startbalvalued = val startbal
|
||||
where
|
||||
val = maybe id (mixedAmountApplyValuation jpricedirectives styles daybeforereportstart today multiperiod) value_
|
||||
val = maybe id (mixedAmountApplyValuation priceoracle styles daybeforereportstart today multiperiod) value_
|
||||
where
|
||||
daybeforereportstart = maybe
|
||||
(error' "postingsReport: expected a non-empty journal") -- XXX shouldn't happen
|
||||
|
||||
@ -145,12 +145,14 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
|
||||
userq = queryFromOpts d ropts'
|
||||
format = outputFormatFromOpts opts
|
||||
|
||||
-- make a CompoundBalanceReport
|
||||
-- make a CompoundBalanceReport.
|
||||
-- For efficiency, generate a price oracle here and reuse it with each subreport.
|
||||
priceoracle = journalPriceOracle j
|
||||
subreports =
|
||||
map (\CBCSubreportSpec{..} ->
|
||||
(cbcsubreporttitle
|
||||
,mbrNormaliseSign cbcsubreportnormalsign $ -- <- convert normal-negative to normal-positive
|
||||
compoundBalanceSubreport ropts' userq j cbcsubreportquery cbcsubreportnormalsign
|
||||
compoundBalanceSubreport ropts' userq j priceoracle cbcsubreportquery cbcsubreportnormalsign
|
||||
,cbcsubreportincreasestotal
|
||||
))
|
||||
cbcqueries
|
||||
@ -252,14 +254,14 @@ showEndDates es = case es of
|
||||
|
||||
-- | Run one subreport for a compound balance command in multi-column mode.
|
||||
-- This returns a MultiBalanceReport.
|
||||
compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> NormalSign -> MultiBalanceReport
|
||||
compoundBalanceSubreport ropts@ReportOpts{..} userq j subreportqfn subreportnormalsign = r'
|
||||
compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> PriceOracle -> (Journal -> Query) -> NormalSign -> MultiBalanceReport
|
||||
compoundBalanceSubreport ropts@ReportOpts{..} userq j priceoracle subreportqfn subreportnormalsign = r'
|
||||
where
|
||||
-- force --empty to ensure same columns in all sections
|
||||
ropts' = ropts { empty_=True, normalbalance_=Just subreportnormalsign }
|
||||
-- run the report
|
||||
q = And [subreportqfn j, userq]
|
||||
r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j
|
||||
r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReportWith ropts' q j priceoracle
|
||||
-- if user didn't specify --empty, now remove the all-zero rows, unless they have non-zero subaccounts
|
||||
-- in this report
|
||||
r' | empty_ = r
|
||||
|
||||
Loading…
Reference in New Issue
Block a user