mirror of
https://github.com/simonmichael/hledger.git
synced 2025-01-04 08:13:20 +03:00
524 lines
28 KiB
Haskell
524 lines
28 KiB
Haskell
{-# LANGUAGE FlexibleInstances, RecordWildCards, ScopedTypeVariables, OverloadedStrings #-}
|
|
{-|
|
|
|
|
Multi-column balance reports, used by the balance command.
|
|
|
|
-}
|
|
|
|
module Hledger.Reports.MultiBalanceReports (
|
|
MultiBalanceReport(..),
|
|
MultiBalanceReportRow,
|
|
multiBalanceReport,
|
|
balanceReportFromMultiBalanceReport,
|
|
mbrNegate,
|
|
mbrNormaliseSign,
|
|
multiBalanceReportSpan,
|
|
tableAsText,
|
|
|
|
-- -- * Tests
|
|
tests_MultiBalanceReports
|
|
)
|
|
where
|
|
|
|
import Data.List
|
|
import Data.Maybe
|
|
import Data.Ord
|
|
import Data.Time.Calendar
|
|
import Safe
|
|
import Text.Tabular as T
|
|
import Text.Tabular.AsciiWide
|
|
|
|
import Hledger.Data
|
|
import Hledger.Query
|
|
import Hledger.Utils
|
|
import Hledger.Read (mamountp')
|
|
import Hledger.Reports.ReportOptions
|
|
import Hledger.Reports.BalanceReport
|
|
|
|
|
|
-- | A multi balance report is a balance report with one or more columns. It has:
|
|
--
|
|
-- 1. a list of each column's period (date span)
|
|
--
|
|
-- 2. a list of rows, each containing:
|
|
--
|
|
-- * the full account name
|
|
--
|
|
-- * the leaf account name
|
|
--
|
|
-- * the account's depth
|
|
--
|
|
-- * A list of amounts, one for each column. The meaning of the
|
|
-- amounts depends on the type of multi balance report, of which
|
|
-- there are three: periodic, cumulative and historical (see
|
|
-- 'BalanceType' and "Hledger.Cli.Commands.Balance").
|
|
--
|
|
-- * the total of the row's amounts for a periodic report,
|
|
-- or zero for cumulative/historical reports (since summing
|
|
-- end balances generally doesn't make sense).
|
|
--
|
|
-- * the average of the row's amounts
|
|
--
|
|
-- 3. the column totals, and the overall grand total (or zero for
|
|
-- cumulative/historical reports) and grand average.
|
|
--
|
|
newtype MultiBalanceReport =
|
|
MultiBalanceReport ([DateSpan]
|
|
,[MultiBalanceReportRow]
|
|
,MultiBalanceReportTotals
|
|
)
|
|
type MultiBalanceReportRow = (AccountName, AccountName, Int, [MixedAmount], MixedAmount, MixedAmount)
|
|
type MultiBalanceReportTotals = ([MixedAmount], MixedAmount, MixedAmount) -- (Totals list, sum of totals, average of totals)
|
|
|
|
instance Show MultiBalanceReport where
|
|
-- use pshow (pretty-show's ppShow) to break long lists onto multiple lines
|
|
-- we add some bogus extra shows here to help it parse the output
|
|
-- and wrap tuples and lists properly
|
|
show (MultiBalanceReport (spans, items, totals)) =
|
|
"MultiBalanceReport (ignore extra quotes):\n" ++ pshow (show spans, map show items, totals)
|
|
|
|
-- type alias just to remind us which AccountNames might be depth-clipped, below.
|
|
type ClippedAccountName = AccountName
|
|
|
|
-- | Generate a multicolumn balance report for the matched accounts,
|
|
-- showing the change of balance, accumulated balance, or historical balance
|
|
-- in each of the specified periods. Does not support tree-mode boring parent eliding.
|
|
-- 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.
|
|
multiBalanceReport :: ReportOpts -> Query -> Journal -> MultiBalanceReport
|
|
multiBalanceReport ropts@ReportOpts{..} q j@Journal{..} =
|
|
(if invert_ then mbrNegate else id) $
|
|
MultiBalanceReport (colspans, sortedrowsvalued, totalsrow)
|
|
where
|
|
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
|
|
|
|
----------------------------------------------------------------------
|
|
-- 1. Queries, report/column dates.
|
|
|
|
symq = dbg1 "symq" $ filterQuery queryIsSym $ dbg1 "requested q" q
|
|
depthq = dbg1 "depthq" $ filterQuery queryIsDepth q
|
|
depth = queryDepth depthq
|
|
depthless = dbg1 "depthless" . filterQuery (not . queryIsDepth)
|
|
datelessq = dbg1 "datelessq" $ filterQuery (not . queryIsDateOrDate2) q
|
|
dateqcons = if date2_ then Date2 else Date
|
|
-- The date span specified by -b/-e/-p options and query args if any.
|
|
requestedspan = dbg1 "requestedspan" $ queryDateSpan date2_ q
|
|
-- If the requested span is open-ended, close it using the journal's end dates.
|
|
-- This can still be the null (open) span if the journal is empty.
|
|
requestedspan' = dbg1 "requestedspan'" $ requestedspan `spanDefaultsFrom` journalDateSpan date2_ j
|
|
-- The list of interval spans enclosing the requested span.
|
|
-- This list can be empty if the journal was empty,
|
|
-- or if hledger-ui has added its special date:-tomorrow to the query
|
|
-- and all txns are in the future.
|
|
intervalspans = dbg1 "intervalspans" $ splitSpan interval_ requestedspan'
|
|
-- The requested span enlarged to enclose a whole number of intervals.
|
|
-- This can be the null span if there were no intervals.
|
|
reportspan = dbg1 "reportspan" $ DateSpan (maybe Nothing spanStart $ headMay intervalspans)
|
|
(maybe Nothing spanEnd $ lastMay intervalspans)
|
|
mreportstart = spanStart reportspan
|
|
-- The user's query with no depth limit, and expanded to the report span
|
|
-- if there is one (otherwise any date queries are left as-is, which
|
|
-- handles the hledger-ui+future txns case above).
|
|
reportq = dbg1 "reportq" $ depthless $
|
|
if reportspan == nulldatespan
|
|
then q
|
|
else And [datelessq, reportspandatesq]
|
|
where
|
|
reportspandatesq = dbg1 "reportspandatesq" $ dateqcons reportspan
|
|
-- The date spans to be included as report columns.
|
|
colspans :: [DateSpan] = dbg1 "colspans" $ splitSpan interval_ displayspan
|
|
where
|
|
displayspan
|
|
| 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
|
|
|
|
----------------------------------------------------------------------
|
|
-- 2. Things we'll need for valuation, if -V/--value-at are present.
|
|
-- Valuation complicates this report quite a lot.
|
|
|
|
-- Here's the current intended effect of --value-at on each part of the report:
|
|
-- -H starting balances:
|
|
-- transaction: sum of values of previous postings on their posting dates
|
|
-- period: value -H starting balances at day before report start
|
|
-- date: value -H starting balances at date
|
|
-- table cells:
|
|
-- transaction: value each posting before calculating table cell amounts
|
|
-- period: value each table cell amount at subperiod end
|
|
-- date: value each table cell amount at date
|
|
-- column totals:
|
|
-- transaction: sum/average the valued cell amounts
|
|
-- period: sum/average the unvalued amounts and value at subperiod end
|
|
-- date: sum/average the unvalued amounts and value at date
|
|
-- row totals & averages, grand total & average:
|
|
-- transaction: sum/average the valued amounts
|
|
-- period: sum/average the unvalued amounts and value at report period end
|
|
-- date: sum/average the unvalued amounts and value at date
|
|
-- mvalueat = valueTypeFromOpts ropts
|
|
today = fromMaybe (error' "postingsReport: ReportOpts today_ is unset so could not satisfy --value-at=now") today_
|
|
-- Market prices. Sort into date then parse order,
|
|
-- & reverse for quick lookup of the latest price.
|
|
prices = reverse $ sortOn mpdate jmarketprices
|
|
-- A helper for valuing amounts according to --value-at.
|
|
maybevalue :: Day -> MixedAmount -> MixedAmount
|
|
maybevalue periodlastday amt = case value_ of
|
|
Nothing -> amt
|
|
Just (AtCost _mc) -> amt -- assume --value-at=transaction was handled earlier
|
|
Just (AtEnd _mc) -> mixedAmountValue prices periodlastday amt
|
|
Just (AtNow _mc) -> mixedAmountValue prices today amt
|
|
Just (AtDate d _mc) -> mixedAmountValue prices d amt
|
|
-- The last day of each column subperiod.
|
|
lastdays :: [Day] =
|
|
map ((maybe
|
|
(error' "multiBalanceReport: expected all spans to have an end date") -- XXX should not happen
|
|
(addDays (-1)))
|
|
. spanEnd) colspans
|
|
-- The last day of the overall report period.
|
|
reportlastday =
|
|
fromMaybe (error' "multiBalanceReport: expected a non-empty journal") -- XXX might happen ? :(
|
|
$ reportPeriodOrJournalLastDay ropts j
|
|
|
|
----------------------------------------------------------------------
|
|
-- 3. Calculate starting balances (both unvalued and valued), if needed for -H
|
|
|
|
-- Balances at report start date, unvalued, from all earlier postings which otherwise match the query.
|
|
startbals :: [(AccountName, MixedAmount)] = dbg1 "startbals" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems
|
|
where
|
|
(startbalanceitems,_) = dbg1 "starting balance report" $ balanceReport ropts''{value_=Nothing} startbalq j
|
|
where
|
|
ropts' | tree_ ropts = ropts{no_elide_=True}
|
|
| otherwise = ropts{accountlistmode_=ALFlat}
|
|
ropts'' = ropts'{period_ = precedingperiod}
|
|
where
|
|
precedingperiod = dateSpanAsPeriod $ spanIntersect (DateSpan Nothing mreportstart) $ periodAsDateSpan period_
|
|
-- q projected back before the report start date.
|
|
-- When there's no report start date, in case there are future txns (the hledger-ui case above),
|
|
-- we use emptydatespan to make sure they aren't counted as starting balance.
|
|
startbalq = dbg1 "startbalq" $ And [datelessq, dateqcons precedingspan]
|
|
where
|
|
precedingspan = case mreportstart of
|
|
Just d -> DateSpan Nothing (Just d)
|
|
Nothing -> emptydatespan
|
|
-- Balances at report start date, maybe valued according to --value-at. XXX duplication
|
|
startbalsmaybevalued :: [(AccountName, MixedAmount)] = dbg1 "startbalsmaybevalued" $ map (\(a,_,_,b) -> (a,b)) startbalanceitems
|
|
where
|
|
(startbalanceitems,_) = dbg1 "starting balance report (maybe valued)" $ balanceReport ropts'' startbalq j
|
|
where
|
|
ropts' | tree_ ropts = ropts{no_elide_=True}
|
|
| otherwise = ropts{accountlistmode_=ALFlat}
|
|
ropts'' = ropts'{period_ = precedingperiod}
|
|
where
|
|
precedingperiod = dateSpanAsPeriod $ spanIntersect (DateSpan Nothing mreportstart) $ periodAsDateSpan period_
|
|
-- q projected back before the report start date.
|
|
-- When there's no report start date, in case there are future txns (the hledger-ui case above),
|
|
-- we use emptydatespan to make sure they aren't counted as starting balance.
|
|
startbalq = dbg1 "startbalq" $ And [datelessq, dateqcons precedingspan]
|
|
where
|
|
precedingspan = case mreportstart of
|
|
Just d -> DateSpan Nothing (Just d)
|
|
Nothing -> emptydatespan
|
|
-- The matched accounts with a starting balance. All of these should appear
|
|
-- in the report even if they have no postings during the report period.
|
|
startaccts = dbg1 "startaccts" $ map fst startbals
|
|
-- Helpers to look up an account's starting balance.
|
|
startingBalanceFor a = fromMaybe nullmixedamt $ lookup a startbals
|
|
valuedStartingBalanceFor a = fromMaybe nullmixedamt $ lookup a startbalsmaybevalued
|
|
|
|
----------------------------------------------------------------------
|
|
-- 4. Gather postings for each column.
|
|
|
|
-- Postings matching the query within the report period.
|
|
ps :: [Posting] =
|
|
dbg1 "ps" $
|
|
journalPostings $
|
|
filterJournalAmounts symq $ -- remove amount parts excluded by cur:
|
|
filterJournalPostings reportq $ -- remove postings not matched by (adjusted) query
|
|
journalSelectingAmountFromOpts ropts j
|
|
-- Group postings into their columns, with the column end dates.
|
|
colps :: [([Posting], Maybe Day)] =
|
|
dbg1 "colps"
|
|
[(filter (isPostingInDateSpan' (whichDateFromOpts ropts) s) ps, spanEnd s) | s <- colspans]
|
|
-- If --value-at=transaction is in effect, convert the postings to value before summing.
|
|
colpsmaybevalued :: [([Posting], Maybe Day)] =
|
|
case value_ of
|
|
Just (AtCost _mc) -> [([postingValue jmarketprices (postingDate p) p | p <- ps], periodend) | (ps,periodend) <- colps]
|
|
_ -> colps
|
|
|
|
----------------------------------------------------------------------
|
|
-- 5. Calculate account balance changes in each column.
|
|
|
|
-- In each column, gather the accounts that have postings and their change amount.
|
|
-- Do this for the unvalued postings, and if needed the posting-date-valued postings.
|
|
acctChangesFromPostings :: [Posting] -> [(ClippedAccountName, MixedAmount)]
|
|
acctChangesFromPostings ps = [(aname a, (if tree_ ropts then aibalance else aebalance) a) | a <- as]
|
|
where
|
|
as = depthLimit $
|
|
(if tree_ ropts then id else filter ((>0).anumpostings)) $
|
|
drop 1 $ accountsFromPostings ps
|
|
depthLimit
|
|
| tree_ ropts = filter ((depthq `matchesAccount`).aname) -- exclude deeper balances
|
|
| otherwise = clipAccountsAndAggregate depth -- aggregate deeper balances at the depth limit
|
|
-- colacctchanges :: [[(ClippedAccountName, MixedAmount)]] =
|
|
-- dbg1 "colacctchanges" $ map (acctChangesFromPostings . fst) colps
|
|
colacctchangesmaybevalued :: [[(ClippedAccountName, MixedAmount)]] =
|
|
dbg1 "colacctchangesmaybevalued" $ map (acctChangesFromPostings . fst) colpsmaybevalued
|
|
|
|
----------------------------------------------------------------------
|
|
-- 6. Gather the account balance changes into a regular matrix including the accounts
|
|
-- from all columns (and with -H, accounts with starting balances), adding zeroes where needed.
|
|
|
|
-- All account names that will be displayed, possibly depth-clipped.
|
|
displayaccts :: [ClippedAccountName] =
|
|
dbg1 "displayaccts" $
|
|
(if tree_ ropts then expandAccountNames else id) $
|
|
nub $ map (clipOrEllipsifyAccountName depth) $
|
|
if empty_ || balancetype_ == HistoricalBalance
|
|
then nub $ sort $ startaccts ++ allpostedaccts
|
|
else allpostedaccts
|
|
where
|
|
allpostedaccts :: [AccountName] = dbg1 "allpostedaccts" $ sort $ accountNamesFromPostings ps
|
|
-- Each column's balance changes for each account, adding zeroes where needed.
|
|
colallacctchanges :: [[(ClippedAccountName, MixedAmount)]] =
|
|
dbg1 "colallacctchanges"
|
|
[sortBy (comparing fst) $
|
|
unionBy (\(a,_) (a',_) -> a == a') postedacctchanges zeroes
|
|
| postedacctchanges <- colacctchangesmaybevalued]
|
|
where zeroes = [(a, nullmixedamt) | a <- displayaccts]
|
|
-- Transpose to get each account's balance changes across all columns.
|
|
acctchanges :: [(ClippedAccountName, [MixedAmount])] =
|
|
dbg1 "acctchanges"
|
|
[(a, map snd abs) | abs@((a,_):_) <- transpose colallacctchanges] -- never null, or used when null...
|
|
|
|
----------------------------------------------------------------------
|
|
-- 7. Build the report rows.
|
|
|
|
-- One row per account, with account name info, column amounts, row total and row average.
|
|
-- Calculate them two ways: unvalued for calculating column/grand totals, and valued for display.
|
|
rows :: [MultiBalanceReportRow] =
|
|
dbg1 "rows" $
|
|
[(a, accountLeafName a, accountNameLevel a, unvaluedbals, rowtot, rowavg)
|
|
| (a,changes) <- acctchanges
|
|
-- The amounts to be displayed (period changes, cumulative totals, or historical balances).
|
|
, let unvaluedbals = case balancetype_ of
|
|
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes
|
|
CumulativeChange -> drop 1 $ scanl (+) 0 changes
|
|
_ -> changes
|
|
-- The total and average for the row.
|
|
, let rowtot = if balancetype_==PeriodChange then sum unvaluedbals else 0
|
|
, let rowavg = averageMixedAmounts unvaluedbals
|
|
, empty_ || depth == 0 || any (not . isZeroMixedAmount) unvaluedbals
|
|
]
|
|
rowsvalued :: [MultiBalanceReportRow] =
|
|
dbg1 "rowsvalued" $
|
|
[(a, accountLeafName a, accountNameLevel a, valuedbals, valuedrowtot, valuedrowavg)
|
|
| (a,changes) <- acctchanges
|
|
-- The amounts to be displayed (period changes, cumulative totals, or historical balances).
|
|
, let unvaluedbals = case balancetype_ of
|
|
HistoricalBalance -> drop 1 $ scanl (+) (startingBalanceFor a) changes
|
|
CumulativeChange -> drop 1 $ scanl (+) 0 changes
|
|
_ -> changes
|
|
-- The amounts valued according to --value-at, if needed.
|
|
, let valuedbals1 = case balancetype_ of
|
|
HistoricalBalance -> drop 1 $ scanl (+) (valuedStartingBalanceFor a) changes
|
|
CumulativeChange -> drop 1 $ scanl (+) 0 changes
|
|
_ -> changes
|
|
, let valuedbals = case value_ of
|
|
Just (AtCost _mc) -> valuedbals1
|
|
Just (AtEnd _mc) -> [mixedAmountValue prices periodlastday amt | (amt,periodlastday) <- zip unvaluedbals lastdays]
|
|
Just (AtNow _mc) -> [mixedAmountValue prices today amt | amt <- valuedbals1]
|
|
Just (AtDate d _mc) -> [mixedAmountValue prices d amt | amt <- valuedbals1]
|
|
_ -> unvaluedbals --value-at=transaction was handled earlier
|
|
-- The total and average for the row, and their values.
|
|
, let rowtot = if balancetype_==PeriodChange then sum unvaluedbals else 0
|
|
, let rowavg = averageMixedAmounts unvaluedbals
|
|
, let valuedrowtot = case value_ of
|
|
Just (AtEnd _mc) -> mixedAmountValue prices reportlastday rowtot
|
|
Just (AtNow _mc) -> mixedAmountValue prices today rowtot
|
|
Just (AtDate d _mc) -> mixedAmountValue prices d rowtot
|
|
_ -> rowtot
|
|
, let valuedrowavg = case value_ of
|
|
Just (AtEnd _mc) -> mixedAmountValue prices reportlastday rowavg
|
|
Just (AtNow _mc) -> mixedAmountValue prices today rowavg
|
|
Just (AtDate d _mc) -> mixedAmountValue prices d rowavg
|
|
_ -> rowavg
|
|
, empty_ || depth == 0 || any (not . isZeroMixedAmount) valuedbals
|
|
]
|
|
|
|
----------------------------------------------------------------------
|
|
-- 8. Sort the report rows.
|
|
|
|
-- Sort the rows by amount or by account declaration order. This is a bit tricky.
|
|
-- TODO: is it always ok to sort report rows after report has been generated, as a separate step ?
|
|
sortedrowsvalued :: [MultiBalanceReportRow] =
|
|
dbg1 "sortedrowsvalued" $
|
|
sortrows rowsvalued
|
|
where
|
|
sortrows
|
|
| sort_amount_ && accountlistmode_ == ALTree = sortTreeMBRByAmount
|
|
| sort_amount_ = sortFlatMBRByAmount
|
|
| otherwise = sortMBRByAccountDeclaration
|
|
where
|
|
-- Sort the report rows, representing a tree of accounts, by row total at each level.
|
|
-- Similar to sortMBRByAccountDeclaration/sortAccountNamesByDeclaration.
|
|
sortTreeMBRByAmount rows = sortedrows
|
|
where
|
|
anamesandrows = [(first6 r, r) | r <- rows]
|
|
anames = map fst anamesandrows
|
|
atotals = [(a,tot) | (a,_,_,_,tot,_) <- rows]
|
|
accounttree = accountTree "root" anames
|
|
accounttreewithbals = mapAccounts setibalance accounttree
|
|
where
|
|
-- should not happen, but it's dangerous; TODO
|
|
setibalance a = a{aibalance=fromMaybe (error "sortTreeMBRByAmount 1") $ lookup (aname a) atotals}
|
|
sortedaccounttree = sortAccountTreeByAmount (fromMaybe NormallyPositive normalbalance_) accounttreewithbals
|
|
sortedanames = map aname $ drop 1 $ flattenAccounts sortedaccounttree
|
|
sortedrows = sortAccountItemsLike sortedanames anamesandrows
|
|
|
|
-- Sort the report rows, representing a flat account list, by row total.
|
|
sortFlatMBRByAmount = sortBy (maybeflip $ comparing (normaliseMixedAmountSquashPricesForDisplay . fifth6))
|
|
where
|
|
maybeflip = if normalbalance_ == Just NormallyNegative then id else flip
|
|
|
|
-- Sort the report rows by account declaration order then account name.
|
|
sortMBRByAccountDeclaration rows = sortedrows
|
|
where
|
|
anamesandrows = [(first6 r, r) | r <- rows]
|
|
anames = map fst anamesandrows
|
|
sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
|
|
sortedrows = sortAccountItemsLike sortedanames anamesandrows
|
|
|
|
----------------------------------------------------------------------
|
|
-- 9. Build the report totals row.
|
|
|
|
-- Calculate and maybe value the column totals.
|
|
highestlevelaccts = [a | a <- displayaccts, not $ any (`elem` displayaccts) $ init $ expandAccountName a]
|
|
colamts = transpose [bs | (a,_,_,bs,_,_) <- rows , not (tree_ ropts) || a `elem` highestlevelaccts]
|
|
colamtsvalued = transpose [bs | (a,_,_,bs,_,_) <- rowsvalued, not (tree_ ropts) || a `elem` highestlevelaccts]
|
|
coltotals :: [MixedAmount] =
|
|
dbg1 "coltotals" $
|
|
case value_ of
|
|
Nothing -> map sum colamts
|
|
Just (AtCost _mc) -> map sum colamtsvalued
|
|
Just (AtEnd _mc) -> map (\(amts,periodlastday) -> maybevalue periodlastday $ sum amts) $ zip colamts lastdays
|
|
Just (AtNow _mc) -> map (maybevalue today . sum) colamts
|
|
Just (AtDate d _mc) -> map (maybevalue d . sum) colamts
|
|
-- Calculate and maybe value the grand total and average.
|
|
[grandtotal,grandaverage] =
|
|
let amts = map ($ map sum colamts)
|
|
[if balancetype_==PeriodChange then sum else const 0
|
|
,averageMixedAmounts
|
|
]
|
|
in case value_ of
|
|
Nothing -> amts
|
|
Just (AtCost _mc) -> amts
|
|
Just (AtEnd _mc) -> map (maybevalue reportlastday) amts
|
|
Just (AtNow _mc) -> map (maybevalue today) amts
|
|
Just (AtDate d _mc) -> map (maybevalue d) amts
|
|
-- Totals row.
|
|
totalsrow :: MultiBalanceReportTotals =
|
|
dbg1 "totalsrow" (coltotals, grandtotal, grandaverage)
|
|
|
|
-- | Given a MultiBalanceReport and its normal balance sign,
|
|
-- if it is known to be normally negative, convert it to normally positive.
|
|
mbrNormaliseSign :: NormalSign -> MultiBalanceReport -> MultiBalanceReport
|
|
mbrNormaliseSign NormallyNegative = mbrNegate
|
|
mbrNormaliseSign _ = id
|
|
|
|
-- | Flip the sign of all amounts in a MultiBalanceReport.
|
|
mbrNegate (MultiBalanceReport (colspans, rows, totalsrow)) =
|
|
MultiBalanceReport (colspans, map mbrRowNegate rows, mbrTotalsRowNegate totalsrow)
|
|
where
|
|
mbrRowNegate (acct,shortacct,indent,amts,tot,avg) = (acct,shortacct,indent,map negate amts,-tot,-avg)
|
|
mbrTotalsRowNegate (amts,tot,avg) = (map negate amts,-tot,-avg)
|
|
|
|
-- | Figure out the overall date span of a multicolumn balance report.
|
|
multiBalanceReportSpan :: MultiBalanceReport -> DateSpan
|
|
multiBalanceReportSpan (MultiBalanceReport ([], _, _)) = DateSpan Nothing Nothing
|
|
multiBalanceReportSpan (MultiBalanceReport (colspans, _, _)) = DateSpan (spanStart $ head colspans) (spanEnd $ last colspans)
|
|
|
|
-- | 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
|
|
-- (see ReportOpts and CompoundBalanceCommand).
|
|
balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal -> BalanceReport
|
|
balanceReportFromMultiBalanceReport opts q j = (rows', total)
|
|
where
|
|
MultiBalanceReport (_, rows, (totals, _, _)) = multiBalanceReport opts q j
|
|
rows' = [(a
|
|
,if flat_ opts then a else a' -- BalanceReport expects full account name here with --flat
|
|
,if tree_ opts then d-1 else 0 -- BalanceReport uses 0-based account depths
|
|
, headDef nullmixedamt amts -- 0 columns is illegal, should not happen, return zeroes if it does
|
|
) | (a,a',d, amts, _, _) <- rows]
|
|
total = headDef nullmixedamt totals
|
|
|
|
|
|
-- common rendering helper, XXX here for now
|
|
|
|
tableAsText :: ReportOpts -> (a -> String) -> Table String String a -> String
|
|
tableAsText (ReportOpts{pretty_tables_ = pretty}) showcell =
|
|
unlines
|
|
. trimborder
|
|
. lines
|
|
. render pretty id id showcell
|
|
. align
|
|
where
|
|
trimborder = drop 1 . init . map (drop 1 . init)
|
|
align (Table l t d) = Table l' t d
|
|
where
|
|
acctswidth = maximum' $ map strWidth (headerContents l)
|
|
l' = padRightWide acctswidth <$> l
|
|
|
|
-- tests
|
|
|
|
tests_MultiBalanceReports = tests "MultiBalanceReports" [
|
|
let
|
|
(opts,journal) `gives` r = do
|
|
let (eitems, etotal) = r
|
|
(MultiBalanceReport (_, aitems, atotal)) = multiBalanceReport opts (queryFromOpts nulldate opts) journal
|
|
showw (acct,acct',indent,lAmt,amt,amt') = (acct, acct', indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
|
|
(map showw aitems) `is` (map showw eitems)
|
|
((\(_, b, _) -> showMixedAmountDebug b) atotal) `is` (showMixedAmountDebug etotal) -- we only check the sum of the totals
|
|
usd0 = usd 0
|
|
amount0 = Amount {acommodity="$", aquantity=0, aprice=NoPrice, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asprecision = 2, asdecimalpoint = Just '.', asdigitgroups = Nothing}, aismultiplier=False}
|
|
in
|
|
tests "multiBalanceReport" [
|
|
test "null journal" $
|
|
(defreportopts, nulljournal) `gives` ([], Mixed [nullamt])
|
|
|
|
,test "with -H on a populated period" $
|
|
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
|
|
(
|
|
[
|
|
("assets:bank:checking", "checking", 3, [mamountp' "$1.00"] , Mixed [nullamt], Mixed [amount0 {aquantity=1}])
|
|
,("income:salary" ,"salary" , 2, [mamountp' "$-1.00"], Mixed [nullamt], Mixed [amount0 {aquantity=(-1)}])
|
|
],
|
|
Mixed [nullamt])
|
|
|
|
,_test "a valid history on an empty period" $
|
|
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 2) (fromGregorian 2008 1 3), balancetype_=HistoricalBalance}, samplejournal) `gives`
|
|
(
|
|
[
|
|
("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
|
|
,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
|
|
],
|
|
Mixed [usd0])
|
|
|
|
,_test "a valid history on an empty period (more complex)" $
|
|
(defreportopts{period_= PeriodBetween (fromGregorian 2009 1 1) (fromGregorian 2009 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
|
|
(
|
|
[
|
|
("assets:bank:checking","checking",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
|
|
,("assets:bank:saving","saving",3, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=1}])
|
|
,("assets:cash","cash",2, [mamountp' "$-2.00"], mamountp' "$-2.00",Mixed [amount0 {aquantity=(-2)}])
|
|
,("expenses:food","food",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
|
|
,("expenses:supplies","supplies",2, [mamountp' "$1.00"], mamountp' "$1.00",Mixed [amount0 {aquantity=(1)}])
|
|
,("income:gifts","gifts",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
|
|
,("income:salary","salary",2, [mamountp' "$-1.00"], mamountp' "$-1.00",Mixed [amount0 {aquantity=(-1)}])
|
|
],
|
|
Mixed [usd0])
|
|
]
|
|
]
|