bal: support --value-at=p/t with multiperiod reports (#329)
This commit is contained in:
		
							parent
							
								
									74c381cc88
								
							
						
					
					
						commit
						8d7eacd73f
					
				| @ -85,7 +85,6 @@ type ClippedAccountName = AccountName | ||||
| multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport | ||||
| multiBalanceReport ropts@ReportOpts{..} q j = | ||||
|   (if invert_ then mbrNegate else id) $  | ||||
|   (if value_  then mbrValue ropts j else id) $ | ||||
|   MultiBalanceReport (displayspans, sorteditems, totalsrow) | ||||
|     where | ||||
|       symq       = dbg1 "symq"   $ filterQuery queryIsSym $ dbg1 "requested q" q | ||||
| @ -139,14 +138,39 @@ multiBalanceReport ropts@ReportOpts{..} q j = | ||||
|             | empty_    = dbg1 "displayspan (-E)" reportspan                              -- all the requested intervals | ||||
|             | otherwise = dbg1 "displayspan" $ requestedspan `spanIntersect` matchedspan  -- exclude leading/trailing empty intervals | ||||
|           matchedspan = dbg1 "matchedspan" $ postingsDateSpan' (whichDateFromOpts ropts) ps | ||||
|       -- Group postings into their columns. | ||||
|       psPerSpan :: [[Posting]] = | ||||
|       -- Group postings into their columns, with the column end dates. | ||||
|       psPerSpan :: [([Posting], Maybe Day)] = | ||||
|           dbg1 "psPerSpan" | ||||
|           [filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps | s <- displayspans] | ||||
|           [(filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps, spanEnd s) | s <- displayspans] | ||||
|       -- Check if we'll be doing valuation. Here's how it's done in the various cases: | ||||
|       --  balance -M --value-at | ||||
|       --   transaction: convert each posting to value before calculating table cell amounts (balance change or ending balance) ? | ||||
|       --   period:      convert each table cell amount (balance change or ending balance) to its value at period end | ||||
|       --   date:        convert each table cell amount to its value at date | ||||
|       mvalueat = if value_ then Just value_at_ else Nothing | ||||
|       today    = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_ | ||||
|       -- If --value-at=transaction is in effect, convert the postings to value before summing. | ||||
|       maybeValuedPsPerSpan :: [([Posting], Maybe Day)] = | ||||
|         case mvalueat of | ||||
|           Just AtTransaction -> [([postingValueAtDate j (postingDate p) p | p <- ps], periodend) | (ps,periodend) <- psPerSpan] | ||||
|           _                  -> psPerSpan | ||||
|       -- In each column, calculate the change in each account that has postings. | ||||
|       -- And if --value-at is in effect (except --value-at=transaction), convert these change amounts to value. | ||||
|       postedAcctBalChangesPerSpan :: [[(ClippedAccountName, MixedAmount)]] = | ||||
|           dbg1 "postedAcctBalChangesPerSpan" $ | ||||
|           map postingAcctBals psPerSpan | ||||
|           [postingAcctBals valuedps | ||||
|           | (ps,periodend) <- maybeValuedPsPerSpan | ||||
|           , let periodlastday = maybe | ||||
|                                 (error' "multiBalanceReport: expected a subperiod end date") -- XXX shouldn't happen | ||||
|                                 (addDays (-1)) | ||||
|                                 periodend | ||||
|           , let valuedps = | ||||
|                   case mvalueat of | ||||
|                     Just AtPeriod      -> [postingValueAtDate j periodlastday p | p <- ps] | ||||
|                     Just AtNow         -> [postingValueAtDate j today p         | p <- ps] | ||||
|                     Just (AtDate d)    -> [postingValueAtDate j d p             | p <- ps] | ||||
|                     _                  -> ps | ||||
|           ] | ||||
|           where | ||||
|             postingAcctBals :: [Posting] -> [(ClippedAccountName, MixedAmount)] | ||||
|             postingAcctBals ps = [(aname a, (if tree_ ropts then aibalance else aebalance) a) | a <- as] | ||||
| @ -192,8 +216,8 @@ multiBalanceReport ropts@ReportOpts{..} q j = | ||||
|           [(a, accountLeafName a, accountNameLevel a, displayedBals, rowtot, rowavg) | ||||
|            | (a,changes) <- acctBalChanges | ||||
|            , let displayedBals = case balancetype_ of | ||||
|                                   HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes | ||||
|                                   CumulativeChange -> drop 1 $ scanl (+) nullmixedamt changes | ||||
|                                   HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes  -- XXX need to value per period | ||||
|                                   CumulativeChange  -> drop 1 $ scanl (+) 0                      changes | ||||
|                                   _                 -> changes | ||||
|            , let rowtot = sum displayedBals | ||||
|            , let rowavg = averageMixedAmounts displayedBals | ||||
| @ -274,43 +298,6 @@ multiBalanceReportSpan :: MultiBalanceReport -> DateSpan | ||||
| multiBalanceReportSpan (MultiBalanceReport ([], _, _))       = DateSpan Nothing Nothing | ||||
| multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans) | ||||
| 
 | ||||
| -- | Convert all the posting amounts in a MultiBalanceReport to their | ||||
| -- default valuation commodities. This means using the Journal's most | ||||
| -- recent applicable market prices before the valuation date. | ||||
| -- The valuation date is set with --value-at and can be: | ||||
| -- each posting's date, | ||||
| -- or the last day in the report subperiod, | ||||
| -- or today's date (gives an error if today_ is not set in ReportOpts), | ||||
| -- or a specified date. | ||||
| mbrValue :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport | ||||
| mbrValue ReportOpts{..} Journal{..} (MultiBalanceReport (spans, rows, (coltotals, rowtotaltotal, rowavgtotal))) = | ||||
|   MultiBalanceReport ( | ||||
|      spans | ||||
|     ,[(acct, acct', depth, map (uncurry val) $ zip ends rowamts, val end rowtotal, val end rowavg) | ||||
|      | (acct, acct', depth, rowamts, rowtotal, rowavg) <- rows] | ||||
|     ,(map (uncurry val) $ zip ends coltotals | ||||
|      ,val end rowtotaltotal | ||||
|      ,val end rowavgtotal) | ||||
|     ) | ||||
|   where | ||||
|     ends = map (addDays (-1) . fromMaybe (error' "mbrValue: expected all report periods to have an end date") . spanEnd) spans  -- XXX shouldn't happen | ||||
|     end  = lastDef (error' "mbrValue: expected at least one report subperiod") ends  -- XXX shouldn't happen | ||||
|     val periodend amt = mixedAmountValue prices valuationdate amt | ||||
|       where | ||||
|         -- prices are in parse order - sort into date then parse order, | ||||
|         -- & reversed for quick lookup of the latest price. | ||||
|         prices = reverse $ sortOn mpdate jmarketprices | ||||
|         valuationdate = case value_at_ of | ||||
|           AtTransaction -> | ||||
|             error' "sorry, --value-at=transaction with balance reports is not yet supported" | ||||
|           AtPeriod | average_ || row_total_ -> | ||||
|             error' "sorry, --value-at=period with -T or -A in periodic balance reports is not yet supported" | ||||
|           AtPeriod      -> periodend | ||||
|           AtNow         -> case today_ of | ||||
|                              Just d  -> d | ||||
|                              Nothing -> error' "mbrValue: ReportOpts today_ is unset so could not satisfy --value-at=now" | ||||
|           AtDate d      -> d | ||||
| 
 | ||||
| -- | Generates a simple non-columnar BalanceReport, but using multiBalanceReport,  | ||||
| -- in order to support --historical. Does not support tree-mode boring parent eliding.  | ||||
| -- If the normalbalance_ option is set, it adjusts the sorting and sign of amounts  | ||||
|  | ||||
| @ -323,11 +323,7 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do | ||||
|            | ||||
|       else | ||||
|         if multiperiod then do  -- multi period balance report | ||||
|           -- With --value-at=transaction, convert all amounts to value before summing them. | ||||
|           let j' | value_at_ == AtTransaction = | ||||
|                      error' "sorry, --value-at=transaction with balance reports is not yet supported"  -- journalValueAtTransactionDate ropts j | ||||
|                  | otherwise = j | ||||
|               report = multiBalanceReport ropts (queryFromOpts d ropts) j' | ||||
|           let report = multiBalanceReport ropts (queryFromOpts d ropts) j | ||||
|               render = case format of | ||||
|                 "csv"  -> (++ "\n") . printCSV . multiBalanceReportAsCsv ropts | ||||
|                 "html" ->  (++ "\n") . TL.unpack . L.renderText . multiBalanceReportAsHtml ropts | ||||
| @ -335,16 +331,13 @@ balance opts@CliOpts{rawopts_=rawopts,reportopts_=ropts@ReportOpts{..}} j = do | ||||
|           writeOutput opts $ render report | ||||
| 
 | ||||
|         else do  -- single period simple balance report | ||||
|           -- With --value-at=transaction, convert all amounts to value before summing them. | ||||
|           let j' | value_at_ == AtTransaction = journalValueAtTransactionDate ropts j | ||||
|                  | otherwise = j | ||||
|               report | ||||
|           let report | ||||
|                 | balancetype_ `elem` [HistoricalBalance, CumulativeChange] | ||||
|                   = let ropts' | flat_ ropts = ropts | ||||
|                                | otherwise   = ropts{accountlistmode_=ALTree} | ||||
|                     in balanceReportFromMultiBalanceReport ropts' (queryFromOpts d ropts) j' | ||||
|                     in balanceReportFromMultiBalanceReport ropts' (queryFromOpts d ropts) j | ||||
|                           -- for historical balances we must use balanceReportFromMultiBalanceReport (also forces --no-elide) | ||||
|                 | otherwise = balanceReport ropts (queryFromOpts d ropts) j' -- simple Ledger-style balance report  | ||||
|                 | otherwise = balanceReport ropts (queryFromOpts d ropts) j -- simple Ledger-style balance report  | ||||
|               render = case format of | ||||
|                 "csv"  -> \ropts r -> (++ "\n") $ printCSV $ balanceReportAsCsv ropts r | ||||
|                 "html" -> \_ _ -> error' "Sorry, HTML output is not yet implemented for this kind of report."  -- TODO | ||||
|  | ||||
| @ -25,7 +25,7 @@ import Text.Tabular as T | ||||
| import Hledger | ||||
| import Hledger.Cli.Commands.Balance | ||||
| import Hledger.Cli.CliOptions | ||||
| import Hledger.Cli.Utils (journalValueAtTransactionDate, writeOutput) | ||||
| import Hledger.Cli.Utils (writeOutput) | ||||
| 
 | ||||
| -- | Description of a compound balance report command,  | ||||
| -- from which we generate the command's cmdargs mode and IO action. | ||||
| @ -209,15 +209,11 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r | ||||
| compoundBalanceSubreport :: ReportOpts -> Query -> Journal -> (Journal -> Query) -> NormalSign -> MultiBalanceReport | ||||
| compoundBalanceSubreport ropts@ReportOpts{..} userq j subreportqfn subreportnormalsign = r' | ||||
|   where | ||||
|     -- With --value-at=transaction and a periodic report, convert all amounts to value before summing them. | ||||
|     j' | value_at_ == AtTransaction && interval_ /= NoInterval = journalValueAtTransactionDate ropts j | ||||
|        | otherwise = j | ||||
| 
 | ||||
|     -- 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' | ||||
|     q = And [subreportqfn j, userq] | ||||
|     r@(MultiBalanceReport (dates, rows, totals)) = multiBalanceReport ropts' q j | ||||
|     -- if user didn't specify --empty, now remove the all-zero rows, unless they have non-zero subaccounts | ||||
|     -- in this report | ||||
|     r' | empty_    = r | ||||
|  | ||||
| @ -14,7 +14,6 @@ module Hledger.Cli.Utils | ||||
|      writeOutput, | ||||
|      journalTransform, | ||||
|      journalAddForecast, | ||||
|      journalValueAtTransactionDate, | ||||
|      journalReload, | ||||
|      journalReloadIfChanged, | ||||
|      journalFileIsNewer, | ||||
| @ -121,24 +120,6 @@ anonymise j | ||||
|   where | ||||
|     anon = T.pack . flip showHex "" . (fromIntegral :: Int -> Word32) . hash | ||||
| 
 | ||||
| -- journalApplyValue and friends are here not in Hledger.Data.Journal | ||||
| -- because they use ReportOpts. | ||||
| 
 | ||||
| -- | Convert all the journal's posting amounts to their market value | ||||
| -- as of each posting's date. Needed when converting some periodic | ||||
| -- reports to value, when --value-at=transaction (only). | ||||
| -- See eg Register.hs.  | ||||
| journalValueAtTransactionDate :: ReportOpts -> Journal -> Journal | ||||
| journalValueAtTransactionDate ReportOpts{..} j@Journal{..} | ||||
|   | value_at_ /= AtTransaction = j | ||||
|   | otherwise                  = j{jtxns = map txnvalue jtxns} | ||||
|   where | ||||
|     txnvalue t@Transaction{..} = t{tpostings=map postingvalue tpostings} | ||||
|     postingvalue p@Posting{..} = p{pamount=mixedAmountValue prices (postingDate p) pamount} | ||||
|     -- prices are in parse order - sort into date then parse order, | ||||
|     -- reversed for quick lookup of the latest price. | ||||
|     prices = reverse $ sortOn mpdate jmarketprices | ||||
| 
 | ||||
| -- | Generate periodic transactions from all periodic transaction rules in the journal. | ||||
| -- These transactions are added to the in-memory Journal (but not the on-disk file). | ||||
| -- | ||||
|  | ||||
| @ -612,9 +612,10 @@ Here are the ones currently supported | ||||
| | register                                                | Y                                 | Y                            | Y                                | | ||||
| | register, multiperiod                              | Y                                 | Y                            | Y                                | | ||||
| | balance                                                 | Y                                 | Y                            | Y                                | | ||||
| | balance, multiperiod                               | -                                 | Y                            | Y                                | | ||||
| | balance, multiperiod, -T/-A                   | -                                 | -                            | Y                                | | ||||
| | balance, multiperiod                               | Y                                 | Y                            | Y                                | | ||||
| | balance, multiperiod, -T/-A                   | Y                                 | Y                            | Y                                | | ||||
| | register/balance, multiperiod, -T/-A, -H | ?                                 | ?                            | ?                                | | ||||
| | balance, --budget                                  | ?                                 | ?                            | ?                                | | ||||
| 
 | ||||
| ## Combining -B and -V | ||||
| 
 | ||||
|  | ||||
| @ -299,15 +299,13 @@ $ hledger -f- bal -V | ||||
| 
 | ||||
| # 29. multicolumn balance report valued at transaction | ||||
| $ hledger -f- bal -MTA --value-at=transaction | ||||
| >2 /not yet supported/ | ||||
| >=1 | ||||
| # Balance changes in 2000q1: | ||||
| # | ||||
| #    || Jan  Feb  Mar    Total  Average  | ||||
| # ===++================================= | ||||
| #  a || 1 B  2 B  3 B      6 B      2 B  | ||||
| # ---++--------------------------------- | ||||
| #    || 1 B  2 B  3 B      6 B      2 B  | ||||
| Balance changes in 2000q1: | ||||
| 
 | ||||
|    || Jan  Feb  Mar    Total  Average  | ||||
| ===++================================= | ||||
|  a || 1 B  2 B  3 B      6 B      2 B  | ||||
| ---++--------------------------------- | ||||
|    || 1 B  2 B  3 B      6 B      2 B  | ||||
|   | ||||
| # 30. multicolumn balance report valued at period end | ||||
| $ hledger -f- bal -M --value-at=period | ||||
| @ -321,18 +319,25 @@ Balance changes in 2000q1: | ||||
| 
 | ||||
| # 31. multicolumn balance report valued at period end with -T or -A | ||||
| $ hledger -f- bal -M --value-at=period -TA | ||||
| >2 /not yet supported/ | ||||
| >=1 | ||||
| 
 | ||||
| # 32. multicolumn balance report valued at other date | ||||
| $ hledger -f- bal -M --value-at=2000-01-15 | ||||
| Balance changes in 2000q1: | ||||
| 
 | ||||
|    || Jan  Feb  Mar  | ||||
| ===++=============== | ||||
|  a || 5 B  5 B  5 B  | ||||
| ---++--------------- | ||||
|    || 5 B  5 B  5 B  | ||||
|    || Jan  Feb  Mar    Total  Average  | ||||
| ===++================================= | ||||
|  a || 5 B  2 B  3 B     10 B      3 B  | ||||
| ---++--------------------------------- | ||||
|    || 5 B  2 B  3 B     10 B      3 B  | ||||
| # >2 /not yet supported/ | ||||
| # >=1 | ||||
| 
 | ||||
| # 32. multicolumn balance report valued at other date | ||||
| $ hledger -f- bal -MTA --value-at=2000-01-15 | ||||
| Balance changes in 2000q1: | ||||
| 
 | ||||
|    || Jan  Feb  Mar    Total  Average  | ||||
| ===++================================= | ||||
|  a || 5 B  5 B  5 B     15 B      5 B  | ||||
| ---++--------------------------------- | ||||
|    || 5 B  5 B  5 B     15 B      5 B  | ||||
| 
 | ||||
| # 33. multicolumn balance report valued today (with today >= 2000-04-01) | ||||
| $ hledger -f- bal -M --value-at=now | ||||
|  | ||||
		Loading…
	
		Reference in New Issue
	
	Block a user