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