slaesvuo/hledger
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

dev: refactor table rendering code

Browse Source 
- Consolidate some table rendering helpers in Balance.hs
- Rename, document for clarity
- Extract parameters for controlling table borders
- hlint suggestions
This commit is contained in:
Simon Michael 2024-06-12 03:13:58 +01:00
parent 1260a68596
commit 1a242c1264
6 changed files with 387 additions and 379 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

302
hledger-lib/Hledger/Reports/BudgetReport.hs
View File

@ -1,5 +1,4 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
module Hledger.Reports.BudgetReport ( module Hledger.Reports.BudgetReport (
@ -10,9 +9,6 @@ module Hledger.Reports.BudgetReport (
BudgetReportRow, BudgetReportRow,
BudgetReport, BudgetReport,
budgetReport, budgetReport,
budgetReportAsTable,
budgetReportAsText,
budgetReportAsCsv,
-- * Helpers -- * Helpers
combineBudgetAndActual, combineBudgetAndActual,
-- * Tests -- * Tests
@ -21,25 +17,16 @@ module Hledger.Reports.BudgetReport (
where where
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Arrow ((***))
import Data.Decimal (roundTo)
import Data.Function (on)
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.List (find, partition, transpose, foldl', maximumBy, intercalate) import Data.List (find, partition, maximumBy, intercalate)
import Data.List.Extra (nubSort) import Data.List.Extra (nubSort)
import Data.Maybe (fromMaybe, catMaybes, isJust) import Data.Maybe (fromMaybe, isJust)
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as S import qualified Data.Set as S
import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import Safe (minimumDef) import Safe (minimumDef)
--import System.Console.CmdArgs.Explicit as C
--import Lucid as L
import qualified Text.Tabular.AsciiWide as Tab
import Hledger.Data import Hledger.Data
import Hledger.Utils import Hledger.Utils
@ -62,17 +49,6 @@ type BudgetReportRow = PeriodicReportRow DisplayName BudgetCell
-- | A full budget report table. -- | A full budget report table.
type BudgetReport = PeriodicReport DisplayName BudgetCell type BudgetReport = PeriodicReport DisplayName BudgetCell
-- A BudgetCell's data values rendered for display - the actual change amount,
-- the budget goal amount if any, and the corresponding goal percentage if possible.
type BudgetDisplayCell = (WideBuilder, Maybe (WideBuilder, Maybe WideBuilder))
-- | A row of rendered budget data cells.
type BudgetDisplayRow = [BudgetDisplayCell]
-- | An amount render helper for the budget report. Renders each commodity separately.
type BudgetShowAmountsFn = MixedAmount -> [WideBuilder]
-- | A goal percentage calculating helper for the budget report.
type BudgetCalcPercentagesFn = Change -> BudgetGoal -> [Maybe Percentage]
_brrShowDebug :: BudgetReportRow -> String _brrShowDebug :: BudgetReportRow -> String
_brrShowDebug (PeriodicReportRow dname budgetpairs _tot _avg) = _brrShowDebug (PeriodicReportRow dname budgetpairs _tot _avg) =
unwords [ unwords [
@ -279,280 +255,6 @@ combineBudgetAndActual ropts j
totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change totActualByPeriod = Map.fromList $ zip actualperiods actualtots :: Map DateSpan Change
budget b = if mixedAmountLooksZero b then Nothing else Just b 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" <>
balanceReportTableAsText ropts (budgetReportAsTable ropts budgetr)
where
title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
<> (case conversionop_ of
Just ToCost -> ", converted to cost"
_ -> "")
<> (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 -> "")
<> ":"
-- | Build a 'Table' from a multi-column balance report.
budgetReportAsTable :: ReportOpts -> BudgetReport -> Tab.Table Text Text WideBuilder
budgetReportAsTable ReportOpts{..} (PeriodicReport spans items totrow) =
maybetransposetable $
addtotalrow $
Tab.Table
(Tab.Group Tab.NoLine $ map Tab.Header accts)
(Tab.Group Tab.NoLine $ map Tab.Header colheadings)
rows
where
maybetransposetable
| transpose_ = \(Tab.Table rh ch vals) -> Tab.Table ch rh (transpose vals)
| otherwise = id
addtotalrow
| no_total_ = id
| otherwise = let rh = Tab.Group Tab.NoLine . replicate (length totalrows) $ Tab.Header ""
ch = Tab.Header [] -- ignored
in (flip (Tab.concatTables Tab.SingleLine) $ Tab.Table rh ch totalrows)
colheadings = ["Commodity" | layout_ == LayoutBare]
++ map (reportPeriodName balanceaccum_ spans) spans
++ [" Total" | row_total_]
++ ["Average" | average_]
(accts, rows, totalrows) =
(accts'
,maybecommcol itemscs $ showcells texts
,maybecommcol totrowcs $ showtotrow totrowtexts)
where
-- If --layout=bare, prepend a commodities column.
maybecommcol :: [WideBuilder] -> [[WideBuilder]] -> [[WideBuilder]]
maybecommcol cs
| layout_ == LayoutBare = zipWith (:) cs
| otherwise = id
showcells, showtotrow :: [[BudgetDisplayCell]] -> [[WideBuilder]]
(showcells, showtotrow) =
(maybetranspose . map (zipWith showBudgetDisplayCell widths) . maybetranspose
,maybetranspose . map (zipWith showBudgetDisplayCell totrowwidths) . maybetranspose)
where
-- | Combine a BudgetDisplayCell's rendered values into a "[PERCENT of GOAL]" rendering,
-- respecting the given widths.
showBudgetDisplayCell :: (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder
showBudgetDisplayCell (actualwidth, budgetwidth, percentwidth) (actual, mbudget) =
flip WideBuilder (actualwidth + totalbudgetwidth) $
toPadded actual <> maybe emptycell showBudgetGoalAndPercentage mbudget
where
toPadded (WideBuilder b w) = (TB.fromText . flip T.replicate " " $ actualwidth - w) <> b
(totalpercentwidth, totalbudgetwidth) =
let totalpercentwidth' = if percentwidth == 0 then 0 else percentwidth + 5
in ( totalpercentwidth'
, if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth' + 3
)
emptycell :: TB.Builder
emptycell = TB.fromText $ T.replicate totalbudgetwidth " "
showBudgetGoalAndPercentage :: (WideBuilder, Maybe WideBuilder) -> TB.Builder
showBudgetGoalAndPercentage (goal, perc) =
let perct = case perc of
Nothing -> T.replicate totalpercentwidth " "
Just pct -> T.replicate (percentwidth - wbWidth pct) " " <> wbToText pct <> "% of "
in TB.fromText $ " [" <> perct <> T.replicate (budgetwidth - wbWidth goal) " " <> wbToText goal <> "]"
-- | Build a list of widths for each column.
-- When --transpose is used, the totals row must be included in this list.
widths :: [(Int, Int, Int)]
widths = zip3 actualwidths budgetwidths percentwidths
where
actualwidths = map (maximum' . map first3 ) $ cols
budgetwidths = map (maximum' . map second3) $ cols
percentwidths = map (maximum' . map third3 ) $ cols
catcolumnwidths = foldl' (zipWith (++)) $ repeat []
cols = maybetranspose $ catcolumnwidths $ map (cellswidth . rowToBudgetCells) items ++ [cellswidth $ rowToBudgetCells totrow]
cellswidth :: [BudgetCell] -> [[(Int, Int, Int)]]
cellswidth row =
let cs = budgetCellsCommodities row
(showmixed, percbudget) = mkBudgetDisplayFns cs
disp = showcell showmixed percbudget
budgetpercwidth = wbWidth *** maybe 0 wbWidth
cellwidth (am, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (wbWidth am, bw, pw)
in map (map cellwidth . disp) row
totrowwidths :: [(Int, Int, Int)]
totrowwidths
| transpose_ = drop (length texts) widths
| otherwise = widths
maybetranspose
| transpose_ = transpose
| otherwise = id
(accts', itemscs, texts) = unzip3 $ concat shownitems
where
shownitems :: [[(AccountName, WideBuilder, BudgetDisplayRow)]]
shownitems =
map (\i ->
let
addacctcolumn = map (\(cs, cvals) -> (renderacct i, cs, cvals))
isunbudgetedrow = displayFull (prrName i) == unbudgetedAccountName
in addacctcolumn $ showrow isunbudgetedrow $ rowToBudgetCells i)
items
where
-- 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_ of
ALTree -> T.replicate ((prrDepth row - 1)*2) " " <> prrDisplayName row
ALFlat -> accountNameDrop (drop_) $ prrFullName row
(totrowcs, totrowtexts) = unzip $ concat showntotrow
where
showntotrow :: [[(WideBuilder, BudgetDisplayRow)]]
showntotrow = [showrow False $ rowToBudgetCells totrow]
-- | Get the data cells from a row or totals row, maybe adding
-- the row total and/or row average depending on options.
rowToBudgetCells :: PeriodicReportRow a BudgetCell -> [BudgetCell]
rowToBudgetCells (PeriodicReportRow _ as rowtot rowavg) = as
++ [rowtot | row_total_ && not (null as)]
++ [rowavg | average_ && not (null as)]
-- | Render a row's data cells as "BudgetDisplayCell"s, and a rendered list of commodity symbols.
-- Also requires a flag indicating whether this is the special <unbudgeted> row.
-- (The types make that hard to check here.)
showrow :: Bool -> [BudgetCell] -> [(WideBuilder, BudgetDisplayRow)]
showrow isunbudgetedrow cells =
let
cs = budgetCellsCommodities cells
-- #2071 If there are no commodities - because there are no actual or goal amounts -
-- the zipped list would be empty, causing this row not to be shown.
-- But rows like this sometimes need to be shown to preserve the account tree structure.
-- So, ensure 0 will be shown as actual amount(s).
-- Unfortunately this disables boring parent eliding, as if --no-elide had been used.
-- (Just turning on --no-elide higher up doesn't work right.)
-- Note, no goal amount will be shown for these rows,
-- whereas --no-elide is likely to show a goal amount aggregated from children.
cs1 = if null cs && not isunbudgetedrow then [""] else cs
(showmixed, percbudget) = mkBudgetDisplayFns cs1
in
zip (map wbFromText cs1) $
transpose $
map (showcell showmixed percbudget)
cells
budgetCellsCommodities :: [BudgetCell] -> [CommoditySymbol]
budgetCellsCommodities = S.toList . foldl' S.union mempty . map budgetCellCommodities
where
budgetCellCommodities :: BudgetCell -> S.Set CommoditySymbol
budgetCellCommodities (am, bm) = f am `S.union` f bm
where f = maybe mempty maCommodities
-- | Render a "BudgetCell"'s amounts as "BudgetDisplayCell"s (one per commodity).
showcell :: BudgetShowAmountsFn -> BudgetCalcPercentagesFn -> BudgetCell -> BudgetDisplayRow
showcell showCommodityAmounts calcCommodityPercentages (mactual, mbudget) =
zip actualamts budgetinfos
where
actual = fromMaybe nullmixedamt mactual
actualamts = showCommodityAmounts actual
budgetinfos =
case mbudget of
Nothing -> repeat Nothing
Just goal -> map Just $ showGoalAmountsAndPercentages goal
where
showGoalAmountsAndPercentages :: MixedAmount -> [(WideBuilder, Maybe WideBuilder)]
showGoalAmountsAndPercentages goal = zip amts mpcts
where
amts = showCommodityAmounts goal
mpcts = map (showrounded <$>) $ calcCommodityPercentages actual goal
where showrounded = wbFromText . T.pack . show . roundTo 0
-- | Make budget info display helpers that adapt to --layout=wide.
mkBudgetDisplayFns :: [CommoditySymbol] -> (BudgetShowAmountsFn, BudgetCalcPercentagesFn)
mkBudgetDisplayFns cs = case layout_ of
LayoutWide width ->
( pure . showMixedAmountB oneLineNoCostFmt{displayMaxWidth=width, displayColour=color_}
, \a -> pure . percentage a)
_ -> ( showMixedAmountLinesB noCostFmt{displayCommodity=layout_/=LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing, displayColour=color_}
, \a b -> map (percentage' a b) cs)
where
-- | 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
_ -> Nothing
where
costedAmounts = case conversionop_ of
Just ToCost -> amounts . mixedAmountCost
_ -> amounts
-- | Like percentage, but accept multicommodity actual and budget amounts,
-- and extract the specified commodity from both.
percentage' :: Change -> BudgetGoal -> 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
-- XXX generalise this with multiBalanceReportAsCsv ?
-- | Render a budget report as CSV. Like multiBalanceReportAsCsv,
-- but includes alternating actual and budget amount columns.
budgetReportAsCsv :: ReportOpts -> BudgetReport -> [[Text]]
budgetReportAsCsv
ReportOpts{..}
(PeriodicReport colspans items totrow)
= (if transpose_ then transpose else id) $
-- heading row
("Account" :
["Commodity" | layout_ == LayoutBare ]
++ concatMap (\spn -> [showDateSpan spn, "budget"]) colspans
++ concat [["Total" ,"budget"] | row_total_]
++ concat [["Average","budget"] | average_]
) :
-- account rows
concatMap (rowAsTexts prrFullName) items
-- totals row
++ concat [ rowAsTexts (const "Total:") totrow | not no_total_ ]
where
flattentuples tups = concat [[a,b] | (a,b) <- tups]
showNorm = maybe "" (wbToText . showMixedAmountB oneLineNoCostFmt)
rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text)
-> PeriodicReportRow a BudgetCell
-> [[Text]]
rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg))
| layout_ /= LayoutBare = [render row : map showNorm vals]
| otherwise =
joinNames . zipWith (:) cs -- add symbols and names
. transpose -- each row becomes a list of Text quantities
. map (map wbToText . showMixedAmountLinesB dopts . fromMaybe nullmixedamt)
$ vals
where
cs = S.toList . foldl' S.union mempty . map maCommodities $ catMaybes vals
dopts = oneLineNoCostFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing}
vals = flattentuples as
++ concat [[rowtot, budgettot] | row_total_]
++ concat [[rowavg, budgetavg] | average_]
joinNames = map (render row :)
-- tests -- tests
tests_BudgetReport = testGroup "BudgetReport" [ tests_BudgetReport = testGroup "BudgetReport" [

32
hledger-lib/Hledger/Reports/MultiBalanceReport.hs
View File

@ -28,7 +28,6 @@ module Hledger.Reports.MultiBalanceReport (
getPostings, getPostings,
startingPostings, startingPostings,
generateMultiBalanceReport, generateMultiBalanceReport,
balanceReportTableAsText,
-- -- * Tests -- -- * Tests
tests_MultiBalanceReport tests_MultiBalanceReport
@ -39,7 +38,7 @@ import Control.Monad (guard)
import Data.Bifunctor (second) import Data.Bifunctor (second)
import Data.Foldable (toList) import Data.Foldable (toList)
import Data.List (sortOn, transpose) import Data.List (sortOn, transpose)
import Data.List.NonEmpty (NonEmpty(..)) import Data.List.NonEmpty (NonEmpty((:|)))
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.Map (Map) import Data.Map (Map)
@ -52,11 +51,6 @@ import qualified Data.Set as Set
import Data.Time.Calendar (fromGregorian) import Data.Time.Calendar (fromGregorian)
import Safe (lastDef, minimumMay) import Safe (lastDef, minimumMay)
import Data.Default (def)
import qualified Data.Text as T
import qualified Data.Text.Lazy.Builder as TB
import qualified Text.Tabular.AsciiWide as Tab
import Hledger.Data import Hledger.Data
import Hledger.Query import Hledger.Query
import Hledger.Utils hiding (dbg3,dbg4,dbg5) import Hledger.Utils hiding (dbg3,dbg4,dbg5)
@ -594,33 +588,13 @@ periodChanges start amtmap =
cumulativeSum :: Account -> Map DateSpan Account -> Map DateSpan Account cumulativeSum :: Account -> Map DateSpan Account -> Map DateSpan Account
cumulativeSum start = snd . M.mapAccum (\a b -> let s = sumAcct a b in (s, s)) start cumulativeSum start = snd . M.mapAccum (\a b -> let s = sumAcct a b in (s, s)) start
-- | Given a table representing a multi-column balance report (for example,
-- made using 'balanceReportAsTable'), render it in a format suitable for
-- console output. Amounts with more than two commodities will be elided
-- unless --no-elide is used.
balanceReportTableAsText :: ReportOpts -> Tab.Table T.Text T.Text WideBuilder -> TB.Builder
balanceReportTableAsText ReportOpts{..} =
Tab.renderTableByRowsB def{Tab.tableBorders=False, Tab.prettyTable=pretty_} renderCh renderRow
where
renderCh
| layout_ /= LayoutBare || transpose_ = fmap (Tab.textCell Tab.TopRight)
| otherwise = zipWith ($) (Tab.textCell Tab.TopLeft : repeat (Tab.textCell Tab.TopRight))
renderRow (rh, row)
| layout_ /= LayoutBare || transpose_ =
(Tab.textCell Tab.TopLeft rh, fmap (Tab.Cell Tab.TopRight . pure) row)
| otherwise =
(Tab.textCell Tab.TopLeft rh, zipWith ($) (Tab.Cell Tab.TopLeft : repeat (Tab.Cell Tab.TopRight)) (fmap pure row))
-- tests -- tests
tests_MultiBalanceReport = testGroup "MultiBalanceReport" [ tests_MultiBalanceReport = testGroup "MultiBalanceReport" [
let let
amt0 = Amount {acommodity="$", aquantity=0, acost=Nothing, amt0 = Amount {acommodity="$", aquantity=0, acost=Nothing,
astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asdigitgroups = Nothing, astyle=AmountStyle {ascommodityside = L, ascommodityspaced = False, asdigitgroups = Nothing,
asdecimalmark = Just '.', asprecision = Precision 2, asrounding = NoRounding}} asdecimalmark = Just '.', asprecision = Precision 2, asrounding = NoRounding}}
(rspec,journal) `gives` r = do (rspec,journal) `gives` r = do
let rspec' = rspec{_rsQuery=And [queryFromFlags $ _rsReportOpts rspec, _rsQuery rspec]} let rspec' = rspec{_rsQuery=And [queryFromFlags $ _rsReportOpts rspec, _rsQuery rspec]}

4
hledger-lib/Text/Tabular/AsciiWide.hs
View File

@ -145,9 +145,7 @@ renderRow topts = toLazyText . renderRowB topts
-- | A version of renderRow which returns the underlying Builder. -- | A version of renderRow which returns the underlying Builder.
renderRowB:: TableOpts -> Header Cell -> Builder renderRowB:: TableOpts -> Header Cell -> Builder
renderRowB topts h = renderColumns topts is h renderRowB topts h = renderColumns topts ws h where ws = map cellWidth $ headerContents h
where is = map cellWidth $ headerContents h
verticalBar :: Bool -> Char verticalBar :: Bool -> Char
verticalBar pretty = if pretty then '│' else '|' verticalBar pretty = if pretty then '│' else '|'

410
hledger/Hledger/Cli/Commands/Balance.hs
View File

@ -253,26 +253,29 @@ module Hledger.Cli.Commands.Balance (
,multiBalanceReportAsHtml ,multiBalanceReportAsHtml
,multiBalanceReportHtmlRows ,multiBalanceReportHtmlRows
,multiBalanceReportHtmlFootRow ,multiBalanceReportHtmlFootRow
,balanceReportAsTable ,multiBalanceReportAsTable
,balanceReportTableAsText ,multiBalanceReportTableAsText
,tests_Balance ,tests_Balance
) where ) where
import Control.Arrow ((***))
import Data.Decimal (roundTo)
import Data.Default (def) import Data.Default (def)
import Data.List (transpose, transpose) import Data.Function (on)
import Data.List (find, transpose, foldl')
import qualified Data.Set as S import qualified Data.Set as S
import Data.Maybe (fromMaybe) import Data.Maybe (catMaybes, fromMaybe)
import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB import qualified Data.Text.Lazy.Builder as TB
import Data.Time (addDays, fromGregorian) import Data.Time (addDays, fromGregorian)
import System.Console.CmdArgs.Explicit as C import System.Console.CmdArgs.Explicit as C (flagNone, flagReq, flagOpt)
import Lucid as L hiding (value_) import Lucid as L hiding (value_)
import Safe (headMay, maximumMay) import Safe (headMay, maximumMay)
import Text.Tabular.AsciiWide import Text.Tabular.AsciiWide
(Align(..), Cell(..), Table(..), TableOpts(..), cellWidth, concatTables, (Header(..), Align(..), Properties(..), Cell(..), Table(..), TableOpts(..),
renderColumns, renderRowB, textCell) cellWidth, concatTables, renderColumns, renderRowB, renderTableByRowsB, textCell)
import qualified Text.Tabular.AsciiWide as Tab
import Hledger import Hledger
import Hledger.Cli.CliOptions import Hledger.Cli.CliOptions
@ -444,7 +447,7 @@ balanceReportAsCsv opts (items, total) =
balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
balanceReportAsText opts ((items, total)) = case layout_ opts of balanceReportAsText opts ((items, total)) = case layout_ opts of
LayoutBare | iscustom -> error' "Custom format not supported with commodity columns" -- PARTIAL: LayoutBare | iscustom -> error' "Custom format not supported with commodity columns" -- PARTIAL:
LayoutBare -> balanceReportAsText' opts ((items, total)) LayoutBare -> bareLayoutBalanceReportAsText opts ((items, total))
_ -> unlinesB ls <> unlinesB (if no_total_ opts then [] else [overline, totalLines]) _ -> unlinesB ls <> unlinesB (if no_total_ opts then [] else [overline, totalLines])
where where
(ls, sizes) = unzip $ map (balanceReportItemAsText opts) items (ls, sizes) = unzip $ map (balanceReportItemAsText opts) items
@ -460,11 +463,14 @@ balanceReportAsText opts ((items, total)) = case layout_ opts of
overlinewidth = if iscustom then sum (map maximum' $ transpose sizes) else 20 overlinewidth = if iscustom then sum (map maximum' $ transpose sizes) else 20
overline = TB.fromText $ T.replicate overlinewidth "-" overline = TB.fromText $ T.replicate overlinewidth "-"
-- | Render a single-column balance report as plain text in commodity-column mode -- | Render a single-column balance report as plain text with a separate commodity column (--layout=bare)
balanceReportAsText' :: ReportOpts -> BalanceReport -> TB.Builder bareLayoutBalanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder
balanceReportAsText' opts ((items, total)) = bareLayoutBalanceReportAsText opts ((items, total)) =
unlinesB . fmap (renderColumns def{tableBorders=False} sizes . Tab.Group Tab.NoLine . fmap Tab.Header) $ unlinesB .
ls ++ concat [[[overline], totalline] | not (no_total_ opts)] map
(renderColumns def{tableBorders=singleColumnTableOuterBorder} sizes .
Group singleColumnTableInterColumnBorder . map Header) $
ls ++ concat [[[overline], totalline] | not (no_total_ opts)]
where where
render (_, acctname, dep, amt) = render (_, acctname, dep, amt) =
[ Cell TopRight damts [ Cell TopRight damts
@ -479,6 +485,8 @@ balanceReportAsText' opts ((items, total)) =
sizes = fromMaybe 0 . maximumMay . map cellWidth <$> sizes = fromMaybe 0 . maximumMay . map cellWidth <$>
transpose ([totalline | not (no_total_ opts)] ++ ls) transpose ([totalline | not (no_total_ opts)] ++ ls)
overline = Cell TopLeft . pure . wbFromText . flip T.replicate "-" . fromMaybe 0 $ headMay sizes overline = Cell TopLeft . pure . wbFromText . flip T.replicate "-" . fromMaybe 0 $ headMay sizes
singleColumnTableOuterBorder = False
singleColumnTableInterColumnBorder = NoLine
{- {-
:r :r
@ -499,21 +507,31 @@ balanceReportItemAsText :: ReportOpts -> BalanceReportItem -> (TB.Builder, [Int]
balanceReportItemAsText opts (_, accountName, dep, amt) = balanceReportItemAsText opts (_, accountName, dep, amt) =
renderBalanceReportItem opts (accountName, dep, amt) renderBalanceReportItem opts (accountName, dep, amt)
-- | Render a balance report item using the given StringFormat, generating one or more lines of text. -- | Render a balance report item, using the StringFormat specified by --format.
--
renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> (TB.Builder, [Int]) renderBalanceReportItem :: ReportOpts -> (AccountName, Int, MixedAmount) -> (TB.Builder, [Int])
renderBalanceReportItem opts (acctname, dep, total) = renderBalanceReportItem opts (acctname, dep, total) =
case format_ opts of case format_ opts of
OneLine comps -> renderRow' $ render True True comps OneLine comps -> renderRowFromComponents $ renderComponents True True comps
TopAligned comps -> renderRow' $ render True False comps TopAligned comps -> renderRowFromComponents $ renderComponents True False comps
BottomAligned comps -> renderRow' $ render False False comps BottomAligned comps -> renderRowFromComponents $ renderComponents False False comps
where where
renderRow' is = ( renderRowB def{tableBorders=False, borderSpaces=False} -- Combine the rendered component cells horizontally, as a possibly multi-line text (builder),
. Tab.Group Tab.NoLine $ map Tab.Header is -- aligned in borderless columns (? XXX). Also returns the rendered width of each cell.
, map cellWidth is ) renderRowFromComponents :: [Cell] -> (TB.Builder, [Int])
renderRowFromComponents cs =
( renderRowB def{tableBorders=False, borderSpaces=False} . Group NoLine $ map Header cs
, map cellWidth cs
)
render topaligned oneline = map (renderComponent topaligned oneline opts (acctname, dep, total)) -- Render each of the given StringFormat components for the balance report item,
-- returning each as a Cell.
renderComponents :: Bool -> Bool -> [StringFormatComponent] -> [Cell]
renderComponents topaligned oneline = map (renderComponent topaligned oneline opts (acctname, dep, total))
-- | Render one StringFormat component for a balance report item. -- Render one StringFormat component for a balance report item.
-- Returns a Cell, containing 0 or more lines of text (as builders).
renderComponent :: Bool -> Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell renderComponent :: Bool -> Bool -> ReportOpts -> (AccountName, Int, MixedAmount) -> StringFormatComponent -> Cell
renderComponent _ _ _ _ (FormatLiteral s) = textCell TopLeft s renderComponent _ _ _ _ (FormatLiteral s) = textCell TopLeft s
renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljust mmin mmax field) = case field of renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljust mmin mmax field) = case field of
@ -545,12 +563,12 @@ multiBalanceReportAsCsv opts@ReportOpts{..} report = maybeTranspose allRows
allRows = case layout_ of allRows = case layout_ of
LayoutTidy -> rows -- tidy csv should not include totals or averages LayoutTidy -> rows -- tidy csv should not include totals or averages
_ -> rows ++ totals _ -> rows ++ totals
(rows, totals) = multiBalanceReportAsCsvOrHtml False opts report (rows, totals) = multiBalanceReportAsCsvHelper False opts report
maybeTranspose = if transpose_ then transpose else id maybeTranspose = if transpose_ then transpose else id
-- Helper used for both CSV and HTML rendering. -- Helper for CSV (and HTML) rendering.
multiBalanceReportAsCsvOrHtml :: Bool -> ReportOpts -> MultiBalanceReport -> (CSV, CSV) multiBalanceReportAsCsvHelper :: Bool -> ReportOpts -> MultiBalanceReport -> (CSV, CSV)
multiBalanceReportAsCsvOrHtml ishtml opts@ReportOpts{..} (PeriodicReport colspans items tr) = multiBalanceReportAsCsvHelper ishtml opts@ReportOpts{..} (PeriodicReport colspans items tr) =
(headers : concatMap fullRowAsTexts items, totalrows) (headers : concatMap fullRowAsTexts items, totalrows)
where where
headers = "account" : case layout_ of headers = "account" : case layout_ of
@ -558,9 +576,8 @@ multiBalanceReportAsCsvOrHtml ishtml opts@ReportOpts{..} (PeriodicReport colspan
LayoutBare -> "commodity" : dateHeaders LayoutBare -> "commodity" : dateHeaders
_ -> dateHeaders _ -> dateHeaders
dateHeaders = map showDateSpan colspans ++ ["total" | row_total_] ++ ["average" | average_] dateHeaders = map showDateSpan colspans ++ ["total" | row_total_] ++ ["average" | average_]
fullRowAsTexts row = map (showName row :) $ rowAsText opts colspans row fullRowAsTexts row = map (showName row :) $ rowAsText opts colspans row
showName = accountNameDrop drop_ . prrFullName where showName = accountNameDrop drop_ . prrFullName
totalrows totalrows
| no_total_ = mempty | no_total_ = mempty
| otherwise = map ("total" :) $ rowAsText opts colspans tr | otherwise = map ("total" :) $ rowAsText opts colspans tr
@ -585,7 +602,7 @@ multiBalanceReportHtmlRows ropts mbr =
-- TODO: should the commodity_column be displayed as a subaccount in this case as well? -- TODO: should the commodity_column be displayed as a subaccount in this case as well?
(headingsrow:bodyrows, mtotalsrows) (headingsrow:bodyrows, mtotalsrows)
| transpose_ ropts = error' "Sorry, --transpose with HTML output is not yet supported" -- PARTIAL: | transpose_ ropts = error' "Sorry, --transpose with HTML output is not yet supported" -- PARTIAL:
| otherwise = multiBalanceReportAsCsvOrHtml True ropts mbr | otherwise = multiBalanceReportAsCsvHelper True ropts mbr
in in
(multiBalanceReportHtmlHeadRow ropts headingsrow (multiBalanceReportHtmlHeadRow ropts headingsrow
,map (multiBalanceReportHtmlBodyRow ropts) bodyrows ,map (multiBalanceReportHtmlBodyRow ropts) bodyrows
@ -676,7 +693,7 @@ multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> TL.Text
multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $
TB.fromText title TB.fromText title
<> TB.fromText "\n\n" <> TB.fromText "\n\n"
<> balanceReportTableAsText ropts (balanceReportAsTable ropts r) <> multiBalanceReportTableAsText ropts (multiBalanceReportAsTable ropts r)
where where
title = mtitle <> " in " <> showDateSpan (periodicReportSpan r) <> valuationdesc <> ":" title = mtitle <> " in " <> showDateSpan (periodicReportSpan r) <> valuationdesc <> ":"
@ -707,14 +724,14 @@ multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $
_ -> False _ -> False
-- | Build a 'Table' from a multi-column balance report. -- | Build a 'Table' from a multi-column balance report.
balanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text WideBuilder multiBalanceReportAsTable :: ReportOpts -> MultiBalanceReport -> Table T.Text T.Text WideBuilder
balanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, balanceaccum_} multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, balanceaccum_}
(PeriodicReport spans items tr) = (PeriodicReport spans items tr) =
maybetranspose $ maybetranspose $
addtotalrow $ addtotalrow $
Table Table
(Tab.Group Tab.NoLine $ map Tab.Header (concat accts)) (Group multiColumnTableInterRowBorder $ map Header (concat accts))
(Tab.Group Tab.NoLine $ map Tab.Header colheadings) (Group multiColumnTableInterColumnBorder $ map Header colheadings)
(concat rows) (concat rows)
where where
totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical]
@ -732,11 +749,13 @@ balanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, balanc
| no_total_ opts = id | no_total_ opts = id
| otherwise = | otherwise =
let totalrows = multiBalanceRowAsTableText opts tr let totalrows = multiBalanceRowAsTableText opts tr
rh = Tab.Group Tab.NoLine . replicate (length totalrows) $ Tab.Header "" rowhdrs = Group NoLine . replicate (length totalrows) $ Header ""
ch = Tab.Header [] -- ignored colhdrs = Header [] -- unused, concatTables will discard
in (flip (concatTables Tab.SingleLine) $ Table rh ch totalrows) in (flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows)
maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals) maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals)
| otherwise = id | otherwise = id
multiColumnTableInterRowBorder = NoLine
multiColumnTableInterColumnBorder = NoLine
multiBalanceRowAsWbs :: AmountFormat -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] multiBalanceRowAsWbs :: AmountFormat -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]]
multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = multiBalanceRowAsWbs bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) =
@ -789,6 +808,321 @@ multiBalanceRowAsHtmlText opts colspans = fmap (fmap wbToText) . multiBalanceRow
multiBalanceRowAsTableText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] multiBalanceRowAsTableText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]]
multiBalanceRowAsTableText opts = multiBalanceRowAsWbs oneLineNoCostFmt{displayColour=color_ opts} opts [] multiBalanceRowAsTableText opts = multiBalanceRowAsWbs oneLineNoCostFmt{displayColour=color_ opts} opts []
-- | Given a table representing a multi-column balance report,
-- render it in a format suitable for console output.
-- Amounts with more than two commodities will be elided unless --no-elide is used.
multiBalanceReportTableAsText :: ReportOpts -> Table T.Text T.Text WideBuilder -> TB.Builder
multiBalanceReportTableAsText ReportOpts{..} = renderTableByRowsB tableopts renderCh renderRow
where
tableopts = def{tableBorders=multiColumnTableOuterBorder, prettyTable=pretty_}
multiColumnTableOuterBorder = False
renderCh :: [Text] -> [Cell]
renderCh
| layout_ /= LayoutBare || transpose_ = fmap (textCell TopRight)
| otherwise = zipWith ($) (textCell TopLeft : repeat (textCell TopRight))
renderRow :: (Text, [WideBuilder]) -> (Cell, [Cell])
renderRow (rh, row)
| layout_ /= LayoutBare || transpose_ =
(textCell TopLeft rh, fmap (Cell TopRight . pure) row)
| otherwise =
(textCell TopLeft rh, zipWith ($) (Cell TopLeft : repeat (Cell TopRight)) (fmap pure row))
-- A BudgetCell's data values rendered for display - the actual change amount,
-- the budget goal amount if any, and the corresponding goal percentage if possible.
type BudgetDisplayCell = (WideBuilder, Maybe (WideBuilder, Maybe WideBuilder))
-- | A row of rendered budget data cells.
type BudgetDisplayRow = [BudgetDisplayCell]
-- | An amount render helper for the budget report. Renders each commodity separately.
type BudgetShowAmountsFn = MixedAmount -> [WideBuilder]
-- | A goal percentage calculating helper for the budget report.
type BudgetCalcPercentagesFn = Change -> BudgetGoal -> [Maybe Percentage]
-- | 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" <>
multiBalanceReportTableAsText ropts (budgetReportAsTable ropts budgetr)
where
title = "Budget performance in " <> showDateSpan (periodicReportSpan budgetr)
<> (case conversionop_ of
Just ToCost -> ", converted to cost"
_ -> "")
<> (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 -> "")
<> ":"
-- | Build a 'Table' from a multi-column balance report.
budgetReportAsTable :: ReportOpts -> BudgetReport -> Table Text Text WideBuilder
budgetReportAsTable ReportOpts{..} (PeriodicReport spans items totrow) =
maybetransposetable $
addtotalrow $
Table
(Group NoLine $ map Header accts)
(Group NoLine $ map Header colheadings)
rows
where
maybetransposetable
| transpose_ = \(Table rh ch vals) -> Table ch rh (transpose vals)
| otherwise = id
addtotalrow
| no_total_ = id
| otherwise =
let
rowhdrs = Group NoLine . replicate (length totalrows) $ Header ""
colhdrs = Header [] -- ignored by concatTables
in
(flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows) -- XXX ?
colheadings = ["Commodity" | layout_ == LayoutBare]
++ map (reportPeriodName balanceaccum_ spans) spans
++ [" Total" | row_total_]
++ ["Average" | average_]
(accts, rows, totalrows) =
(accts'
,maybecommcol itemscs $ showcells texts
,maybecommcol totrowcs $ showtotrow totrowtexts)
where
-- If --layout=bare, prepend a commodities column.
maybecommcol :: [WideBuilder] -> [[WideBuilder]] -> [[WideBuilder]]
maybecommcol cs
| layout_ == LayoutBare = zipWith (:) cs
| otherwise = id
showcells, showtotrow :: [[BudgetDisplayCell]] -> [[WideBuilder]]
(showcells, showtotrow) =
(maybetranspose . map (zipWith showBudgetDisplayCell widths) . maybetranspose
,maybetranspose . map (zipWith showBudgetDisplayCell totrowwidths) . maybetranspose)
where
-- | Combine a BudgetDisplayCell's rendered values into a "[PERCENT of GOAL]" rendering,
-- respecting the given widths.
showBudgetDisplayCell :: (Int, Int, Int) -> BudgetDisplayCell -> WideBuilder
showBudgetDisplayCell (actualwidth, budgetwidth, percentwidth) (actual, mbudget) =
flip WideBuilder (actualwidth + totalbudgetwidth) $
toPadded actual <> maybe emptycell showBudgetGoalAndPercentage mbudget
where
toPadded (WideBuilder b w) = (TB.fromText . flip T.replicate " " $ actualwidth - w) <> b
(totalpercentwidth, totalbudgetwidth) =
let totalpercentwidth' = if percentwidth == 0 then 0 else percentwidth + 5
in ( totalpercentwidth'
, if budgetwidth == 0 then 0 else budgetwidth + totalpercentwidth' + 3
)
emptycell :: TB.Builder
emptycell = TB.fromText $ T.replicate totalbudgetwidth " "
showBudgetGoalAndPercentage :: (WideBuilder, Maybe WideBuilder) -> TB.Builder
showBudgetGoalAndPercentage (goal, perc) =
let perct = case perc of
Nothing -> T.replicate totalpercentwidth " "
Just pct -> T.replicate (percentwidth - wbWidth pct) " " <> wbToText pct <> "% of "
in TB.fromText $ " [" <> perct <> T.replicate (budgetwidth - wbWidth goal) " " <> wbToText goal <> "]"
-- | Build a list of widths for each column.
-- When --transpose is used, the totals row must be included in this list.
widths :: [(Int, Int, Int)]
widths = zip3 actualwidths budgetwidths percentwidths
where
actualwidths = map (maximum' . map first3 ) $ cols
budgetwidths = map (maximum' . map second3) $ cols
percentwidths = map (maximum' . map third3 ) $ cols
catcolumnwidths = foldl' (zipWith (++)) $ repeat []
cols = maybetranspose $ catcolumnwidths $ map (cellswidth . rowToBudgetCells) items ++ [cellswidth $ rowToBudgetCells totrow]
cellswidth :: [BudgetCell] -> [[(Int, Int, Int)]]
cellswidth row =
let cs = budgetCellsCommodities row
(showmixed, percbudget) = mkBudgetDisplayFns cs
disp = showcell showmixed percbudget
budgetpercwidth = wbWidth *** maybe 0 wbWidth
cellwidth (am, bm) = let (bw, pw) = maybe (0, 0) budgetpercwidth bm in (wbWidth am, bw, pw)
in map (map cellwidth . disp) row
totrowwidths :: [(Int, Int, Int)]
totrowwidths
| transpose_ = drop (length texts) widths
| otherwise = widths
maybetranspose
| transpose_ = transpose
| otherwise = id
(accts', itemscs, texts) = unzip3 $ concat shownitems
where
shownitems :: [[(AccountName, WideBuilder, BudgetDisplayRow)]]
shownitems =
map (\i ->
let
addacctcolumn = map (\(cs, cvals) -> (renderacct i, cs, cvals))
isunbudgetedrow = displayFull (prrName i) == unbudgetedAccountName
in addacctcolumn $ showrow isunbudgetedrow $ rowToBudgetCells i)
items
where
-- 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_ of
ALTree -> T.replicate ((prrDepth row - 1)*2) " " <> prrDisplayName row
ALFlat -> accountNameDrop (drop_) $ prrFullName row
(totrowcs, totrowtexts) = unzip $ concat showntotrow
where
showntotrow :: [[(WideBuilder, BudgetDisplayRow)]]
showntotrow = [showrow False $ rowToBudgetCells totrow]
-- | Get the data cells from a row or totals row, maybe adding
-- the row total and/or row average depending on options.
rowToBudgetCells :: PeriodicReportRow a BudgetCell -> [BudgetCell]
rowToBudgetCells (PeriodicReportRow _ as rowtot rowavg) = as
++ [rowtot | row_total_ && not (null as)]
++ [rowavg | average_ && not (null as)]
-- | Render a row's data cells as "BudgetDisplayCell"s, and a rendered list of commodity symbols.
-- Also requires a flag indicating whether this is the special <unbudgeted> row.
-- (The types make that hard to check here.)
showrow :: Bool -> [BudgetCell] -> [(WideBuilder, BudgetDisplayRow)]
showrow isunbudgetedrow cells =
let
cs = budgetCellsCommodities cells
-- #2071 If there are no commodities - because there are no actual or goal amounts -
-- the zipped list would be empty, causing this row not to be shown.
-- But rows like this sometimes need to be shown to preserve the account tree structure.
-- So, ensure 0 will be shown as actual amount(s).
-- Unfortunately this disables boring parent eliding, as if --no-elide had been used.
-- (Just turning on --no-elide higher up doesn't work right.)
-- Note, no goal amount will be shown for these rows,
-- whereas --no-elide is likely to show a goal amount aggregated from children.
cs1 = if null cs && not isunbudgetedrow then [""] else cs
(showmixed, percbudget) = mkBudgetDisplayFns cs1
in
zip (map wbFromText cs1) $
transpose $
map (showcell showmixed percbudget)
cells
budgetCellsCommodities :: [BudgetCell] -> [CommoditySymbol]
budgetCellsCommodities = S.toList . foldl' S.union mempty . map budgetCellCommodities
where
budgetCellCommodities :: BudgetCell -> S.Set CommoditySymbol
budgetCellCommodities (am, bm) = f am `S.union` f bm
where f = maybe mempty maCommodities
-- | Render a "BudgetCell"'s amounts as "BudgetDisplayCell"s (one per commodity).
showcell :: BudgetShowAmountsFn -> BudgetCalcPercentagesFn -> BudgetCell -> BudgetDisplayRow
showcell showCommodityAmounts calcCommodityPercentages (mactual, mbudget) =
zip actualamts budgetinfos
where
actual = fromMaybe nullmixedamt mactual
actualamts = showCommodityAmounts actual
budgetinfos =
case mbudget of
Nothing -> repeat Nothing
Just goal -> map Just $ showGoalAmountsAndPercentages goal
where
showGoalAmountsAndPercentages :: MixedAmount -> [(WideBuilder, Maybe WideBuilder)]
showGoalAmountsAndPercentages goal = zip amts mpcts
where
amts = showCommodityAmounts goal
mpcts = map (showrounded <$>) $ calcCommodityPercentages actual goal
where showrounded = wbFromText . T.pack . show . roundTo 0
-- | Make budget info display helpers that adapt to --layout=wide.
mkBudgetDisplayFns :: [CommoditySymbol] -> (BudgetShowAmountsFn, BudgetCalcPercentagesFn)
mkBudgetDisplayFns cs = case layout_ of
LayoutWide width ->
( pure . showMixedAmountB oneLineNoCostFmt{displayMaxWidth=width, displayColour=color_}
, \a -> pure . percentage a)
_ -> ( showMixedAmountLinesB noCostFmt{displayCommodity=layout_/=LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing, displayColour=color_}
, \a b -> map (percentage' a b) cs)
where
-- | 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
_ -> Nothing
where
costedAmounts = case conversionop_ of
Just ToCost -> amounts . mixedAmountCost
_ -> amounts
-- | Like percentage, but accept multicommodity actual and budget amounts,
-- and extract the specified commodity from both.
percentage' :: Change -> BudgetGoal -> 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
-- XXX generalise this with multiBalanceReportAsCsv ?
-- | Render a budget report as CSV. Like multiBalanceReportAsCsv,
-- but includes alternating actual and budget amount columns.
budgetReportAsCsv :: ReportOpts -> BudgetReport -> [[Text]]
budgetReportAsCsv
ReportOpts{..}
(PeriodicReport colspans items totrow)
= (if transpose_ then transpose else id) $
-- heading row
("Account" :
["Commodity" | layout_ == LayoutBare ]
++ concatMap (\spn -> [showDateSpan spn, "budget"]) colspans
++ concat [["Total" ,"budget"] | row_total_]
++ concat [["Average","budget"] | average_]
) :
-- account rows
concatMap (rowAsTexts prrFullName) items
-- totals row
++ concat [ rowAsTexts (const "Total:") totrow | not no_total_ ]
where
flattentuples tups = concat [[a,b] | (a,b) <- tups]
showNorm = maybe "" (wbToText . showMixedAmountB oneLineNoCostFmt)
rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text)
-> PeriodicReportRow a BudgetCell
-> [[Text]]
rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg))
| layout_ /= LayoutBare = [render row : map showNorm vals]
| otherwise =
joinNames . zipWith (:) cs -- add symbols and names
. transpose -- each row becomes a list of Text quantities
. map (map wbToText . showMixedAmountLinesB dopts . fromMaybe nullmixedamt)
$ vals
where
cs = S.toList . foldl' S.union mempty . map maCommodities $ catMaybes vals
dopts = oneLineNoCostFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing}
vals = flattentuples as
++ concat [[rowtot, budgettot] | row_total_]
++ concat [[rowavg, budgetavg] | average_]
joinNames = map (render row :)
-- tests
tests_Balance = testGroup "Balance" [ tests_Balance = testGroup "Balance" [
testGroup "balanceReportAsText" [ testGroup "balanceReportAsText" [

4
hledger/Hledger/Cli/Commands/Roi.hs
View File

@ -325,10 +325,10 @@ interestSum referenceDay cf rate = sum $ map go cf
calculateCashFlow :: WhichDate -> [Transaction] -> Query -> CashFlow calculateCashFlow :: WhichDate -> [Transaction] -> Query -> CashFlow
calculateCashFlow wd trans query = calculateCashFlow wd trans query =
[ (postingDateOrDate2 wd p, pamount p) | p <- filter (matchesPosting query) (concatMap realPostings trans), maIsNonZero (pamount p) ] [ (postingDateOrDate2 wd p, pamount p) | p <- concatMap (filter (matchesPosting query) . realPostings) trans, maIsNonZero (pamount p) ]
total :: [Transaction] -> Query -> MixedAmount total :: [Transaction] -> Query -> MixedAmount
total trans query = sumPostings . filter (matchesPosting query) $ concatMap realPostings trans total trans query = sumPostings (concatMap (filter (matchesPosting query) . realPostings) trans)
unMix :: MixedAmount -> Quantity unMix :: MixedAmount -> Quantity
unMix a = unMix a =

14
hledger/Hledger/Cli/CompoundBalanceCommand.hs
View File

@ -218,7 +218,7 @@ compoundBalanceReportAsText :: ReportOpts -> CompoundPeriodicReport DisplayName
compoundBalanceReportAsText ropts (CompoundPeriodicReport title _colspans subreports totalsrow) = compoundBalanceReportAsText ropts (CompoundPeriodicReport title _colspans subreports totalsrow) =
TB.toLazyText $ TB.toLazyText $
TB.fromText title <> TB.fromText "\n\n" <> TB.fromText title <> TB.fromText "\n\n" <>
balanceReportTableAsText ropts bigtablewithtotalsrow multiBalanceReportTableAsText ropts bigtablewithtotalsrow
where where
bigtable = bigtable =
case map (subreportAsTable ropts) subreports of case map (subreportAsTable ropts) subreports of
@ -243,7 +243,7 @@ compoundBalanceReportAsText ropts (CompoundPeriodicReport title _colspans subrep
-- [COL1LINE2, COL2LINE2] -- [COL1LINE2, COL2LINE2]
-- ] -- ]
coltotalslines = multiBalanceRowAsTableText ropts totalsrow coltotalslines = multiBalanceRowAsTableText ropts totalsrow
totalstable = Table totalstable = Table
(Group NoLine $ map Header $ "Net:" : replicate (length coltotalslines - 1) "") -- row headers (Group NoLine $ map Header $ "Net:" : replicate (length coltotalslines - 1) "") -- row headers
(Header []) -- column headers, concatTables will discard these (Header []) -- column headers, concatTables will discard these
coltotalslines -- cell values coltotalslines -- cell values
@ -257,11 +257,11 @@ compoundBalanceReportAsText ropts (CompoundPeriodicReport title _colspans subrep
tophdrs -- column headers tophdrs -- column headers
([]:cells) -- cell values ([]:cells) -- cell values
where where
Table lefthdrs tophdrs cells = balanceReportAsTable ropts1 r Table lefthdrs tophdrs cells = multiBalanceReportAsTable ropts1 r
tableSubreportTitleBottomBorder = SingleLine tableSubreportTitleBottomBorder = SingleLine
tableInterSubreportBorder = DoubleLine tableInterSubreportBorder = DoubleLine
tableGrandTotalsTopBorder = DoubleLine tableGrandTotalsTopBorder = DoubleLine
-- | Render a compound balance report as CSV. -- | Render a compound balance report as CSV.
-- Subreports' CSV is concatenated, with the headings rows replaced by a -- Subreports' CSV is concatenated, with the headings rows replaced by a
@ -296,7 +296,7 @@ compoundBalanceReportAsCsv ropts (CompoundPeriodicReport title colspans subrepor
map (length . prDates . second3) subreports map (length . prDates . second3) subreports
addtotals addtotals
| no_total_ ropts || length subreports == 1 = id | no_total_ ropts || length subreports == 1 = id
| otherwise = (++ fmap ("Net:" : ) (multiBalanceRowAsCsvText ropts colspans totalrow)) | otherwise = (++ map ("Net:" : ) (multiBalanceRowAsCsvText ropts colspans totalrow))
-- | Render a compound balance report as HTML. -- | Render a compound balance report as HTML.
compoundBalanceReportAsHtml :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> Html () compoundBalanceReportAsHtml :: ReportOpts -> CompoundPeriodicReport DisplayName MixedAmount -> Html ()