diff --git a/hledger-web/Hledger/Web/Handler/BalanceR.hs b/hledger-web/Hledger/Web/Handler/BalanceR.hs index 68713931a56..0c51c1be7e3 100644 --- a/hledger-web/Hledger/Web/Handler/BalanceR.hs +++ b/hledger-web/Hledger/Web/Handler/BalanceR.hs @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 287148f52f7..cb109a52472 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -255,7 +255,6 @@ module Hledger.Cli.Commands.Balance ( ,budgetReportAsCsv ,budgetReportAsHtml ,budgetReportAsSpreadsheet - ,multiBalanceRowAsCellBuilders ,multiBalanceRowAsCsvText ,multiBalanceRowAsText ,multiBalanceReportAsText @@ -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 @@ -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 @@ -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) @@ -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 $ @@ -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 @@ -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 @@ -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 @@ -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. @@ -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) @@ -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] -> @@ -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 diff --git a/hledger/Hledger/Cli/Commands/Balance/Internal.hs b/hledger/Hledger/Cli/Commands/Balance/Internal.hs new file mode 100644 index 00000000000..7de62bc5410 --- /dev/null +++ b/hledger/Hledger/Cli/Commands/Balance/Internal.hs @@ -0,0 +1,302 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE RecordWildCards #-} + +module Hledger.Cli.Commands.Balance.Internal where + +import Control.Monad (guard) +import Data.List (transpose) +import Data.Set qualified as S +import Data.Text (Text) +import Data.Text qualified as T +import Data.Time (addDays) +import Text.Tabular.AsciiWide (Header(..), Properties(..), Table(..), concatTables) + +import Hledger +import Hledger.Cli.Anchor (setAccountAnchor, dateSpanCell, headerDateSpanCell, renderPeriodHeading) +import Hledger.Write.Spreadsheet (rawTableContent, headerCell, + addHeaderBorders, addRowSpanHeader, + cellFromMixedAmount, cellsFromMixedAmount) +import Hledger.Write.Spreadsheet qualified as Ods + + + +-- 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" + +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" + +-- What to show as heading for the totals row in balance reports ? +-- Currently nothing in terminal, Total: in HTML, FODS and xSV output. +totalRowHeadingText :: Text +totalRowHeadingSpreadsheet :: Text +totalRowHeadingBudgetText :: Text +totalRowHeadingBudgetCsv :: Text + +totalRowHeadingText = "" +totalRowHeadingSpreadsheet = "Total:" +totalRowHeadingBudgetText = "" +totalRowHeadingBudgetCsv = "Total:" + + +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) + + +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) + + + +multiBalanceHasTotalsColumn :: ReportOpts -> Bool +multiBalanceHasTotalsColumn ropts = + row_total_ ropts && balanceaccum_ ropts `notElem` [Cumulative, Historical] + + +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 + + +multiBalanceRowAsText :: + ReportOpts -> [CommoditySymbol] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] +multiBalanceRowAsText opts allCommodities = + rawTableContent . + multiBalanceRowAsCellBuilders oneLineNoCostFmt{displayColour=color_ opts} + opts [] allCommodities + Value (simpleDateSpanCell $ period_titles_ opts) + +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] + +-- | 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. +balanceSubReportAsSpreadsheetParts :: + AmountFormat -> ReportOpts -> + [CommoditySymbol] -> MultiBalanceReport -> + ([[Ods.Cell Ods.NumLines Text]], + [[Ods.Cell Ods.NumLines Text]], + [[Ods.Cell Ods.NumLines Text]]) +balanceSubReportAsSpreadsheetParts 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"] + + + +-- | 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) + +-- | 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 + } diff --git a/hledger/Hledger/Cli/Commands/Holdings.hs b/hledger/Hledger/Cli/Commands/Holdings.hs index 735030f230d..3e4bc543bfb 100644 --- a/hledger/Hledger/Cli/Commands/Holdings.hs +++ b/hledger/Hledger/Cli/Commands/Holdings.hs @@ -35,7 +35,7 @@ import Text.Printf (printf) import Hledger import Hledger.Cli.CliOptions -import Hledger.Cli.Commands.Balance (addTotalBorders, renderPeriodicAcct) +import Hledger.Cli.Commands.Balance.Internal (addTotalBorders, renderPeriodicAcct) import Hledger.Cli.Commands.Print (roundFromRawOpts) import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutputLazyText) import Hledger.Write.Csv (CSV, printCSV, printTSV) diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index d454980126d..3006142ed1d 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -40,6 +40,7 @@ import Hledger import Hledger.Cli.Commands.Balance import Hledger.Cli.CliOptions import Hledger.Cli.Utils (unsupportedOutputFormatError, writeOutputLazyText) +import Hledger.Cli.Commands.Balance.Internal import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Write.Html (formatRow, formatTitle, htmlAsLazyText, nl, Html, toHtml) import Hledger.Write.Html.Attribute (stylesheet, tableStyle) @@ -418,7 +419,7 @@ compoundBalanceReportAsSpreadsheet fmt accountLabel maybeBlank ropts cbr = subreportrows (subreporttitle, mbr, _increasestotal) = let (_, bodyrows, mtotalsrows) = - multiBalanceReportAsSpreadsheetParts fmt ropts allCommodities mbr + balanceSubReportAsSpreadsheetParts fmt ropts allCommodities mbr accountCell = (Spr.defaultCell subreporttitle) { Spr.cellStyle = Spr.Body Spr.Total, @@ -457,7 +458,7 @@ compoundBalanceReportAsSpreadsheet fmt accountLabel maybeBlank ropts cbr = -- | All commodities appearing in any of these subreports, sorted. -- Used as the commodity column order for LayoutBareWide across the whole -- compound report; it must cover every row rendered, including the totals --- row, see 'setDisplayCommodityBare' in "Hledger.Cli.Commands.Balance". +-- row, see 'setDisplayCommodityBare' in "Hledger.Cli.Commands.Balance.Internal". allCommoditiesFromSubreports :: [(text, PeriodicReport a MixedAmount, bool)] -> [CommoditySymbol] allCommoditiesFromSubreports = diff --git a/hledger/hledger.cabal b/hledger/hledger.cabal index 8552091aec1..92c04c3b6f3 100644 --- a/hledger/hledger.cabal +++ b/hledger/hledger.cabal @@ -146,6 +146,7 @@ library Hledger.Cli.Utils Hledger.Cli.Version other-modules: + Hledger.Cli.Commands.Balance.Internal Paths_hledger autogen-modules: Paths_hledger diff --git a/hledger/package.yaml b/hledger/package.yaml index 74e8a28867a..070d109c9af 100644 --- a/hledger/package.yaml +++ b/hledger/package.yaml @@ -214,6 +214,11 @@ library: # - Hledger.Cli.Script # - Hledger.Cli.Utils # - Hledger.Cli.Version + other-modules: + - Hledger.Cli.Commands.Balance.Internal + - Paths_hledger + autogen-modules: + - Paths_hledger dependencies: - Diff >=1.0 # for Data.Algorithm.DiffContext's context-diff API - hashable >=1.2.4