lib: deduplicate, refactor valuation code
This commit is contained in:
parent
0a9d724152
commit
69e255cead
@ -58,6 +58,7 @@ module Hledger.Data.Amount (
|
|||||||
-- ** arithmetic
|
-- ** arithmetic
|
||||||
costOfAmount,
|
costOfAmount,
|
||||||
divideAmount,
|
divideAmount,
|
||||||
|
amountValue,
|
||||||
-- ** rendering
|
-- ** rendering
|
||||||
amountstyle,
|
amountstyle,
|
||||||
showAmount,
|
showAmount,
|
||||||
@ -90,6 +91,7 @@ module Hledger.Data.Amount (
|
|||||||
isZeroMixedAmount,
|
isZeroMixedAmount,
|
||||||
isReallyZeroMixedAmount,
|
isReallyZeroMixedAmount,
|
||||||
isReallyZeroMixedAmountCost,
|
isReallyZeroMixedAmountCost,
|
||||||
|
mixedAmountValue,
|
||||||
-- ** rendering
|
-- ** rendering
|
||||||
showMixedAmount,
|
showMixedAmount,
|
||||||
showMixedAmountOneLine,
|
showMixedAmountOneLine,
|
||||||
@ -113,6 +115,8 @@ import Data.Function (on)
|
|||||||
import Data.List
|
import Data.List
|
||||||
import Data.Map (findWithDefault)
|
import Data.Map (findWithDefault)
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
import Data.Time.Calendar (Day)
|
||||||
|
import Data.Ord (comparing)
|
||||||
-- import Data.Text (Text)
|
-- import Data.Text (Text)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
@ -347,6 +351,38 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'}
|
|||||||
where
|
where
|
||||||
s' = findWithDefault s c styles
|
s' = findWithDefault s c styles
|
||||||
|
|
||||||
|
-- | Find the market value of this amount on the given date, in it's
|
||||||
|
-- default valuation commodity, based on recorded market prices.
|
||||||
|
-- If no default valuation commodity can be found, the amount is left
|
||||||
|
-- unchanged.
|
||||||
|
amountValue :: Journal -> Day -> Amount -> Amount
|
||||||
|
amountValue j d a =
|
||||||
|
case commodityValue j d (acommodity a) of
|
||||||
|
Just v -> v{aquantity=aquantity v * aquantity a
|
||||||
|
,aprice=aprice a
|
||||||
|
}
|
||||||
|
Nothing -> a
|
||||||
|
|
||||||
|
-- This is here not in Commodity.hs to use the Amount Show instance above for debugging.
|
||||||
|
-- | Find the market value, if known, of one unit of this commodity (A) on
|
||||||
|
-- the given valuation date, in the commodity (B) mentioned in the latest
|
||||||
|
-- applicable market price. The latest applicable market price is the market
|
||||||
|
-- price directive for commodity A with the latest date that is on or before
|
||||||
|
-- the valuation date; or if there are multiple such prices with the same date,
|
||||||
|
-- the last parsed.
|
||||||
|
commodityValue :: Journal -> Day -> CommoditySymbol -> Maybe Amount
|
||||||
|
commodityValue j valuationdate c
|
||||||
|
| null applicableprices = dbg Nothing
|
||||||
|
| otherwise = dbg $ Just $ mpamount $ last applicableprices
|
||||||
|
where
|
||||||
|
dbg = dbg8 ("using market price for "++T.unpack c)
|
||||||
|
applicableprices =
|
||||||
|
[p | p <- sortBy (comparing mpdate) $ jmarketprices j
|
||||||
|
, mpcommodity p == c
|
||||||
|
, mpdate p <= valuationdate
|
||||||
|
]
|
||||||
|
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- MixedAmount
|
-- MixedAmount
|
||||||
|
|
||||||
@ -603,6 +639,9 @@ cshowMixedAmountOneLineWithoutPrice m = concat $ intersperse ", " $ map cshowAmo
|
|||||||
canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
|
canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount
|
||||||
canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as
|
canonicaliseMixedAmount styles (Mixed as) = Mixed $ map (canonicaliseAmount styles) as
|
||||||
|
|
||||||
|
mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount
|
||||||
|
mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as
|
||||||
|
|
||||||
-------------------------------------------------------------------------------
|
-------------------------------------------------------------------------------
|
||||||
-- misc
|
-- misc
|
||||||
|
|
||||||
|
|||||||
@ -14,7 +14,6 @@ where
|
|||||||
import Data.List
|
import Data.List
|
||||||
import Data.Maybe (fromMaybe)
|
import Data.Maybe (fromMaybe)
|
||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
-- import Data.Text (Text)
|
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
-- import qualified Data.Map as M
|
-- import qualified Data.Map as M
|
||||||
|
|||||||
@ -17,9 +17,6 @@ module Hledger.Reports.BalanceReport (
|
|||||||
BalanceReport,
|
BalanceReport,
|
||||||
BalanceReportItem,
|
BalanceReportItem,
|
||||||
balanceReport,
|
balanceReport,
|
||||||
balanceReportValue,
|
|
||||||
mixedAmountValue,
|
|
||||||
amountValue,
|
|
||||||
flatShowsExclusiveBalance,
|
flatShowsExclusiveBalance,
|
||||||
|
|
||||||
-- * Tests
|
-- * Tests
|
||||||
@ -32,7 +29,6 @@ import Data.Ord
|
|||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
import Data.Time.Calendar
|
import Data.Time.Calendar
|
||||||
import Test.HUnit
|
import Test.HUnit
|
||||||
import qualified Data.Text as T
|
|
||||||
|
|
||||||
import Hledger.Data
|
import Hledger.Data
|
||||||
import Hledger.Read (mamountp')
|
import Hledger.Read (mamountp')
|
||||||
@ -152,57 +148,6 @@ balanceReportItem opts q a
|
|||||||
-- items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows]
|
-- items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows]
|
||||||
-- total = headDef 0 mbrtotals
|
-- total = headDef 0 mbrtotals
|
||||||
|
|
||||||
-- | Convert all the amounts in a single-column balance report to
|
|
||||||
-- their value on the given date in their default valuation
|
|
||||||
-- commodities.
|
|
||||||
balanceReportValue :: Journal -> Day -> BalanceReport -> BalanceReport
|
|
||||||
balanceReportValue j d r = r'
|
|
||||||
where
|
|
||||||
(items,total) = r
|
|
||||||
r' =
|
|
||||||
dbg8 "known market prices" (jmarketprices j) `seq`
|
|
||||||
dbg8 "report end date" d `seq`
|
|
||||||
dbg8 "balanceReportValue"
|
|
||||||
([(n, n', i, mixedAmountValue j d a) |(n,n',i,a) <- items], mixedAmountValue j d total)
|
|
||||||
|
|
||||||
mixedAmountValue :: Journal -> Day -> MixedAmount -> MixedAmount
|
|
||||||
mixedAmountValue j d (Mixed as) = Mixed $ map (amountValue j d) as
|
|
||||||
|
|
||||||
-- | Find the market value of this amount on the given date, in it's
|
|
||||||
-- default valuation commodity, based on recorded market prices.
|
|
||||||
-- If no default valuation commodity can be found, the amount is left
|
|
||||||
-- unchanged.
|
|
||||||
amountValue :: Journal -> Day -> Amount -> Amount
|
|
||||||
amountValue j d a =
|
|
||||||
case commodityValue j d (acommodity a) of
|
|
||||||
Just v -> v{aquantity=aquantity v * aquantity a
|
|
||||||
,aprice=aprice a
|
|
||||||
}
|
|
||||||
Nothing -> a
|
|
||||||
|
|
||||||
-- | Find the market value, if known, of one unit of this commodity (A) on
|
|
||||||
-- the given valuation date, in the commodity (B) mentioned in the latest
|
|
||||||
-- applicable market price. The latest applicable market price is the market
|
|
||||||
-- price directive for commodity A with the latest date that is on or before
|
|
||||||
-- the valuation date; or if there are multiple such prices with the same date,
|
|
||||||
-- the last parsed.
|
|
||||||
commodityValue :: Journal -> Day -> CommoditySymbol -> Maybe Amount
|
|
||||||
commodityValue j valuationdate c
|
|
||||||
| null applicableprices = dbg Nothing
|
|
||||||
| otherwise = dbg $ Just $ mpamount $ last applicableprices
|
|
||||||
where
|
|
||||||
dbg = dbg8 ("using market price for "++T.unpack c)
|
|
||||||
applicableprices =
|
|
||||||
[p | p <- sortBy (comparing mpdate) $ jmarketprices j
|
|
||||||
, mpcommodity p == c
|
|
||||||
, mpdate p <= valuationdate
|
|
||||||
]
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
tests_balanceReport =
|
tests_balanceReport =
|
||||||
let
|
let
|
||||||
|
|||||||
@ -9,7 +9,6 @@ module Hledger.Reports.MultiBalanceReports (
|
|||||||
MultiBalanceReport(..),
|
MultiBalanceReport(..),
|
||||||
MultiBalanceReportRow,
|
MultiBalanceReportRow,
|
||||||
multiBalanceReport,
|
multiBalanceReport,
|
||||||
multiBalanceReportValue,
|
|
||||||
singleBalanceReport,
|
singleBalanceReport,
|
||||||
|
|
||||||
-- -- * Tests
|
-- -- * Tests
|
||||||
@ -234,18 +233,6 @@ multiBalanceReport opts q j = MultiBalanceReport (displayspans, sorteditems, tot
|
|||||||
dbg1 s = let p = "multiBalanceReport" in Hledger.Utils.dbg1 (p++" "++s) -- add prefix in this function's debug output
|
dbg1 s = let p = "multiBalanceReport" in Hledger.Utils.dbg1 (p++" "++s) -- add prefix in this function's debug output
|
||||||
-- dbg1 = const id -- exclude this function from debug output
|
-- dbg1 = const id -- exclude this function from debug output
|
||||||
|
|
||||||
-- | Convert all the amounts in a multi-column balance report to their
|
|
||||||
-- value on the given date in their default valuation commodities
|
|
||||||
-- (which are determined as of that date, not the report interval dates).
|
|
||||||
multiBalanceReportValue :: Journal -> Day -> MultiBalanceReport -> MultiBalanceReport
|
|
||||||
multiBalanceReportValue j d r = r'
|
|
||||||
where
|
|
||||||
MultiBalanceReport (spans, rows, (coltotals, rowtotaltotal, rowavgtotal)) = r
|
|
||||||
r' = MultiBalanceReport
|
|
||||||
(spans,
|
|
||||||
[(acct, acct', depth, map convert rowamts, convert rowtotal, convert rowavg) | (acct, acct', depth, rowamts, rowtotal, rowavg) <- rows],
|
|
||||||
(map convert coltotals, convert rowtotaltotal, convert rowavgtotal))
|
|
||||||
convert = mixedAmountValue j d
|
|
||||||
|
|
||||||
tests_multiBalanceReport =
|
tests_multiBalanceReport =
|
||||||
let
|
let
|
||||||
|
|||||||
@ -82,14 +82,8 @@ asInit d reset ui@UIState{
|
|||||||
|
|
||||||
q = queryFromOpts d ropts
|
q = queryFromOpts d ropts
|
||||||
|
|
||||||
-- maybe convert balances to market value
|
|
||||||
convert | value_ ropts' = balanceReportValue j valuedate
|
|
||||||
| otherwise = id
|
|
||||||
where
|
|
||||||
valuedate = fromMaybe d $ queryEndDate False q
|
|
||||||
|
|
||||||
-- run the report
|
-- run the report
|
||||||
(items,_total) = convert $ report ropts' q j
|
(items,_total) = report ropts' q j
|
||||||
where
|
where
|
||||||
-- still using the old balanceReport for change reports as it
|
-- still using the old balanceReport for change reports as it
|
||||||
-- does not include every account from before the report period
|
-- does not include every account from before the report period
|
||||||
|
|||||||
@ -10,6 +10,9 @@ module Hledger.Cli.Utils
|
|||||||
(
|
(
|
||||||
withJournalDo,
|
withJournalDo,
|
||||||
writeOutput,
|
writeOutput,
|
||||||
|
journalApplyValue,
|
||||||
|
journalAddForecast,
|
||||||
|
generateAutomaticPostings,
|
||||||
journalReload,
|
journalReload,
|
||||||
journalReloadIfChanged,
|
journalReloadIfChanged,
|
||||||
journalFileIsNewer,
|
journalFileIsNewer,
|
||||||
@ -106,9 +109,12 @@ anonymise j
|
|||||||
where
|
where
|
||||||
anon = T.pack . flip showHex "" . (fromIntegral :: Int -> Word32) . hash
|
anon = T.pack . flip showHex "" . (fromIntegral :: Int -> Word32) . hash
|
||||||
|
|
||||||
-- TODO This early value conversion was introduced 2017/4 to replace the late balanceReportValue/multiBalanceReportValue conversion; but hledger-ui (eg) still uses the latter.
|
-- TODO move journalApplyValue and friends to Hledger.Data.Journal ? They are here because they use ReportOpts
|
||||||
|
|
||||||
-- | If -V/--value was requested, convert all journal amounts to their market value
|
-- | If -V/--value was requested, convert all journal amounts to their market value
|
||||||
-- as of the report end date. Cf http://hledger.org/manual.html#market-value
|
-- as of the report end date. Cf http://hledger.org/manual.html#market-value
|
||||||
|
-- Since 2017/4 we do this early, before commands run, which affects all commands
|
||||||
|
-- and seems to have the same effect as doing it last on the reported values.
|
||||||
journalApplyValue :: ReportOpts -> Journal -> IO Journal
|
journalApplyValue :: ReportOpts -> Journal -> IO Journal
|
||||||
journalApplyValue ropts j = do
|
journalApplyValue ropts j = do
|
||||||
mvaluedate <- reportEndDate j ropts
|
mvaluedate <- reportEndDate j ropts
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user