multibalanceReport: Move responsibility for determining displayed name in multiBalanceReportWith, not at point of consumption.
This commit is contained in:
Stephen Morgan
parent
0dedcfbe15
commit
5f0918217a
@ -47,8 +47,8 @@ type BudgetAverage = Average
|
||||
|
||||
-- | A budget report tracks expected and actual changes per account and subperiod.
|
||||
type BudgetCell = (Maybe Change, Maybe BudgetGoal)
|
||||
type BudgetReport = PeriodicReport AccountName BudgetCell
|
||||
type BudgetReportRow = PeriodicReportRow AccountName BudgetCell
|
||||
type BudgetReport = PeriodicReport DisplayName BudgetCell
|
||||
type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell
|
||||
|
||||
-- | Calculate budget goals from all periodic transactions,
|
||||
-- actual balance changes from the regular transactions,
|
||||
@ -99,9 +99,9 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte
|
||||
sortTreeBURByActualAmount :: [BudgetReportRow] -> [BudgetReportRow]
|
||||
sortTreeBURByActualAmount rows = sortedrows
|
||||
where
|
||||
anamesandrows = [(prrName r, r) | r <- rows]
|
||||
anamesandrows = [(prrFullName r, r) | r <- rows]
|
||||
anames = map fst anamesandrows
|
||||
atotals = [(a, tot) | PeriodicReportRow a _ _ (tot,_) _ <- rows]
|
||||
atotals = [(displayFull a, tot) | PeriodicReportRow a _ (tot,_) _ <- rows]
|
||||
accounttree = accountTree "root" anames
|
||||
accounttreewithbals = mapAccounts setibalance accounttree
|
||||
where
|
||||
@ -124,8 +124,8 @@ sortBudgetReport ropts j (PeriodicReport ps rows trow) = PeriodicReport ps sorte
|
||||
-- <unbudgeted> remains at the top.
|
||||
sortByAccountDeclaration rows = sortedrows
|
||||
where
|
||||
(unbudgetedrow,rows') = partition ((=="<unbudgeted>") . prrName) rows
|
||||
anamesandrows = [(prrName r, r) | r <- rows']
|
||||
(unbudgetedrow,rows') = partition ((==unbudgetedAccountName) . prrFullName) rows
|
||||
anamesandrows = [(prrFullName r, r) | r <- rows']
|
||||
anames = map fst anamesandrows
|
||||
sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
|
||||
sortedrows = unbudgetedrow ++ sortAccountItemsLike sortedanames anamesandrows
|
||||
@ -189,17 +189,17 @@ budgetRollUp budgetedaccts showunbudgeted j = j { jtxns = remapTxn <$> jtxns j }
|
||||
--
|
||||
combineBudgetAndActual :: MultiBalanceReport -> MultiBalanceReport -> BudgetReport
|
||||
combineBudgetAndActual
|
||||
(PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ _ budgettots budgetgrandtot budgetgrandavg))
|
||||
(PeriodicReport actualperiods actualrows (PeriodicReportRow _ _ actualtots actualgrandtot actualgrandavg)) =
|
||||
(PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg))
|
||||
(PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) =
|
||||
PeriodicReport periods rows totalrow
|
||||
where
|
||||
periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods
|
||||
|
||||
-- first, combine any corresponding budget goals with actual changes
|
||||
rows1 =
|
||||
[ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal
|
||||
| PeriodicReportRow acct treeindent actualamts actualtot actualavg <- actualrows
|
||||
, let mbudgetgoals = Map.lookup acct budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
|
||||
[ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal
|
||||
| PeriodicReportRow acct actualamts actualtot actualavg <- actualrows
|
||||
, let mbudgetgoals = Map.lookup (displayFull acct) budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
|
||||
, let budgetmamts = maybe (replicate (length periods) Nothing) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal]
|
||||
, let mbudgettot = second3 <$> mbudgetgoals :: Maybe BudgetTotal
|
||||
, let mbudgetavg = third3 <$> mbudgetgoals :: Maybe BudgetAverage
|
||||
@ -211,14 +211,14 @@ combineBudgetAndActual
|
||||
]
|
||||
where
|
||||
budgetGoalsByAcct :: Map AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
|
||||
Map.fromList [ (acct, (amts, tot, avg))
|
||||
| PeriodicReportRow acct _ amts tot avg <- budgetrows ]
|
||||
Map.fromList [ (displayFull acct, (amts, tot, avg))
|
||||
| PeriodicReportRow acct amts tot avg <- budgetrows ]
|
||||
|
||||
-- next, make rows for budget goals with no actual changes
|
||||
rows2 =
|
||||
[ PeriodicReportRow acct treeindent amtandgoals totamtandgoal avgamtandgoal
|
||||
| PeriodicReportRow acct treeindent budgetgoals budgettot budgetavg <- budgetrows
|
||||
, acct `notElem` map prrName rows1
|
||||
[ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal
|
||||
| PeriodicReportRow acct budgetgoals budgettot budgetavg <- budgetrows
|
||||
, displayFull acct `notElem` map prrFullName rows1
|
||||
, let acctBudgetByPeriod = Map.fromList $ zip budgetperiods budgetgoals :: Map DateSpan BudgetGoal
|
||||
, let amtandgoals = [ (Nothing, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell]
|
||||
, let totamtandgoal = (Nothing, Just budgettot)
|
||||
@ -230,10 +230,10 @@ combineBudgetAndActual
|
||||
-- TODO: respect --sort-amount
|
||||
-- TODO: add --sort-budget to sort by budget goal amount
|
||||
rows :: [BudgetReportRow] =
|
||||
sortOn prrName $ rows1 ++ rows2
|
||||
sortOn prrFullName $ rows1 ++ rows2
|
||||
|
||||
-- TODO: grand total & average shows 0% when there are no actual amounts, inconsistent with other cells
|
||||
totalrow = PeriodicReportRow () 0
|
||||
totalrow = PeriodicReportRow ()
|
||||
[ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ]
|
||||
( Just actualgrandtot, Just budgetgrandtot )
|
||||
( Just actualgrandavg, Just budgetgrandavg )
|
||||
@ -311,7 +311,7 @@ budgetReportAsText ropts@ReportOpts{..} budgetr =
|
||||
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table String String (Maybe MixedAmount, Maybe MixedAmount)
|
||||
budgetReportAsTable
|
||||
ropts
|
||||
(PeriodicReport periods rows (PeriodicReportRow _ _ coltots grandtot grandavg)) =
|
||||
(PeriodicReport periods rows (PeriodicReportRow _ coltots grandtot grandavg)) =
|
||||
addtotalrow $
|
||||
Table
|
||||
(T.Group NoLine $ map Header accts)
|
||||
@ -322,10 +322,13 @@ budgetReportAsTable
|
||||
++ [" Total" | row_total_ ropts]
|
||||
++ ["Average" | average_ ropts]
|
||||
accts = map renderacct rows
|
||||
renderacct (PeriodicReportRow a i _ _ _)
|
||||
| tree_ ropts = replicate ((i-1)*2) ' ' ++ T.unpack (accountLeafName a)
|
||||
| otherwise = T.unpack $ maybeAccountNameDrop ropts a
|
||||
rowvals (PeriodicReportRow _ _ as rowtot rowavg) =
|
||||
-- FIXME. Have to check explicitly for which to render here, since
|
||||
-- budgetReport sets accountlistmode to ALTree. Find a principled way to do
|
||||
-- this.
|
||||
renderacct row
|
||||
| tree_ ropts = replicate ((prrDepth row - 1)*2) ' ' ++ T.unpack (prrDisplayName row)
|
||||
| otherwise = T.unpack . maybeAccountNameDrop ropts $ prrFullName row
|
||||
rowvals (PeriodicReportRow _ as rowtot rowavg) =
|
||||
as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts]
|
||||
addtotalrow
|
||||
| no_total_ ropts = id
|
||||
|
||||
@ -50,9 +50,7 @@ import Hledger.Reports.ReportTypes
|
||||
--
|
||||
-- 2. a list of rows, each containing:
|
||||
--
|
||||
-- * the full account name
|
||||
--
|
||||
-- * the account's depth
|
||||
-- * the full account name, display name, and display depth
|
||||
--
|
||||
-- * A list of amounts, one for each column.
|
||||
--
|
||||
@ -63,8 +61,8 @@ import Hledger.Reports.ReportTypes
|
||||
-- 3. the column totals, and the overall grand total (or zero for
|
||||
-- cumulative/historical reports) and grand average.
|
||||
|
||||
type MultiBalanceReport = PeriodicReport AccountName MixedAmount
|
||||
type MultiBalanceReportRow = PeriodicReportRow AccountName MixedAmount
|
||||
type MultiBalanceReport = PeriodicReport DisplayName MixedAmount
|
||||
type MultiBalanceReportRow = PeriodicReportRow DisplayName MixedAmount
|
||||
|
||||
-- type alias just to remind us which AccountNames might be depth-clipped, below.
|
||||
type ClippedAccountName = AccountName
|
||||
@ -78,7 +76,7 @@ type ClippedAccountName = AccountName
|
||||
-- command (in multiperiod mode) and (via multiBalanceReport') by the bs/cf/is commands.
|
||||
multiBalanceReport :: Day -> ReportOpts -> Journal -> MultiBalanceReport
|
||||
multiBalanceReport today ropts j =
|
||||
multiBalanceReportWith ropts q j (journalPriceOracle infer j)
|
||||
multiBalanceReportWith ropts q j (journalPriceOracle infer j)
|
||||
where
|
||||
q = queryFromOpts today ropts
|
||||
infer = infer_value_ ropts
|
||||
@ -93,46 +91,55 @@ multiBalanceReportWith :: ReportOpts -> Query -> Journal -> PriceOracle -> Multi
|
||||
multiBalanceReportWith ropts@ReportOpts{..} q j priceoracle = report
|
||||
where
|
||||
-- Queries, report/column dates.
|
||||
reportspan = dbg "reportspan" $ calculateReportSpan ropts q j
|
||||
reportq = dbg "reportq" $ makeReportQuery ropts reportspan q
|
||||
ropts' = dbg "ropts'" $ setDefaultAccountListMode ALFlat ropts
|
||||
reportspan = dbg "reportspan" $ calculateReportSpan ropts' q j
|
||||
reportq = dbg "reportq" $ makeReportQuery ropts' reportspan q
|
||||
|
||||
-- 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.
|
||||
startbals = dbg' "startbals" $ startingBalances ropts reportq j reportspan
|
||||
startbals = dbg' "startbals" $ startingBalances ropts' reportq j reportspan
|
||||
|
||||
-- Postings matching the query within the report period.
|
||||
ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts reportq j
|
||||
ps :: [(Posting, Day)] = dbg'' "ps" $ getPostings ropts' reportq j
|
||||
days = map snd ps
|
||||
|
||||
-- The date spans to be included as report columns.
|
||||
colspans = dbg "colspans" $ calculateColSpans ropts reportspan days
|
||||
colspans = dbg "colspans" $ calculateColSpans ropts' reportspan days
|
||||
|
||||
-- Group postings into their columns.
|
||||
colps = dbg'' "colps" $ calculateColumns colspans ps
|
||||
|
||||
-- Each account's balance changes across all columns.
|
||||
acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts q startbals colps
|
||||
acctchanges = dbg'' "acctchanges" $ calculateAccountChanges ropts' q startbals colps
|
||||
|
||||
-- Process changes into normal, cumulative, or historical amounts, plus value them
|
||||
accumvalued = dbg'' "accumvalued" $ accumValueAmounts ropts j priceoracle colspans startbals acctchanges
|
||||
accumvalued = dbg'' "accumvalued" $ accumValueAmounts ropts' j priceoracle colspans startbals acctchanges
|
||||
|
||||
-- All account names that will be displayed, possibly depth-clipped.
|
||||
displayaccts = dbg'' "displayaccts" $ displayedAccounts ropts q accumvalued
|
||||
displayaccts = dbg'' "displayaccts" $ displayedAccounts ropts' q accumvalued
|
||||
|
||||
-- All the rows of the report.
|
||||
rows = dbg'' "rows" $ buildReportRows ropts reportq accumvalued
|
||||
rows = dbg'' "rows" $ buildReportRows ropts' reportq accumvalued
|
||||
|
||||
-- Sorted report rows.
|
||||
sortedrows = dbg' "sortedrows" $ sortRows ropts j rows
|
||||
sortedrows = dbg' "sortedrows" $ sortRows ropts' j rows
|
||||
|
||||
-- Calculate column totals
|
||||
totalsrow = dbg' "totalsrow" $ calculateTotalsRow ropts displayaccts sortedrows
|
||||
totalsrow = dbg' "totalsrow" $ calculateTotalsRow ropts' displayaccts sortedrows
|
||||
|
||||
-- Postprocess the report, negating balances and taking percentages if needed
|
||||
report = dbg' "report" . postprocessReport ropts $
|
||||
report = dbg' "report" . postprocessReport ropts' $
|
||||
PeriodicReport colspans sortedrows totalsrow
|
||||
|
||||
|
||||
-- | Calculate the span of the report to be generated.
|
||||
setDefaultAccountListMode :: AccountListMode -> ReportOpts -> ReportOpts
|
||||
setDefaultAccountListMode def ropts = ropts{accountlistmode_=mode}
|
||||
where
|
||||
mode = case accountlistmode_ ropts of
|
||||
ALDefault -> def
|
||||
a -> a
|
||||
|
||||
-- | Calculate the span of the report to be generated.
|
||||
calculateReportSpan :: ReportOpts -> Query -> Journal -> DateSpan
|
||||
calculateReportSpan ropts q j = reportspan
|
||||
@ -312,7 +319,7 @@ buildReportRows :: ReportOpts -> Query
|
||||
-> HashMap AccountName [Account]
|
||||
-> [MultiBalanceReportRow]
|
||||
buildReportRows ropts q acctvalues =
|
||||
[ PeriodicReportRow a (accountNameLevel a) rowbals rowtot rowavg
|
||||
[ PeriodicReportRow (name a) rowbals rowtot rowavg
|
||||
| (a,accts) <- HM.toList acctvalues
|
||||
, let rowbals = map balance accts
|
||||
-- The total and average for the row.
|
||||
@ -323,6 +330,7 @@ buildReportRows ropts q acctvalues =
|
||||
, empty_ ropts || queryDepth q == 0 || any (not . mixedAmountLooksZero) rowbals -- TODO: Remove this eventually, to be handled elswhere
|
||||
]
|
||||
where
|
||||
name = if tree_ ropts then treeDisplayName else flatDisplayName
|
||||
balance = if tree_ ropts then aibalance else aebalance
|
||||
|
||||
-- | Calculate accounts which are to be displayed in the report, as well as
|
||||
@ -363,9 +371,9 @@ sortRows ropts j
|
||||
sortTreeMBRByAmount :: [MultiBalanceReportRow] -> [MultiBalanceReportRow]
|
||||
sortTreeMBRByAmount rows = sortedrows
|
||||
where
|
||||
anamesandrows = [(prrName r, r) | r <- rows]
|
||||
anamesandrows = [(prrFullName r, r) | r <- rows]
|
||||
anames = map fst anamesandrows
|
||||
atotals = [(prrName r, prrTotal r) | r <- rows]
|
||||
atotals = [(prrFullName r, prrTotal r) | r <- rows]
|
||||
accounttree = accountTree "root" anames
|
||||
accounttreewithbals = mapAccounts setibalance accounttree
|
||||
where
|
||||
@ -383,7 +391,7 @@ sortRows ropts j
|
||||
-- Sort the report rows by account declaration order then account name.
|
||||
sortMBRByAccountDeclaration rows = sortedrows
|
||||
where
|
||||
anamesandrows = [(prrName r, r) | r <- rows]
|
||||
anamesandrows = [(prrFullName r, r) | r <- rows]
|
||||
anames = map fst anamesandrows
|
||||
sortedanames = sortAccountNamesByDeclaration j (tree_ ropts) anames
|
||||
sortedrows = sortAccountItemsLike sortedanames anamesandrows
|
||||
@ -394,13 +402,13 @@ sortRows ropts j
|
||||
calculateTotalsRow :: ReportOpts -> HashMap ClippedAccountName (ClippedAccountName, Int)
|
||||
-> [MultiBalanceReportRow] -> PeriodicReportRow () MixedAmount
|
||||
calculateTotalsRow ropts displayaccts rows =
|
||||
PeriodicReportRow () 0 coltotals grandtotal grandaverage
|
||||
PeriodicReportRow () coltotals grandtotal grandaverage
|
||||
where
|
||||
highestlevelaccts = HM.filterWithKey (\a _ -> isHighest a) displayaccts
|
||||
where isHighest = not . any (`HM.member` displayaccts) . init . expandAccountName
|
||||
|
||||
colamts = transpose . map prrAmounts $ filter isHighest rows
|
||||
where isHighest row = not (tree_ ropts) || prrName row `HM.member` highestlevelaccts
|
||||
where isHighest row = not (tree_ ropts) || prrFullName row `HM.member` highestlevelaccts
|
||||
|
||||
-- TODO: If colamts is null, then this is empty. Do we want it to be a full
|
||||
-- column of zeros?
|
||||
@ -418,8 +426,8 @@ postprocessReport ropts (PeriodicReport spans rows totalrow) =
|
||||
where
|
||||
maybeInvert = if invert_ ropts then prNegate else id
|
||||
percentage = if not (percent_ ropts) then id else \case
|
||||
PeriodicReportRow name d rowvals rowtotal rowavg ->
|
||||
PeriodicReportRow name d
|
||||
PeriodicReportRow name rowvals rowtotal rowavg ->
|
||||
PeriodicReportRow name
|
||||
(zipWith perdivide rowvals $ prrAmounts totalrow)
|
||||
(perdivide rowtotal $ prrTotal totalrow)
|
||||
(perdivide rowavg $ prrAverage totalrow)
|
||||
@ -431,16 +439,17 @@ postprocessReport ropts (PeriodicReport spans rows totalrow) =
|
||||
-- (see ReportOpts and CompoundBalanceCommand).
|
||||
balanceReportFromMultiBalanceReport :: ReportOpts -> Query -> Journal
|
||||
-> ([(AccountName, AccountName, Int, MixedAmount)], MixedAmount)
|
||||
balanceReportFromMultiBalanceReport opts q j = (rows', total)
|
||||
balanceReportFromMultiBalanceReport ropts q j = (rows', total)
|
||||
where
|
||||
PeriodicReport _ rows (PeriodicReportRow _ _ totals _ _) =
|
||||
multiBalanceReportWith opts q j (journalPriceOracle (infer_value_ opts) j)
|
||||
rows' = [( a
|
||||
, if flat_ opts then a else accountLeafName a -- BalanceReport expects full account name here with --flat
|
||||
, if tree_ opts then d-1 else 0 -- BalanceReport uses 0-based account depths
|
||||
PeriodicReport _ rows (PeriodicReportRow _ totals _ _) =
|
||||
multiBalanceReportWith ropts q j (journalPriceOracle (infer_value_ ropts) j)
|
||||
rows' = [( displayFull a
|
||||
, leafName a
|
||||
, if tree_ ropts then displayDepth a - 1 else 0 -- BalanceReport uses 0-based account depths
|
||||
, headDef nullmixedamt amts -- 0 columns is illegal, should not happen, return zeroes if it does
|
||||
) | PeriodicReportRow a d amts _ _ <- rows]
|
||||
) | PeriodicReportRow a amts _ _ <- rows]
|
||||
total = headDef nullmixedamt totals
|
||||
leafName = if flat_ ropts then displayFull else displayName -- BalanceReport expects full account name here with --flat
|
||||
|
||||
|
||||
-- | Transpose a Map of HashMaps to a HashMap of Maps.
|
||||
@ -519,8 +528,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
(opts,journal) `gives` r = do
|
||||
let (eitems, etotal) = r
|
||||
(PeriodicReport _ aitems atotal) = multiBalanceReport nulldate opts journal
|
||||
showw (PeriodicReportRow acct indent lAmt amt amt')
|
||||
= (acct, accountLeafName acct, indent, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
|
||||
showw (PeriodicReportRow a lAmt amt amt')
|
||||
= (displayFull a, displayName a, displayDepth a, map showMixedAmountDebug lAmt, showMixedAmountDebug amt, showMixedAmountDebug amt')
|
||||
(map showw aitems) @?= (map showw eitems)
|
||||
showMixedAmountDebug (prrTotal atotal) @?= showMixedAmountDebug etotal -- we only check the sum of the totals
|
||||
in
|
||||
@ -531,8 +540,8 @@ tests_MultiBalanceReport = tests "MultiBalanceReport" [
|
||||
,test "with -H on a populated period" $
|
||||
(defreportopts{period_= PeriodBetween (fromGregorian 2008 1 1) (fromGregorian 2008 1 2), balancetype_=HistoricalBalance}, samplejournal) `gives`
|
||||
(
|
||||
[ PeriodicReportRow "assets:bank:checking" 3 [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}])
|
||||
, PeriodicReportRow "income:salary" 2 [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}])
|
||||
[ PeriodicReportRow (flatDisplayName "assets:bank:checking") [mamountp' "$1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=1}])
|
||||
, PeriodicReportRow (flatDisplayName "income:salary") [mamountp' "$-1.00"] (Mixed [nullamt]) (Mixed [amt0 {aquantity=(-1)}])
|
||||
],
|
||||
Mixed [nullamt])
|
||||
|
||||
|
||||
@ -17,10 +17,22 @@ module Hledger.Reports.ReportTypes
|
||||
, periodicReportSpan
|
||||
, prNegate
|
||||
, prNormaliseSign
|
||||
|
||||
, prMapName
|
||||
, prMapMaybeName
|
||||
|
||||
, DisplayName(..)
|
||||
, flatDisplayName
|
||||
, treeDisplayName
|
||||
|
||||
, prrFullName
|
||||
, prrDisplayName
|
||||
, prrDepth
|
||||
) where
|
||||
|
||||
import Data.Aeson
|
||||
import Data.Decimal
|
||||
import Data.Maybe (mapMaybe)
|
||||
import GHC.Generics (Generic)
|
||||
import Hledger.Data
|
||||
|
||||
@ -72,7 +84,6 @@ data PeriodicReport a b =
|
||||
data PeriodicReportRow a b =
|
||||
PeriodicReportRow
|
||||
{ prrName :: a -- An account name.
|
||||
, prrDepth :: Int -- Indent level for displaying this account name in tree mode. 0, 1, 2...
|
||||
, prrAmounts :: [b] -- The data value for each subperiod.
|
||||
, prrTotal :: b -- The total of this row's values.
|
||||
, prrAverage :: b -- The average of this row's values.
|
||||
@ -94,5 +105,57 @@ prNegate :: Num b => PeriodicReport a b -> PeriodicReport a b
|
||||
prNegate (PeriodicReport colspans rows totalsrow) =
|
||||
PeriodicReport colspans (map rowNegate rows) (rowNegate totalsrow)
|
||||
where
|
||||
rowNegate (PeriodicReportRow name indent amts tot avg) =
|
||||
PeriodicReportRow name indent (map negate amts) (-tot) (-avg)
|
||||
rowNegate (PeriodicReportRow name amts tot avg) =
|
||||
PeriodicReportRow name (map negate amts) (-tot) (-avg)
|
||||
|
||||
-- | Map a function over the row names.
|
||||
prMapName :: (a -> b) -> PeriodicReport a c -> PeriodicReport b c
|
||||
prMapName f report = report{prRows = map (prrMapName f) $ prRows report}
|
||||
|
||||
-- | Map a function over the row names, possibly discarding some.
|
||||
prMapMaybeName :: (a -> Maybe b) -> PeriodicReport a c -> PeriodicReport b c
|
||||
prMapMaybeName f report = report{prRows = mapMaybe (prrMapMaybeName f) $ prRows report}
|
||||
|
||||
-- | Map a function over the row names of the PeriodicReportRow.
|
||||
prrMapName :: (a -> b) -> PeriodicReportRow a c -> PeriodicReportRow b c
|
||||
prrMapName f row = row{prrName = f $ prrName row}
|
||||
|
||||
-- | Map maybe a function over the row names of the PeriodicReportRow.
|
||||
prrMapMaybeName :: (a -> Maybe b) -> PeriodicReportRow a c -> Maybe (PeriodicReportRow b c)
|
||||
prrMapMaybeName f row = case f $ prrName row of
|
||||
Nothing -> Nothing
|
||||
Just a -> Just row{prrName = a}
|
||||
|
||||
|
||||
-- | A full name, display name, and depth for an account.
|
||||
data DisplayName = DisplayName
|
||||
{ displayFull :: AccountName
|
||||
, displayName :: AccountName
|
||||
, displayDepth :: Int
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
instance ToJSON DisplayName where
|
||||
toJSON = toJSON . displayFull
|
||||
toEncoding = toEncoding . displayFull
|
||||
|
||||
-- | Construct a flat display name, where the full name is also displayed at
|
||||
-- depth 0
|
||||
flatDisplayName :: AccountName -> DisplayName
|
||||
flatDisplayName a = DisplayName a a 0
|
||||
|
||||
-- | Construct a tree display name, where only the leaf is displayed at its
|
||||
-- given depth
|
||||
treeDisplayName :: AccountName -> DisplayName
|
||||
treeDisplayName a = DisplayName a (accountLeafName a) (accountNameLevel a)
|
||||
-- | Get the full, canonical, name of a PeriodicReportRow tagged by a
|
||||
-- DisplayName.
|
||||
prrFullName :: PeriodicReportRow DisplayName a -> AccountName
|
||||
prrFullName = displayFull . prrName
|
||||
|
||||
-- | Get the display name of a PeriodicReportRow tagged by a DisplayName.
|
||||
prrDisplayName :: PeriodicReportRow DisplayName a -> AccountName
|
||||
prrDisplayName = displayName . prrName
|
||||
|
||||
-- | Get the display depth of a PeriodicReportRow tagged by a DisplayName.
|
||||
prrDepth :: PeriodicReportRow DisplayName a -> Int
|
||||
prrDepth = displayDepth . prrName
|
||||
|
||||
@ -463,18 +463,18 @@ renderComponent1 opts (acctname, depth, total) (FormatField ljust min max field)
|
||||
-- and will include the final totals row unless --no-total is set.
|
||||
multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV
|
||||
multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_}
|
||||
(PeriodicReport colspans items (PeriodicReportRow _ _ coltotals tot avg)) =
|
||||
(PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) =
|
||||
maybetranspose $
|
||||
("Account" : map showDateSpan colspans
|
||||
++ ["Total" | row_total_]
|
||||
++ ["Average" | average_]
|
||||
) :
|
||||
[T.unpack (maybeAccountNameDrop opts a) :
|
||||
[T.unpack (displayFull a) :
|
||||
map showMixedAmountOneLineWithoutPrice
|
||||
(amts
|
||||
++ [rowtot | row_total_]
|
||||
++ [rowavg | average_])
|
||||
| PeriodicReportRow a _ amts rowtot rowavg <- items]
|
||||
| PeriodicReportRow a amts rowtot rowavg <- items]
|
||||
++
|
||||
if no_total_ opts
|
||||
then []
|
||||
@ -603,7 +603,7 @@ multiBalanceReportAsText ropts@ReportOpts{..} r =
|
||||
-- | Build a 'Table' from a multi-column balance report.
|
||||
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table String String MixedAmount
|
||||
balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
|
||||
(PeriodicReport colspans items (PeriodicReportRow _ _ coltotals tot avg)) =
|
||||
(PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) =
|
||||
maybetranspose $
|
||||
addtotalrow $
|
||||
Table
|
||||
@ -619,10 +619,9 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balancetype_}
|
||||
++ [" Total" | totalscolumn]
|
||||
++ ["Average" | average_]
|
||||
accts = map renderacct items
|
||||
renderacct (PeriodicReportRow a i _ _ _)
|
||||
| tree_ opts = replicate ((i-1)*2) ' ' ++ T.unpack (accountLeafName a)
|
||||
| otherwise = T.unpack $ maybeAccountNameDrop opts a
|
||||
rowvals (PeriodicReportRow _ _ as rowtot rowavg) = as
|
||||
renderacct row =
|
||||
replicate ((prrDepth row - 1) * 2) ' ' ++ T.unpack (prrDisplayName row)
|
||||
rowvals (PeriodicReportRow _ as rowtot rowavg) = as
|
||||
++ [rowtot | totalscolumn]
|
||||
++ [rowavg | average_]
|
||||
addtotalrow | no_total_ opts = id
|
||||
|
||||
@ -203,7 +203,7 @@ compoundBalanceCommand CompoundBalanceCommandSpec{..} opts@CliOpts{reportopts_=r
|
||||
-- "2008/01/01-2008/12/31", not "2008").
|
||||
titledatestr
|
||||
| balancetype == HistoricalBalance = showEndDates enddates
|
||||
| otherwise = showDateSpan requestedspan
|
||||
| otherwise = showDateSpan requestedspan
|
||||
where
|
||||
enddates = map (addDays (-1)) $ catMaybes $ map spanEnd colspans -- these spans will always have a definite end date
|
||||
requestedspan = queryDateSpan date2_ userq `spanDefaultsFrom` journalDateSpan date2_ j
|
||||
@ -271,12 +271,12 @@ compoundBalanceSubreport ropts@ReportOpts{..} userq j priceoracle subreportqfn s
|
||||
where
|
||||
nonzeroaccounts =
|
||||
dbg5 "nonzeroaccounts" $
|
||||
mapMaybe (\(PeriodicReportRow act _ amts _ _) ->
|
||||
if not (all mixedAmountLooksZero amts) then Just act else Nothing) rows
|
||||
mapMaybe (\(PeriodicReportRow act amts _ _) ->
|
||||
if not (all mixedAmountLooksZero amts) then Just (displayFull act) else Nothing) rows
|
||||
rows' = filter (not . emptyRow) rows
|
||||
where
|
||||
emptyRow (PeriodicReportRow act _ amts _ _) =
|
||||
all mixedAmountLooksZero amts && not (any (act `isAccountNamePrefixOf`) nonzeroaccounts)
|
||||
emptyRow (PeriodicReportRow act amts _ _) =
|
||||
all mixedAmountLooksZero amts && not (any (displayFull act `isAccountNamePrefixOf`) nonzeroaccounts)
|
||||
|
||||
-- | Render a compound balance report as plain text suitable for console output.
|
||||
{- Eg:
|
||||
|
||||
Loading…
Reference in New Issue
Block a user