mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-28 04:46:31 +03:00
5989ca0381
Makes them consistent with the remaining cells and fixes awkward alignment issue in commodity-column mode where we don't display anything
453 lines
21 KiB
Haskell
453 lines
21 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE RecordWildCards #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
|
|
module Hledger.Reports.BudgetReport (
|
|
BudgetGoal,
|
|
BudgetTotal,
|
|
BudgetAverage,
|
|
BudgetCell,
|
|
BudgetReportRow,
|
|
BudgetReport,
|
|
budgetReport,
|
|
budgetReportAsTable,
|
|
budgetReportAsText,
|
|
budgetReportAsCsv,
|
|
-- * Helpers
|
|
combineBudgetAndActual,
|
|
-- * Tests
|
|
tests_BudgetReport
|
|
)
|
|
where
|
|
|
|
import Control.Applicative ((<|>))
|
|
import Data.Decimal (roundTo)
|
|
import Data.Default (def)
|
|
import Data.Function (on)
|
|
import Data.HashMap.Strict (HashMap)
|
|
import qualified Data.HashMap.Strict as HM
|
|
import Data.List (find, partition, transpose, foldl')
|
|
import Data.List.Extra (nubSort)
|
|
import Data.Maybe (fromMaybe, catMaybes)
|
|
import Data.Map (Map)
|
|
import qualified Data.Map as Map
|
|
import qualified Data.Set as S
|
|
import Data.Text (Text)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Lazy as TL
|
|
import qualified Data.Text.Lazy.Builder as TB
|
|
--import System.Console.CmdArgs.Explicit as C
|
|
--import Lucid as L
|
|
import Text.Tabular.AsciiWide as Tab
|
|
|
|
import Hledger.Data
|
|
import Hledger.Utils
|
|
import Hledger.Read.CsvReader (CSV)
|
|
import Hledger.Reports.ReportOptions
|
|
import Hledger.Reports.ReportTypes
|
|
import Hledger.Reports.MultiBalanceReport
|
|
|
|
|
|
type BudgetGoal = Change
|
|
type BudgetTotal = Total
|
|
type BudgetAverage = Average
|
|
|
|
-- | A budget report tracks expected and actual changes per account and subperiod.
|
|
type BudgetCell = (Maybe Change, Maybe BudgetGoal)
|
|
type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell
|
|
type BudgetReport = PeriodicReport DisplayName BudgetCell
|
|
|
|
|
|
type BudgetDisplayCell = (BudgetCell, (Int, Int, Int))
|
|
|
|
-- | Calculate per-account, per-period budget (balance change) goals
|
|
-- from all periodic transactions, calculate actual balance changes
|
|
-- from the regular transactions, and compare these to get a 'BudgetReport'.
|
|
-- Unbudgeted accounts may be hidden or renamed (see journalWithBudgetAccountNames).
|
|
budgetReport :: ReportSpec -> BalancingOpts -> DateSpan -> Journal -> BudgetReport
|
|
budgetReport rspec bopts reportspan j = dbg4 "sortedbudgetreport" budgetreport
|
|
where
|
|
-- Budget report demands ALTree mode to ensure subaccounts and subaccount budgets are properly handled
|
|
-- and that reports with and without --empty make sense when compared side by side
|
|
ropts = (_rsReportOpts rspec){ accountlistmode_ = ALTree }
|
|
showunbudgeted = empty_ ropts
|
|
budgetedaccts =
|
|
dbg3 "budgetedacctsinperiod" $
|
|
S.fromList $
|
|
expandAccountNames $
|
|
accountNamesFromPostings $
|
|
concatMap tpostings $
|
|
concatMap (`runPeriodicTransaction` reportspan) $
|
|
jperiodictxns j
|
|
actualj = journalWithBudgetAccountNames budgetedaccts showunbudgeted j
|
|
budgetj = journalAddBudgetGoalTransactions bopts ropts reportspan j
|
|
actualreport@(PeriodicReport actualspans _ _) =
|
|
dbg5 "actualreport" $ multiBalanceReport rspec{_rsReportOpts=ropts{empty_=True}} actualj
|
|
budgetgoalreport@(PeriodicReport _ budgetgoalitems budgetgoaltotals) =
|
|
dbg5 "budgetgoalreport" $ multiBalanceReport rspec{_rsReportOpts=ropts{empty_=True}} budgetj
|
|
budgetgoalreport'
|
|
-- If no interval is specified:
|
|
-- budgetgoalreport's span might be shorter actualreport's due to periodic txns;
|
|
-- it should be safe to replace it with the latter, so they combine well.
|
|
| interval_ ropts == NoInterval = PeriodicReport actualspans budgetgoalitems budgetgoaltotals
|
|
| otherwise = budgetgoalreport
|
|
budgetreport = combineBudgetAndActual ropts j budgetgoalreport' actualreport
|
|
|
|
-- | Use all periodic transactions in the journal to generate
|
|
-- budget goal transactions in the specified date span.
|
|
-- Budget goal transactions are similar to forecast transactions except
|
|
-- their purpose and effect is to define balance change goals, per account and period,
|
|
-- for BudgetReport.
|
|
journalAddBudgetGoalTransactions :: BalancingOpts -> ReportOpts -> DateSpan -> Journal -> Journal
|
|
journalAddBudgetGoalTransactions bopts ropts reportspan j =
|
|
either error' id $ journalBalanceTransactions bopts j{ jtxns = budgetts } -- PARTIAL:
|
|
where
|
|
budgetspan = dbg3 "budget span" $ reportspan
|
|
pat = fromMaybe "" $ dbg3 "budget pattern" $ T.toLower <$> budgetpat_ ropts
|
|
-- select periodic transactions matching a pattern
|
|
-- (the argument of the (final) --budget option).
|
|
-- XXX two limitations/wishes, requiring more extensive type changes:
|
|
-- - give an error if pat is non-null and matches no periodic txns
|
|
-- - allow a regexp or a full hledger query, not just a substring
|
|
budgetts =
|
|
dbg5 "budget goal txns" $
|
|
[makeBudgetTxn t
|
|
| pt <- jperiodictxns j
|
|
, pat `T.isInfixOf` T.toLower (ptdescription pt)
|
|
, t <- runPeriodicTransaction pt budgetspan
|
|
]
|
|
makeBudgetTxn t = txnTieKnot $ t { tdescription = T.pack "Budget transaction" }
|
|
|
|
-- | Adjust a journal's account names for budget reporting, in two ways:
|
|
--
|
|
-- 1. accounts with no budget goal anywhere in their ancestry are moved
|
|
-- under the "unbudgeted" top level account.
|
|
--
|
|
-- 2. subaccounts with no budget goal are merged with their closest parent account
|
|
-- with a budget goal, so that only budgeted accounts are shown.
|
|
-- This can be disabled by -E/--empty.
|
|
--
|
|
journalWithBudgetAccountNames :: S.Set AccountName -> Bool -> Journal -> Journal
|
|
journalWithBudgetAccountNames budgetedaccts showunbudgeted j =
|
|
dbg5With (("budget account names: "++).pshow.journalAccountNamesUsed) $
|
|
j { jtxns = remapTxn <$> jtxns j }
|
|
where
|
|
remapTxn = txnTieKnot . transactionTransformPostings remapPosting
|
|
remapPosting p = p { paccount = remapAccount $ paccount p, poriginal = poriginal p <|> Just p }
|
|
remapAccount a
|
|
| a `S.member` budgetedaccts = a
|
|
| Just p <- budgetedparent = if showunbudgeted then a else p
|
|
| otherwise = if showunbudgeted then u <> acctsep <> a else u
|
|
where
|
|
budgetedparent = find (`S.member` budgetedaccts) $ parentAccountNames a
|
|
u = unbudgetedAccountName
|
|
|
|
-- | Combine a per-account-and-subperiod report of budget goals, and one
|
|
-- of actual change amounts, into a budget performance report.
|
|
-- The two reports should have the same report interval, but need not
|
|
-- have exactly the same account rows or date columns.
|
|
-- (Cells in the combined budget report can be missing a budget goal,
|
|
-- an actual amount, or both.) The combined report will include:
|
|
--
|
|
-- - consecutive subperiods at the same interval as the two reports,
|
|
-- spanning the period of both reports
|
|
--
|
|
-- - all accounts mentioned in either report, sorted by account code or
|
|
-- account name or amount as appropriate.
|
|
--
|
|
combineBudgetAndActual :: ReportOpts -> Journal -> MultiBalanceReport -> MultiBalanceReport -> BudgetReport
|
|
combineBudgetAndActual ropts j
|
|
(PeriodicReport budgetperiods budgetrows (PeriodicReportRow _ budgettots budgetgrandtot budgetgrandavg))
|
|
(PeriodicReport actualperiods actualrows (PeriodicReportRow _ actualtots actualgrandtot actualgrandavg)) =
|
|
PeriodicReport periods sortedrows totalrow
|
|
where
|
|
periods = nubSort . filter (/= nulldatespan) $ budgetperiods ++ actualperiods
|
|
|
|
-- first, combine any corresponding budget goals with actual changes
|
|
rows1 =
|
|
[ PeriodicReportRow acct amtandgoals totamtandgoal avgamtandgoal
|
|
| PeriodicReportRow acct actualamts actualtot actualavg <- actualrows
|
|
, let mbudgetgoals = HM.lookup (displayFull acct) budgetGoalsByAcct :: Maybe ([BudgetGoal], BudgetTotal, BudgetAverage)
|
|
, let budgetmamts = maybe (Nothing <$ periods) (map Just . first3) mbudgetgoals :: [Maybe BudgetGoal]
|
|
, let mbudgettot = second3 <$> mbudgetgoals :: Maybe BudgetTotal
|
|
, let mbudgetavg = third3 <$> mbudgetgoals :: Maybe BudgetAverage
|
|
, let acctBudgetByPeriod = Map.fromList [ (p,budgetamt) | (p, Just budgetamt) <- zip budgetperiods budgetmamts ] :: Map DateSpan BudgetGoal
|
|
, let acctActualByPeriod = Map.fromList [ (p,actualamt) | (p, Just actualamt) <- zip actualperiods (map Just actualamts) ] :: Map DateSpan Change
|
|
, let amtandgoals = [ (Map.lookup p acctActualByPeriod, Map.lookup p acctBudgetByPeriod) | p <- periods ] :: [BudgetCell]
|
|
, let totamtandgoal = (Just actualtot, mbudgettot)
|
|
, let avgamtandgoal = (Just actualavg, mbudgetavg)
|
|
]
|
|
where
|
|
budgetGoalsByAcct :: HashMap AccountName ([BudgetGoal], BudgetTotal, BudgetAverage) =
|
|
HM.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 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)
|
|
, let avgamtandgoal = (Nothing, Just budgetavg)
|
|
]
|
|
|
|
-- combine and re-sort rows
|
|
-- TODO: add --sort-budget to sort by budget goal amount
|
|
sortedrows :: [BudgetReportRow] = sortRowsLike (mbrsorted unbudgetedrows ++ mbrsorted rows') rows
|
|
where
|
|
(unbudgetedrows, rows') = partition ((==unbudgetedAccountName) . prrFullName) rows
|
|
mbrsorted = map prrFullName . sortRows ropts j . map (fmap $ fromMaybe nullmixedamt . fst)
|
|
rows = rows1 ++ rows2
|
|
|
|
totalrow = PeriodicReportRow ()
|
|
[ (Map.lookup p totActualByPeriod, Map.lookup p totBudgetByPeriod) | p <- periods ]
|
|
( Just actualgrandtot, budget budgetgrandtot )
|
|
( Just actualgrandavg, budget budgetgrandavg )
|
|
where
|
|
totBudgetByPeriod = Map.fromList $ zip budgetperiods budgettots :: Map DateSpan BudgetTotal
|
|
totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change
|
|
budget b = if mixedAmountLooksZero b then Nothing else Just b
|
|
|
|
-- | Render a budget report as plain text suitable for console output.
|
|
budgetReportAsText :: ReportOpts -> BudgetReport -> TL.Text
|
|
budgetReportAsText ropts@ReportOpts{..} budgetr = TB.toLazyText $
|
|
TB.fromText title <> TB.fromText "\n\n" <>
|
|
renderTableByRowsB def{tableBorders=False,prettyTable=pretty_tables_}
|
|
renderCh renderRow displayTableWithWidths
|
|
where
|
|
title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
|
|
<> (case cost_ of
|
|
Cost -> ", converted to cost"
|
|
NoCost -> "")
|
|
<> (case value_ of
|
|
Just (AtThen _mc) -> ", valued at posting date"
|
|
Just (AtEnd _mc) -> ", valued at period ends"
|
|
Just (AtNow _mc) -> ", current value"
|
|
Just (AtDate d _mc) -> ", valued at " <> showDate d
|
|
Nothing -> "")
|
|
<> ":"
|
|
|
|
renderCh
|
|
| not commodity_column_ = fmap (textCell TopRight)
|
|
| otherwise = zipWith ($) (Tab.textCell TopLeft : repeat (Tab.textCell TopRight))
|
|
|
|
renderRow :: (Text, [((Int, Int, Int), BudgetDisplayCell)]) -> (Cell, [Cell])
|
|
renderRow (rh, cells)
|
|
| not commodity_column_ = (textCell TopLeft rh, fmap (uncurry showcell) cells)
|
|
| otherwise =
|
|
( textCell TopLeft rh
|
|
, textsCell TopLeft cs : fmap (uncurry (showcell' cs)) cells)
|
|
where
|
|
cs = filter (not . T.null) . S.toList . foldl' S.union mempty
|
|
. fmap (budgetCellCommodities . fst . snd) $ cells
|
|
|
|
budgetCellCommodities :: BudgetCell -> S.Set CommoditySymbol
|
|
budgetCellCommodities (am, bm) = f am `S.union` f bm
|
|
where f = S.fromList . fmap acommodity . amounts . fromMaybe nullmixedamt
|
|
|
|
displayTableWithWidths :: Table Text Text ((Int, Int, Int), BudgetDisplayCell)
|
|
displayTableWithWidths = Table rh ch $ map (zipWith (,) widths) displaycells
|
|
Table rh ch displaycells = case budgetReportAsTable ropts budgetr of
|
|
Table rh' ch' vals -> maybetranspose . Table rh' ch' $ map (map cellWidth) vals
|
|
|
|
showNorm = showMixedAmountB oneLine{displayColour=color_, displayMaxWidth=Just 32}
|
|
|
|
cellWidth :: BudgetCell -> BudgetDisplayCell
|
|
cellWidth cell@(actual, budget) =
|
|
let (showF, budgetF)
|
|
| not commodity_column_ = (showamt , budgetAndPerc)
|
|
| otherwise = (showamt', budgetAndPerc')
|
|
(bam, bp) = fromMaybe (0, 0) $ budgetF <$> budget
|
|
in (cell, (showF actual', bam, bp))
|
|
where
|
|
actual' = fromMaybe nullmixedamt actual
|
|
budgetAndPerc b = (showamt b, fromMaybe 0 $ showper <$> percentage actual' b)
|
|
showamt = wbWidth . showNorm
|
|
showper = T.length . showperc
|
|
|
|
cs = S.toList $ budgetCellCommodities cell
|
|
showComm amt = showMixedAmountLinesB noPrice{displayOrder = Just cs} amt
|
|
showamt' = maximum' . fmap wbWidth . showComm
|
|
budgetAndPerc' b = (showamt' b, maximum' $ fmap (fromMaybe 0 . fmap showper . percentage' actual' b) cs)
|
|
|
|
widths = zip3 actualwidths budgetwidths percentwidths
|
|
actualwidths = map (maximum' . map (first3 . snd)) cols
|
|
budgetwidths = map (maximum' . map (second3 . snd)) cols
|
|
percentwidths = map (maximum' . map (third3 . snd)) cols
|
|
cols = transpose displaycells
|
|
|
|
-- XXX lay out actual, percentage and/or goal in the single table cell for now, should probably use separate cells
|
|
showcell :: (Int, Int, Int) -> BudgetDisplayCell -> Cell
|
|
showcell abs@(actualwidth, _, _) ((actual, mbudget), dim@(wa, _, _)) =
|
|
Cell TopRight [WideBuilder ( TB.fromText (T.replicate (actualwidth - wa) " ")
|
|
<> TB.fromText (toText actual')
|
|
<> budgetstr abs dim (budgetAndPerc <$> mbudget)
|
|
) (actualwidth + totalbudgetwidth)]
|
|
where
|
|
toText = TL.toStrict . TB.toLazyText . wbBuilder . showNorm
|
|
actual' = fromMaybe nullmixedamt actual
|
|
budgetAndPerc b = (toText b, showperc <$> percentage actual' b)
|
|
|
|
(_, totalbudgetwidth) = budgetw abs
|
|
|
|
showcell' :: [CommoditySymbol] -> (Int, Int, Int) -> BudgetDisplayCell -> Cell
|
|
showcell' cs abs@(actualwidth, _, _) ((actual, mbudget), _) = Cell TopRight full
|
|
where
|
|
showComm = showMixedAmountLinesB noPrice{displayOrder = Just cs}
|
|
|
|
actual' = fromMaybe nullmixedamt actual
|
|
|
|
toPadded (WideBuilder b w) =
|
|
(TB.fromText . flip T.replicate " " $ actualwidth - w) <> b
|
|
paddedActual = fmap toPadded $ showComm actual'
|
|
|
|
(_, totalbudgetwidth) = budgetw abs
|
|
|
|
budgetAndPerc :: MixedAmount -> [TB.Builder]
|
|
budgetAndPerc = fmap toBudgetStr . uncurry zip . toText
|
|
where
|
|
toBudgetStr t@(b, mp) =
|
|
let bt = if b == "0" then Nothing else Just t
|
|
in budgetstr abs (0, textWidth b, maybe 0 textWidth mp) bt
|
|
toText b =
|
|
( fmap (TL.toStrict . TB.toLazyText . wbBuilder) $ showComm b
|
|
, fmap (fmap showperc . percentage' actual' b) cs
|
|
)
|
|
|
|
full :: [WideBuilder]
|
|
full = fmap (flip WideBuilder (actualwidth + totalbudgetwidth)) $
|
|
zipWith (<>) paddedActual (fromMaybe (repeat (TB.fromText $ T.replicate totalbudgetwidth " ")) $ fmap budgetAndPerc mbudget)
|
|
|
|
budgetw (_, budgetwidth, percentwidth) =
|
|
let totalpercentwidth = if percentwidth == 0 then 0 else percentwidth + 5
|
|
in ( totalpercentwidth
|
|
, if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth + 3
|
|
)
|
|
|
|
-- | Display a padded budget string
|
|
budgetstr abs@(_, budgetwidth, percentwidth) (_, wb, wp) mbudget =
|
|
TB.fromText $ case mbudget of
|
|
Nothing -> T.replicate totalbudgetwidth " "
|
|
Just (budget, Nothing) -> " [" <> T.replicate totalpercentwidth " " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"
|
|
Just (budget, Just pct) -> " [" <> T.replicate (percentwidth - wp) " " <> pct <> "% of " <> T.replicate (budgetwidth - wb) " " <> budget <> "]"
|
|
|
|
where (totalpercentwidth, totalbudgetwidth) = budgetw abs
|
|
|
|
showperc :: Percentage -> Text
|
|
showperc = T.pack . show . roundTo 0
|
|
|
|
-- | Calculate the percentage of actual change to budget goal to show, if any.
|
|
-- If valuing at cost, both amounts are converted to cost before comparing.
|
|
-- A percentage will not be shown if:
|
|
-- - actual or goal are not the same, single, commodity
|
|
-- - the goal is zero
|
|
percentage :: Change -> BudgetGoal -> Maybe Percentage
|
|
percentage actual budget =
|
|
case (costedAmounts actual, costedAmounts budget) of
|
|
([a], [b]) | (acommodity a == acommodity b || amountLooksZero a) && not (amountLooksZero b)
|
|
-> Just $ 100 * aquantity a / aquantity b
|
|
_ -> -- trace (pshow $ (maybecost actual, maybecost budget)) -- debug missing percentage
|
|
Nothing
|
|
where
|
|
costedAmounts = case cost_ of
|
|
Cost -> amounts . mixedAmountCost
|
|
NoCost -> amounts
|
|
|
|
-- | Calculate the percentage of actual change to budget goal for a particular commodity
|
|
percentage' :: MixedAmount -> MixedAmount -> CommoditySymbol -> Maybe Percentage
|
|
percentage' am bm c = case ((,) `on` find ((==) c . acommodity) . amounts) am bm of
|
|
(Just a, Just b) -> percentage (mixedAmount a) (mixedAmount b)
|
|
_ -> Nothing
|
|
|
|
maybetranspose | transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)
|
|
| otherwise = id
|
|
|
|
-- | Build a 'Table' from a multi-column balance report.
|
|
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text (Maybe MixedAmount, Maybe MixedAmount)
|
|
budgetReportAsTable
|
|
ropts@ReportOpts{balanceaccum_}
|
|
(PeriodicReport spans rows (PeriodicReportRow _ coltots grandtot grandavg)) =
|
|
addtotalrow $
|
|
Table
|
|
(Tab.Group NoLine $ map Header accts)
|
|
(Tab.Group NoLine $ map Header colheadings)
|
|
(map rowvals rows)
|
|
where
|
|
colheadings = ["Commodity" | commodity_column_ ropts]
|
|
++ map (reportPeriodName balanceaccum_ spans) spans
|
|
++ [" Total" | row_total_ ropts]
|
|
++ ["Average" | average_ ropts]
|
|
|
|
accts = map renderacct rows
|
|
-- 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 = case accountlistmode_ ropts of
|
|
ALTree -> T.replicate ((prrDepth row - 1)*2) " " <> prrDisplayName row
|
|
ALFlat -> accountNameDrop (drop_ ropts) $ prrFullName row
|
|
rowvals (PeriodicReportRow _ as rowtot rowavg) =
|
|
as ++ [rowtot | row_total_ ropts] ++ [rowavg | average_ ropts]
|
|
addtotalrow
|
|
| no_total_ ropts = id
|
|
| otherwise = (+----+ (row "" $
|
|
coltots ++ [grandtot | row_total_ ropts && not (null coltots)]
|
|
++ [grandavg | average_ ropts && not (null coltots)]
|
|
))
|
|
|
|
-- XXX generalise this with multiBalanceReportAsCsv ?
|
|
-- | Render a budget report as CSV. Like multiBalanceReportAsCsv,
|
|
-- but includes alternating actual and budget amount columns.
|
|
budgetReportAsCsv :: ReportOpts -> BudgetReport -> CSV
|
|
budgetReportAsCsv
|
|
ReportOpts{..}
|
|
(PeriodicReport colspans items tr)
|
|
= (if transpose_ then transpose else id) $
|
|
|
|
-- heading row
|
|
("Account" :
|
|
["Commodity" | commodity_column_ ]
|
|
++ concatMap (\span -> [showDateSpan span, "budget"]) colspans
|
|
++ concat [["Total" ,"budget"] | row_total_]
|
|
++ concat [["Average","budget"] | average_]
|
|
) :
|
|
|
|
-- account rows
|
|
concatMap (rowAsTexts prrFullName) items
|
|
|
|
-- totals row
|
|
++ concat [ rowAsTexts (const "Total:") tr | not no_total_ ]
|
|
|
|
where
|
|
flattentuples abs = concat [[a,b] | (a,b) <- abs]
|
|
showNorm = maybe "" (wbToText . showMixedAmountB oneLine)
|
|
|
|
rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text)
|
|
-> PeriodicReportRow a BudgetCell
|
|
-> [[Text]]
|
|
rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg))
|
|
| not commodity_column_ = [render row : fmap showNorm all]
|
|
| otherwise =
|
|
joinNames . zipWith (:) cs -- add symbols and names
|
|
. transpose -- each row becomes a list of Text quantities
|
|
. fmap (fmap wbToText . showMixedAmountLinesB oneLine{displayOrder=Just cs, displayMinWidth=Nothing})
|
|
. fmap (fromMaybe nullmixedamt)
|
|
$ all
|
|
where
|
|
cs = commodities $ catMaybes all
|
|
commodities = filter (not . T.null) . S.toList
|
|
. foldl' S.union mempty
|
|
. fmap (S.fromList . fmap acommodity . amounts)
|
|
all = flattentuples as
|
|
++ concat [[rowtot, budgettot] | row_total_]
|
|
++ concat [[rowavg, budgetavg] | average_]
|
|
|
|
joinNames = fmap ((:) (render row))
|
|
|
|
-- tests
|
|
|
|
tests_BudgetReport = tests "BudgetReport" [
|
|
]
|