lib: deduplicate, refactor valuation code
This commit is contained in:
		
							parent
							
								
									0a9d724152
								
							
						
					
					
						commit
						69e255cead
					
				| @ -58,6 +58,7 @@ module Hledger.Data.Amount ( | ||||
|   -- ** arithmetic | ||||
|   costOfAmount, | ||||
|   divideAmount, | ||||
|   amountValue, | ||||
|   -- ** rendering | ||||
|   amountstyle, | ||||
|   showAmount, | ||||
| @ -90,6 +91,7 @@ module Hledger.Data.Amount ( | ||||
|   isZeroMixedAmount, | ||||
|   isReallyZeroMixedAmount, | ||||
|   isReallyZeroMixedAmountCost, | ||||
|   mixedAmountValue, | ||||
|   -- ** rendering | ||||
|   showMixedAmount, | ||||
|   showMixedAmountOneLine, | ||||
| @ -113,6 +115,8 @@ import Data.Function (on) | ||||
| import Data.List | ||||
| import Data.Map (findWithDefault) | ||||
| import Data.Maybe | ||||
| import Data.Time.Calendar (Day) | ||||
| import Data.Ord (comparing) | ||||
| -- import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| import Test.HUnit | ||||
| @ -347,6 +351,38 @@ canonicaliseAmount styles a@Amount{acommodity=c, astyle=s} = a{astyle=s'} | ||||
|     where | ||||
|       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 | ||||
| 
 | ||||
| @ -603,6 +639,9 @@ cshowMixedAmountOneLineWithoutPrice m = concat $ intersperse ", " $ map cshowAmo | ||||
| canonicaliseMixedAmount :: M.Map CommoditySymbol AmountStyle -> MixedAmount -> MixedAmount | ||||
| 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 | ||||
| 
 | ||||
|  | ||||
| @ -14,7 +14,6 @@ where | ||||
| import Data.List | ||||
| import Data.Maybe (fromMaybe) | ||||
| import Data.Monoid | ||||
| -- import Data.Text (Text) | ||||
| import qualified Data.Text as T | ||||
| import Test.HUnit | ||||
| -- import qualified Data.Map as M | ||||
|  | ||||
| @ -17,9 +17,6 @@ module Hledger.Reports.BalanceReport ( | ||||
|   BalanceReport, | ||||
|   BalanceReportItem, | ||||
|   balanceReport, | ||||
|   balanceReportValue, | ||||
|   mixedAmountValue, | ||||
|   amountValue, | ||||
|   flatShowsExclusiveBalance, | ||||
| 
 | ||||
|   -- * Tests | ||||
| @ -32,7 +29,6 @@ import Data.Ord | ||||
| import Data.Maybe | ||||
| import Data.Time.Calendar | ||||
| import Test.HUnit | ||||
| import qualified Data.Text as T | ||||
| 
 | ||||
| import Hledger.Data | ||||
| import Hledger.Read (mamountp') | ||||
| @ -152,57 +148,6 @@ balanceReportItem opts q a | ||||
| --     items = [(a,a',n, headDef 0 bs) | ((a,a',n), bs) <- mbrrows] | ||||
| --     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 = | ||||
|   let | ||||
|  | ||||
| @ -9,7 +9,6 @@ module Hledger.Reports.MultiBalanceReports ( | ||||
|   MultiBalanceReport(..), | ||||
|   MultiBalanceReportRow, | ||||
|   multiBalanceReport, | ||||
|   multiBalanceReportValue, | ||||
|   singleBalanceReport, | ||||
| 
 | ||||
|   -- -- * 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 = 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 = | ||||
|   let | ||||
|  | ||||
| @ -82,14 +82,8 @@ asInit d reset ui@UIState{ | ||||
| 
 | ||||
|     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 | ||||
|     (items,_total) = convert $ report ropts' q j | ||||
|     (items,_total) = report ropts' q j | ||||
|       where | ||||
|         -- still using the old balanceReport for change reports as it | ||||
|         -- does not include every account from before the report period | ||||
|  | ||||
| @ -10,6 +10,9 @@ module Hledger.Cli.Utils | ||||
|     ( | ||||
|      withJournalDo, | ||||
|      writeOutput, | ||||
|      journalApplyValue,  | ||||
|      journalAddForecast, | ||||
|      generateAutomaticPostings, | ||||
|      journalReload, | ||||
|      journalReloadIfChanged, | ||||
|      journalFileIsNewer, | ||||
| @ -106,9 +109,12 @@ anonymise j | ||||
|   where | ||||
|     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 | ||||
| -- 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 ropts j = do | ||||
|     mvaluedate <- reportEndDate j ropts | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user