Skip to content

Balance.Internal: new module for internal functions #2745

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
simonmichael merged 1 commit into from
Sep 24, 2026
Merged

Balance.Internal: new module for internal functions #2745

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions hledger-web/Hledger/Web/Handler/BalanceR.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -99,8 +99,7 @@ getBalanceR = do
let mbr = styleAmounts (journalCommodityStylesWith HardRounding j) $
multiBalanceReport rspec j
in ( maybe (trimColon $ Balance.multiBalanceReportTitle ropts mbr) id (title_ ropts)
, Balance.multiBalanceReportAsSpreadsheetParts oneLineNoCostFmt ropts
(Balance.allCommoditiesFromPeriodicReport $ prRows mbr) mbr
, Balance.multiBalanceReportAsSpreadsheetParts oneLineNoCostFmt ropts mbr
)
Yesod.toWidget $ H.h2 $ H.toHtml $ title <> filtered
Yesod.toWidget $ balanceReportLinks BalanceR qparam spn reportinterval
Expand Down
282 changes: 9 additions & 273 deletions hledger/Hledger/Cli/Commands/Balance.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -255,7 +255,6 @@ module Hledger.Cli.Commands.Balance (
,budgetReportAsCsv
,budgetReportAsHtml
,budgetReportAsSpreadsheet
,multiBalanceRowAsCellBuilders
,multiBalanceRowAsCsvText
,multiBalanceRowAsText
,multiBalanceReportAsText
Expand All @@ -266,17 +265,9 @@ module Hledger.Cli.Commands.Balance (
,multiBalanceReportTableAsText
,multiBalanceReportAsSpreadsheet
,multiBalanceReportAsSpreadsheetParts
,allCommoditiesFromPeriodicReport
,multiBalanceReportTitle
,multiBalanceReportNumHeaderColumns
,multiBalanceHasTotalsColumn
,renderPeriodicAcct
,addTotalBorders
,simpleDateSpanCell
,tidyColumnLabels
,nbsp
,RowClass(..)
,accountClass
-- ** Tests
,tests_Balance
) where
Expand All @@ -301,7 +292,7 @@ import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Lazy qualified as TL
import Data.Text.Lazy.Builder qualified as TB
import Data.Time (addDays, fromGregorian)
import Data.Time (fromGregorian)
import System.Console.CmdArgs.Explicit as C (flagNone, flagReq, flagOpt)
import Safe (headMay, maximumMay)
import Text.Tabular.AsciiWide
Expand All @@ -313,7 +304,8 @@ import System.IO qualified as IO
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Cli.Anchor (setAccountAnchor, dateSpanCell, headerDateSpanCell, renderPeriodHeading)
import Hledger.Cli.Anchor (setAccountAnchor, renderPeriodHeading)
import Hledger.Cli.Commands.Balance.Internal
import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Ods (printFods)
import Hledger.Write.Html (Html, titledTableHtml, htmlAsLazyText, toHtml)
Expand Down Expand Up @@ -453,32 +445,11 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ ropts of

-- Rendering

accountClass :: Ods.Class
accountClass = Ods.Class "account"

data RowClass = Value | Total
deriving (Eq, Ord, Enum, Bounded, Show)

amountClass :: RowClass -> Ods.Class
amountClass rc =
Ods.Class $
case rc of Value -> "amount"; Total -> "amount coltotal"

budgetClass :: RowClass -> Ods.Class
budgetClass rc =
Ods.Class $
case rc of Value -> "budget"; Total -> "budget coltotal"

rowTotalClass :: RowClass -> Ods.Class
rowTotalClass rc =
Ods.Class $
case rc of Value -> "amount rowtotal"; Total -> "amount coltotal"

rowAverageClass :: RowClass -> Ods.Class
rowAverageClass rc =
Ods.Class $
case rc of Value -> "amount rowaverage"; Total -> "amount colaverage"

budgetTotalClass :: RowClass -> Ods.Class
budgetTotalClass rc =
Ods.Class $
Expand All @@ -489,12 +460,6 @@ budgetAverageClass rc =
Ods.Class $
case rc of Value -> "budget rowaverage"; Total -> "budget colaverage"

-- What to show as heading for the totals row in balance reports ?
-- Currently nothing in terminal, Total: in HTML, FODS and xSV output.
totalRowHeadingText = ""
totalRowHeadingSpreadsheet = "Total:"
totalRowHeadingBudgetText = ""
totalRowHeadingBudgetCsv = "Total:"

-- Single-column balance reports

Expand Down Expand Up @@ -672,24 +637,6 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus
}


headerWithoutBorders :: [Ods.Cell () text] -> [Ods.Cell Ods.NumLines text]
headerWithoutBorders = map (\c -> c {Ods.cellBorder = Ods.noBorder})

simpleDateSpanCell :: PeriodTitles -> DateSpan -> Ods.Cell Ods.NumLines Text
simpleDateSpanCell ph = Ods.defaultCell . renderPeriodHeading ph

addTotalBorders ::
(Functor f) =>
[f (Ods.Cell border text)] -> [f (Ods.Cell Ods.NumLines text)]
addTotalBorders =
zipWith
(\border ->
fmap (\c -> c {
Ods.cellStyle = Ods.Body Ods.Total,
Ods.cellBorder = Ods.noBorder {Ods.borderTop = border}}))
(Ods.DoubleLine : repeat Ods.NoLine)


-- | Render a single-column balance report as HTML.
-- This report has no default heading, so one is shown only with --title.
balanceReportAsHtml :: ReportOpts -> BalanceReport -> Html
Expand Down Expand Up @@ -780,8 +727,7 @@ multiBalanceReportAsCsv opts@ReportOpts{..} report =
rawTableContent $ header ++ body ++ totals
where
(header, body, totals) =
multiBalanceReportAsSpreadsheetParts machineFmt opts
(allCommoditiesFromPeriodicReport $ prRows report) report
multiBalanceReportAsSpreadsheetParts machineFmt opts report


multiBalanceReportNumHeaderColumns :: Layout -> Int
Expand All @@ -794,59 +740,13 @@ multiBalanceReportNumHeaderColumns lay =
-- | Render the Spreadsheet table rows (CSV, ODS, HTML) for a MultiBalanceReport.
-- Returns the heading rows, 0 or more body rows, and the totals row if enabled.
multiBalanceReportAsSpreadsheetParts ::
AmountFormat -> ReportOpts ->
[CommoditySymbol] -> MultiBalanceReport ->
AmountFormat -> ReportOpts -> MultiBalanceReport ->
([[Ods.Cell Ods.NumLines Text]],
[[Ods.Cell Ods.NumLines Text]],
[[Ods.Cell Ods.NumLines Text]])
multiBalanceReportAsSpreadsheetParts fmt opts@ReportOpts{..}
allCommodities (PeriodicReport colspans items tr) =
(allHeaders, concatMap fullRowAsTexts items, addTotalBorders totalrows)
where
accountCell label = (Ods.defaultCell label) {Ods.cellClass = accountClass}
hCell cls label = (headerCell label) {Ods.cellClass = cls}
allHeaders =
case layout_ of
LayoutBareWide ->
[headerWithoutBorders $
Ods.emptyCell :
concatMap (Ods.horizontalSpan allCommodities) dateHeaders,
headers]
_ -> [headers]
headers =
addHeaderBorders $
hCell accountClass "account" :
case layout_ of
LayoutTidy -> map headerCell tidyColumnLabels
LayoutBareWide -> dateHeaders >> map headerCell allCommodities
LayoutBare -> headerCell "commodity" : dateHeaders
_ -> dateHeaders
-- The headings over columns of figures are marked as such, so that a
-- stylesheet can align them with the figures below (cf amountClass).
amountHeader c = c{Ods.cellClass = amountClass Value}
dateHeaders =
(if not summary_only_ then map (amountHeader . headerDateSpanCell period_titles_ balance_base_url_ querystring_) colspans else [] )++
[hCell (rowTotalClass Value) "total" | multiBalanceHasTotalsColumn opts] ++
[hCell (rowAverageClass Value) "average" | average_]
fullRowAsTexts row =
addRowSpanHeader anchorCell $
rowAsText Value (dateSpanCell period_titles_ balance_base_url_ querystring_ acctName) row
where acctName = prrFullName row
anchorCell =
setAccountAnchor balance_base_url_ querystring_ acctName $
accountCell $ renderPeriodicAcct opts nbsp row
totalrows =
if no_total_
then []
else addRowSpanHeader (accountCell totalRowHeadingSpreadsheet) $
rowAsText Total (simpleDateSpanCell period_titles_) tr
rowAsText rc dsCell =
map (map (fmap wbToText)) .
multiBalanceRowAsCellBuilders fmt opts colspans allCommodities rc dsCell

tidyColumnLabels :: [Text]
tidyColumnLabels =
["period", "start_date", "end_date", "commodity", "value"]
multiBalanceReportAsSpreadsheetParts fmt opts mbr =
balanceSubReportAsSpreadsheetParts fmt opts
(allCommoditiesFromPeriodicReport $ prRows mbr) mbr


-- | Render a multi-column balance report as HTML.
Expand All @@ -862,8 +762,7 @@ multiBalanceReportAsSpreadsheet ::
((Int, Int), [[Ods.Cell Ods.NumLines Text]])
multiBalanceReportAsSpreadsheet ropts mbr =
let (header,body,total) =
multiBalanceReportAsSpreadsheetParts oneLineNoCostFmt ropts
(allCommoditiesFromPeriodicReport $ prRows mbr) mbr
multiBalanceReportAsSpreadsheetParts oneLineNoCostFmt ropts mbr
in (if transpose_ ropts then swap *** Ods.transpose else id) $
((length header, multiBalanceReportNumHeaderColumns (layout_ ropts)),
header ++ body ++ total)
Expand Down Expand Up @@ -943,130 +842,6 @@ multiBalanceReportAsTable opts report@(PeriodicReport _spans items _tr) =
(allCommoditiesFromPeriodicReport items)
report

multiBalanceReportAsPartTable ::
ReportOpts -> [CommoditySymbol] -> MultiBalanceReport ->
Table T.Text T.Text WideBuilder
multiBalanceReportAsPartTable
opts@ReportOpts{summary_only_, average_, balanceaccum_}
allCommodities
(PeriodicReport spans items tr) =
maybetranspose $
addtotalrow $
Table
(Group multiColumnTableInterRowBorder $ map Header $ concat accts)
(Group multiColumnTableInterColumnBorder $ map Header colheadings)
(concat rows)
where
colheadings =
["Commodity" | layout_ opts == LayoutBare]
++
case layout_ opts of
LayoutBareWide ->
liftA2 (\s c -> T.concat [s, " (", c, ")"])
spanNames allCommodities
_ -> spanNames
spanNames =
(guard (not summary_only_) >>
map (reportPeriodName (period_titles_ opts) balanceaccum_ spans) spans)
++ [" Total" | multiBalanceHasTotalsColumn opts]
++ ["Average" | average_]
(accts, rows) = unzip $ fmap fullRowAsTexts items'
where
isLeaf rs row = not $ any (\r -> T.isPrefixOf (displayFull (prrName row) <> ":") (displayFull (prrName r))) rs
items' = if transpose_ opts && tree_ opts
then filter (isLeaf items) items
else items
fullRowAsTexts row = (replicate (length rs) (renderacct row), rs)
where
rs = multiBalanceRowAsText opts allCommodities row
renderacct row' = renderPeriodicAcct opts " " row'
addtotalrow
| no_total_ opts = id
| otherwise =
let totalrows = multiBalanceRowAsText opts allCommodities tr
rowhdrs = Group NoLine $ map Header $ totalRowHeadingText : replicate (length totalrows - 1) ""
colhdrs = Header [] -- unused, concatTables will discard
in (flip (concatTables SingleLine) $ Table rowhdrs colhdrs totalrows)
maybetranspose | transpose_ opts = \(Table rh ch vals) -> Table ch rh (transpose vals)
| otherwise = id
multiColumnTableInterRowBorder = NoLine
multiColumnTableInterColumnBorder = if pretty_ opts then SingleLine else NoLine

-- | All commodities appearing in these report rows, sorted.
-- Used as the commodity column order for LayoutBareWide; it must cover
-- every row rendered, see 'setDisplayCommodityBare'.
allCommoditiesFromPeriodicReport ::
[PeriodicReportRow a MixedAmount] -> [CommoditySymbol]
allCommoditiesFromPeriodicReport =
S.toAscList . foldMap (foldMap maCommodities . prrAmounts)

multiBalanceRowAsCellBuilders ::
AmountFormat -> ReportOpts -> [DateSpan] -> [CommoditySymbol] ->
RowClass -> (DateSpan -> Ods.Cell Ods.NumLines Text) ->
PeriodicReportRow a MixedAmount ->
[[Ods.Cell Ods.NumLines WideBuilder]]
multiBalanceRowAsCellBuilders bopts ropts@ReportOpts{..} colspans allCommodities
rc renderDateSpanCell (PeriodicReportRow _acct as rowtot rowavg) =
case layout_ of
LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) clsamts]
LayoutTall -> paddedTranspose Ods.emptyCell
. map (cellsFromMixedAmount bopts{displayMaxWidth=Nothing})
$ clsamts
LayoutBare -> zipWith (:) (map wbCell cs) -- add symbols
. transpose -- each row becomes a list of Text quantities
. map (cellsFromMixedAmount (setDisplayCommodityBare cs bopts))
$ clsamts
LayoutBareWide -> [concatMap (cellsFromMixedAmount (setDisplayCommodityBare allCommodities bopts))
$ clsamts]
LayoutTidy -> concat
. zipWith (map . addDateColumns) colspans
. map ( zipWith (\c a -> [wbCell c, a]) cs
. cellsFromMixedAmount (setDisplayCommodityBare cs bopts))
$ classified
-- Do not include totals column or average for tidy output, as this
-- complicates the data representation and can be easily calculated
where
wbCell = Ods.defaultCell . wbFromText
wbDate content = (wbCell content) {Ods.cellType = Ods.TypeDate}
cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts
classified = map ((,) (amountClass rc)) as
allamts = map snd clsamts
clsamts = (if not summary_only_ then classified else []) ++
[(rowTotalClass rc, rowtot) |
multiBalanceHasTotalsColumn ropts && not (null as)] ++
[(rowAverageClass rc, rowavg) | average_ && not (null as)]
addDateColumns spn@(DateSpan s e) remCols =
(wbFromText <$> renderDateSpanCell spn) :
wbDate (maybe "" showEFDate s) :
wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :
remCols

paddedTranspose :: a -> [[a]] -> [[a]]
paddedTranspose _ [] = [[]]
paddedTranspose n as1 = take (maximum . map length $ as1) . trans $ as1
where
trans ([] : xss) = (n : map h xss) : trans ([n] : map t xss)
trans ((x : xs) : xss) = (x : map h xss) : trans (m xs : map t xss)
trans [] = []
h (x:_) = x
h [] = n
t (_:xs) = xs
t [] = [n]
m (x:xs) = x:xs
m [] = [n]


multiBalanceHasTotalsColumn :: ReportOpts -> Bool
multiBalanceHasTotalsColumn ropts =
row_total_ ropts && balanceaccum_ ropts `notElem` [Cumulative, Historical]

multiBalanceRowAsText ::
ReportOpts -> [CommoditySymbol] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]]
multiBalanceRowAsText opts allCommodities =
rawTableContent .
multiBalanceRowAsCellBuilders oneLineNoCostFmt{displayColour=color_ opts}
opts [] allCommodities
Value (simpleDateSpanCell $ period_titles_ opts)

multiBalanceRowAsCsvText ::
ReportOpts -> [DateSpan] -> [CommoditySymbol] ->
Expand Down Expand Up @@ -1443,45 +1218,6 @@ unsupportedLayout :: Layout -> a -> a
unsupportedLayout lay =
error' $ show lay ++ " not supported for the chosen output format."

-- | Adjust an amount format for bare layouts, which show commodity symbols
-- in their own column(s): hide the symbols and show amounts in the given
-- commodity order.
--
-- Caution: the order list must include every commodity that will be
-- rendered with this format. 'orderedAmounts' renders exactly one amount
-- per listed commodity, so an amount whose commodity is missing from the
-- list is silently dropped (a listed commodity with no amount shows as zero).
-- For LayoutBareWide the list is the whole report's commodities, gathered by
-- 'allCommoditiesFromPeriodicReport' or 'allCommoditiesFromSubreports';
-- for LayoutBare and LayoutTidy it is the row's own commodities.
setDisplayCommodityBare :: [CommoditySymbol] -> AmountFormat -> AmountFormat
setDisplayCommodityBare cs fmt =
fmt{
displayCommodity = False,
displayCommodityOrder = Just cs,
displayMinWidth = Nothing
}


nbsp :: Text
nbsp = "\160"

renderBalanceAcct ::
ReportOpts -> Text -> (AccountName, AccountName, Int) -> Text
renderBalanceAcct opts space (fullName, displayName, dep) =
if accountlistmode_ opts == ALTree && not (full_names_ opts)
then T.replicate (dep*2) space <> displayName
else accountNameDrop (drop_ opts) fullName

-- FIXME. Have to check explicitly for which to render here, since
-- budgetReport sets accountlistmode to ALTree. Find a principled way to do
-- this.
renderPeriodicAcct ::
ReportOpts -> Text -> PeriodicReportRow DisplayName a -> Text
renderPeriodicAcct opts space row =
renderBalanceAcct opts space
(prrFullName row, prrDisplayName row, prrIndent row)


-- tests

Expand Down
Loading