lib: Write.Spreadsheet.Cell: add cellClass field for HTML style class

cmd: Commands.Balance.multiBalanceRowAsCellBuilders: add HTML style class attributes here
This way we do not need to dissect table rows in
multiBalanceReportHtmlHeadRow, multiBalanceReportHtmlBodyRow, multiBalanceReportHtmlFootRow
Eventually removed these three functions.
This commit is contained in:
Henning Thielemann 2024-09-05 09:51:20 +02:00 committed by Simon Michael
parent 2fcf793221
commit ff397f79cc
4 changed files with 159 additions and 142 deletions

View File

@ -6,6 +6,8 @@ This is derived from <https://hackage.haskell.org/package/classify-frog-0.2.4.3/
-} -}
module Hledger.Write.Html ( module Hledger.Write.Html (
printHtml, printHtml,
formatRow,
formatCell,
) where ) where
import qualified Hledger.Write.Spreadsheet as Spr import qualified Hledger.Write.Spreadsheet as Spr
@ -15,7 +17,7 @@ import qualified Data.Text as Text
import qualified Lucid.Base as LucidBase import qualified Lucid.Base as LucidBase
import qualified Lucid import qualified Lucid
import Data.Text (Text) import Data.Text (Text)
import Data.Foldable (for_) import Data.Foldable (traverse_)
printHtml :: (Lines border) => [[Cell border (Lucid.Html ())]] -> Lucid.Html () printHtml :: (Lines border) => [[Cell border (Lucid.Html ())]] -> Lucid.Html ()
@ -26,9 +28,10 @@ printHtml table = do
"th, td {padding-left:1em}" : "th, td {padding-left:1em}" :
"th.account, td.account {padding-left:0;}" : "th.account, td.account {padding-left:0;}" :
[] []
Lucid.table_ $ for_ table $ \row -> Lucid.table_ $ traverse_ formatRow table
Lucid.tr_ $ for_ row $ \cell ->
formatCell cell formatRow:: (Lines border) => [Cell border (Lucid.Html ())] -> Lucid.Html ()
formatRow = Lucid.tr_ . traverse_ formatCell
formatCell :: (Lines border) => Cell border (Lucid.Html ()) -> Lucid.Html () formatCell :: (Lines border) => Cell border (Lucid.Html ()) -> Lucid.Html ()
formatCell cell = formatCell cell =
@ -43,8 +46,11 @@ formatCell cell =
case leftBorder++rightBorder++topBorder++bottomBorder of case leftBorder++rightBorder++topBorder++bottomBorder of
[] -> [] [] -> []
ss -> [Lucid.style_ $ Text.intercalate "; " ss] in ss -> [Lucid.style_ $ Text.intercalate "; " ss] in
let class_ =
map Lucid.class_ $
filter (not . Text.null) [Spr.textFromClass $ cellClass cell] in
case cellStyle cell of case cellStyle cell of
Head -> Lucid.th_ style str Head -> Lucid.th_ (style++class_) str
Body emph -> Body emph ->
let align = let align =
case cellType cell of case cellType cell of
@ -55,7 +61,7 @@ formatCell cell =
case emph of case emph of
Item -> id Item -> id
Total -> Lucid.b_ Total -> Lucid.b_
in Lucid.td_ (style++align) $ withEmph str in Lucid.td_ (style++align++class_) $ withEmph str
class (Spr.Lines border) => Lines border where class (Spr.Lines border) => Lines border where

View File

@ -7,6 +7,7 @@ module Hledger.Write.Spreadsheet (
Style(..), Style(..),
Emphasis(..), Emphasis(..),
Cell(..), Cell(..),
Class(Class), textFromClass,
Border(..), Border(..),
Lines(..), Lines(..),
NumLines(..), NumLines(..),
@ -20,6 +21,7 @@ module Hledger.Write.Spreadsheet (
import Hledger.Data.Types (Amount) import Hledger.Data.Types (Amount)
import qualified Data.List as List import qualified Data.List as List
import Data.Text (Text)
data Type = data Type =
@ -75,17 +77,23 @@ transposeBorder (Border left right top bottom) =
Border top bottom left right Border top bottom left right
newtype Class = Class Text
textFromClass :: Class -> Text
textFromClass (Class cls) = cls
data Cell border text = data Cell border text =
Cell { Cell {
cellType :: Type, cellType :: Type,
cellBorder :: Border border, cellBorder :: Border border,
cellStyle :: Style, cellStyle :: Style,
cellClass :: Class,
cellContent :: text cellContent :: text
} }
instance Functor (Cell border) where instance Functor (Cell border) where
fmap f (Cell typ border style content) = fmap f (Cell typ border style class_ content) =
Cell typ border style $ f content Cell typ border style class_ $ f content
defaultCell :: (Lines border) => text -> Cell border text defaultCell :: (Lines border) => text -> Cell border text
defaultCell text = defaultCell text =
@ -93,6 +101,7 @@ defaultCell text =
cellType = TypeString, cellType = TypeString,
cellBorder = noBorder, cellBorder = noBorder,
cellStyle = Body Item, cellStyle = Body Item,
cellClass = Class mempty,
cellContent = text cellContent = text
} }

View File

@ -250,16 +250,18 @@ module Hledger.Cli.Commands.Balance (
,balanceReportAsCsv ,balanceReportAsCsv
,balanceReportAsSpreadsheet ,balanceReportAsSpreadsheet
,balanceReportItemAsText ,balanceReportItemAsText
,multiBalanceRowAsCellBuilders
,multiBalanceRowAsCsvText ,multiBalanceRowAsCsvText
,multiBalanceRowAsText ,multiBalanceRowAsText
,multiBalanceReportAsText ,multiBalanceReportAsText
,multiBalanceReportAsCsv ,multiBalanceReportAsCsv
,multiBalanceReportAsHtml ,multiBalanceReportAsHtml
,multiBalanceReportHtmlRows ,multiBalanceReportHtmlRows
,multiBalanceReportHtmlFootRow
,multiBalanceReportAsTable ,multiBalanceReportAsTable
,multiBalanceReportTableAsText ,multiBalanceReportTableAsText
,multiBalanceReportAsSpreadsheet ,multiBalanceReportAsSpreadsheet
,addTotalBorders
,RowClass(..)
-- ** HTML output helpers -- ** HTML output helpers
,stylesheet_ ,stylesheet_
,styles_ ,styles_
@ -279,14 +281,14 @@ module Hledger.Cli.Commands.Balance (
,tests_Balance ,tests_Balance
) where ) where
import Control.Arrow ((***)) import Control.Arrow (second, (***))
import Data.Decimal (roundTo) import Data.Decimal (roundTo)
import Data.Default (def) import Data.Default (def)
import Data.Function (on) import Data.Function (on)
import Data.List (find, transpose, foldl') import Data.List (find, transpose, foldl')
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.Maybe (catMaybes, fromMaybe) import Data.Maybe (mapMaybe, fromMaybe)
import Data.Tuple (swap) import Data.Tuple (swap)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as T import qualified Data.Text as T
@ -308,6 +310,7 @@ import Hledger.Cli.Utils
import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Ods (printFods) import Hledger.Write.Ods (printFods)
import Hledger.Write.Html (printHtml) import Hledger.Write.Html (printHtml)
import qualified Hledger.Write.Html as Html
import qualified Hledger.Write.Spreadsheet as Ods import qualified Hledger.Write.Spreadsheet as Ods
@ -427,6 +430,39 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of
-- Rendering -- Rendering
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 $
case rc of Value -> "budget rowtotal"; Total -> "budget coltotal"
budgetAverageClass :: RowClass -> Ods.Class
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 ? -- What to show as heading for the totals row in balance reports ?
-- Currently nothing in terminal, Total: in html and xSV output. -- Currently nothing in terminal, Total: in html and xSV output.
totalRowHeadingText = "" totalRowHeadingText = ""
@ -581,9 +617,9 @@ balanceReportAsSpreadsheet ::
balanceReportAsSpreadsheet opts (items, total) = balanceReportAsSpreadsheet opts (items, total) =
(if transpose_ opts then Ods.transpose else id) $ (if transpose_ opts then Ods.transpose else id) $
headers : headers :
concatMap (\(a, _, _, b) -> rows a b) items ++ concatMap (\(a, _, _, b) -> rows Value a b) items ++
if no_total_ opts then [] if no_total_ opts then []
else addTotalBorders $ rows totalRowHeadingCsv total else addTotalBorders $ rows Total totalRowHeadingCsv total
where where
cell = Ods.defaultCell cell = Ods.defaultCell
headers = headers =
@ -591,18 +627,21 @@ balanceReportAsSpreadsheet opts (items, total) =
"account" : case layout_ opts of "account" : case layout_ opts of
LayoutBare -> ["commodity", "balance"] LayoutBare -> ["commodity", "balance"]
_ -> ["balance"] _ -> ["balance"]
rows :: AccountName -> MixedAmount -> [[Ods.Cell Ods.NumLines Text]] rows ::
rows name ma = case layout_ opts of RowClass -> AccountName ->
MixedAmount -> [[Ods.Cell Ods.NumLines Text]]
rows rc name ma = case layout_ opts of
LayoutBare -> LayoutBare ->
map (\a -> map (\a ->
[showName name, [showName name,
cell $ acommodity a, cell $ acommodity a,
renderAmount $ mixedAmount a]) renderAmount rc $ mixedAmount a])
. amounts $ mixedAmountStripCosts ma . amounts $ mixedAmountStripCosts ma
_ -> [[showName name, renderAmount ma]] _ -> [[showName name, renderAmount rc ma]]
showName = cell . accountNameDrop (drop_ opts) showName = cell . accountNameDrop (drop_ opts)
renderAmount mixedAmt = wbToText <$> cellFromMixedAmount bopts mixedAmt renderAmount rc mixedAmt =
wbToText <$> cellFromMixedAmount bopts (amountClass rc, mixedAmt)
where where
bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder} bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder}
(showcomm, commorder) (showcomm, commorder)
@ -611,9 +650,10 @@ balanceReportAsSpreadsheet opts (items, total) =
cellFromMixedAmount :: cellFromMixedAmount ::
(Ods.Lines border) => (Ods.Lines border) =>
AmountFormat -> MixedAmount -> Ods.Cell border WideBuilder AmountFormat -> (Ods.Class, MixedAmount) -> Ods.Cell border WideBuilder
cellFromMixedAmount bopts mixedAmt = cellFromMixedAmount bopts (cls, mixedAmt) =
(Ods.defaultCell $ showMixedAmountB bopts mixedAmt) { (Ods.defaultCell $ showMixedAmountB bopts mixedAmt) {
Ods.cellClass = cls,
Ods.cellType = Ods.cellType =
case unifyMixedAmount mixedAmt of case unifyMixedAmount mixedAmt of
Just amt -> amountType bopts amt Just amt -> amountType bopts amt
@ -622,11 +662,14 @@ cellFromMixedAmount bopts mixedAmt =
cellsFromMixedAmount :: cellsFromMixedAmount ::
(Ods.Lines border) => (Ods.Lines border) =>
AmountFormat -> MixedAmount -> [Ods.Cell border WideBuilder] AmountFormat -> (Ods.Class, MixedAmount) -> [Ods.Cell border WideBuilder]
cellsFromMixedAmount bopts mixedAmt = cellsFromMixedAmount bopts (cls, mixedAmt) =
map map
(\(str,amt) -> (\(str,amt) ->
(Ods.defaultCell str) {Ods.cellType = amountType bopts amt}) (Ods.defaultCell str) {
Ods.cellClass = cls,
Ods.cellType = amountType bopts amt
})
(showMixedAmountLinesPartsB bopts mixedAmt) (showMixedAmountLinesPartsB bopts mixedAmt)
amountType :: AmountFormat -> Amount -> Ods.Type amountType :: AmountFormat -> Amount -> Ods.Type
@ -665,33 +708,42 @@ multiBalanceReportAsSpreadsheetHelper ::
multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport colspans items tr) = multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport colspans items tr) =
(headers : concatMap fullRowAsTexts items, addTotalBorders totalrows) (headers : concatMap fullRowAsTexts items, addTotalBorders totalrows)
where where
cell = Ods.defaultCell accountCell label =
(Ods.defaultCell label) {Ods.cellClass = Ods.Class "account"}
hCell cls label = (headerCell label) {Ods.cellClass = Ods.Class cls}
headers = headers =
map headerCell $ hCell "account" "account" :
"account" :
case layout_ of case layout_ of
LayoutTidy -> ["period", "start_date", "end_date", "commodity", "value"] LayoutTidy ->
LayoutBare -> "commodity" : dateHeaders map headerCell
["period", "start_date", "end_date", "commodity", "value"]
LayoutBare -> headerCell "commodity" : dateHeaders
_ -> dateHeaders _ -> dateHeaders
dateHeaders = map showDateSpan colspans ++ ["total" | row_total_] ++ ["average" | average_] dateHeaders =
fullRowAsTexts row = map (cell (showName row) :) $ rowAsText row map (headerCell . showDateSpan) colspans ++
[hCell "rowtotal" "total" | row_total_] ++
[hCell "rowaverage" "average" | average_]
fullRowAsTexts row =
map (accountCell (showName row) :) $ rowAsText Value row
where showName = accountNameDrop drop_ . prrFullName where showName = accountNameDrop drop_ . prrFullName
totalrows totalrows
| no_total_ = [] | no_total_ = []
| ishtml = zipWith (:) (cell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText tr | ishtml = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText Total tr
| otherwise = map (cell totalRowHeadingCsv :) $ rowAsText tr | otherwise = map (accountCell totalRowHeadingCsv :) $ rowAsText Total tr
rowAsText = rowAsText rc =
let fmt = if ishtml then oneLineNoCostFmt else machineFmt let fmt = if ishtml then oneLineNoCostFmt else machineFmt
in map (map (fmap wbToText)) . multiBalanceRowAsCellBuilders fmt opts colspans in map (map (fmap wbToText)) . multiBalanceRowAsCellBuilders fmt opts colspans rc
-- Helpers and CSS styles for HTML output. -- Helpers and CSS styles for HTML output.
stylesheet_ elstyles = style_ $ T.unlines $ "" : [el<>" {"<>styles<>"}" | (el,styles) <- elstyles] stylesheet_ elstyles = style_ $ T.unlines $ "" : [el<>" {"<>styles<>"}" | (el,styles) <- elstyles]
styles_ :: [Text] -> L.Attribute
styles_ = style_ . T.intercalate "; " styles_ = style_ . T.intercalate "; "
bold = "font-weight:bold" bold = "font-weight:bold"
doubleborder = "double black" doubleborder = "double black"
topdoubleborder = "border-top:"<>doubleborder topdoubleborder = "border-top:"<>doubleborder
bottomdoubleborder = "border-bottom:"<>doubleborder bottomdoubleborder = "border-bottom:"<>doubleborder
alignright, alignleft, aligncenter :: Text
alignright = "text-align:right" alignright = "text-align:right"
alignleft = "text-align:left" alignleft = "text-align:left"
aligncenter = "text-align:center" aligncenter = "text-align:center"
@ -721,92 +773,21 @@ 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 = multiBalanceReportAsCsvHelper True ropts mbr | otherwise = multiBalanceReportAsSpreadsheetHelper True ropts mbr
formatRow = Html.formatRow . map (fmap L.toHtml)
in in
(multiBalanceReportHtmlHeadRow ropts headingsrow (formatRow headingsrow
,map (multiBalanceReportHtmlBodyRow ropts) bodyrows ,map formatRow bodyrows
,zipWith3 ($) ,map formatRow mtotalsrows
(repeat (multiBalanceReportHtmlFootRow ropts))
(True : repeat False) -- mark the first html table row for special styling
mtotalsrows
-- TODO pad totals row with zeros when there are -- TODO pad totals row with zeros when there are
) )
-- | Render one MultiBalanceReport heading row as a HTML table row.
multiBalanceReportHtmlHeadRow :: ReportOpts -> [T.Text] -> Html ()
multiBalanceReportHtmlHeadRow _ [] = mempty -- shouldn't happen
multiBalanceReportHtmlHeadRow ropts (acct:cells) =
let
(amts,tot,avg)
| row_total_ ropts && average_ ropts = (ini2, sndlst2, lst2)
| row_total_ ropts = (ini1, lst1, [])
| average_ ropts = (ini1, [], lst1)
| otherwise = (cells, [], [])
where
n = length cells
(ini1,lst1) = splitAt (n-1) cells
(ini2, rest) = splitAt (n-2) cells
(sndlst2,lst2) = splitAt 1 rest
in
tr_ $ mconcat $
th_ [styles_ [bottomdoubleborder,alignleft], class_ "account"] (toHtml acct)
: [th_ [styles_ [bottomdoubleborder,alignright], class_ ""] (toHtml a) | a <- amts]
++ [th_ [styles_ [bottomdoubleborder,alignright], class_ "rowtotal"] (toHtml a) | a <- tot]
++ [th_ [styles_ [bottomdoubleborder,alignright], class_ "rowaverage"] (toHtml a) | a <- avg]
-- | Render one MultiBalanceReport data row as a HTML table row.
multiBalanceReportHtmlBodyRow :: ReportOpts -> [T.Text] -> Html ()
multiBalanceReportHtmlBodyRow _ [] = mempty -- shouldn't happen
multiBalanceReportHtmlBodyRow ropts (label:cells) =
let
(amts,tot,avg)
| row_total_ ropts && average_ ropts = (ini2, sndlst2, lst2)
| row_total_ ropts = (ini1, lst1, [])
| average_ ropts = (ini1, [], lst1)
| otherwise = (cells, [], [])
where
n = length cells
(ini1,lst1) = splitAt (n-1) cells
(ini2, rest) = splitAt (n-2) cells
(sndlst2,lst2) = splitAt 1 rest
in
tr_ $ mconcat $
td_ [styles_ [], class_ "account"] (toHtml label)
: [td_ [styles_ [alignright], class_ "amount"] (toHtml a) | a <- amts]
++ [td_ [styles_ [alignright], class_ "amount rowtotal"] (toHtml a) | a <- tot]
++ [td_ [styles_ [alignright], class_ "amount rowaverage"] (toHtml a) | a <- avg]
-- | Render one MultiBalanceReport totals row as a HTML table row.
multiBalanceReportHtmlFootRow :: ReportOpts -> Bool -> [T.Text] -> Html ()
multiBalanceReportHtmlFootRow _ _ [] = mempty
-- TODO pad totals row with zeros when subreport is empty -- TODO pad totals row with zeros when subreport is empty
-- multiBalanceReportHtmlFootRow ropts $ -- multiBalanceReportHtmlFootRow ropts $
-- "" -- ""
-- : repeat nullmixedamt zeros -- : repeat nullmixedamt zeros
-- ++ (if row_total_ ropts then [nullmixedamt] else []) -- ++ (if row_total_ ropts then [nullmixedamt] else [])
-- ++ (if average_ ropts then [nullmixedamt] else []) -- ++ (if average_ ropts then [nullmixedamt] else [])
multiBalanceReportHtmlFootRow ropts isfirstline (hdr:cells) =
let
(amts,tot,avg)
| row_total_ ropts && average_ ropts = (ini2, sndlst2, lst2)
| row_total_ ropts = (ini1, lst1, [])
| average_ ropts = (ini1, [], lst1)
| otherwise = (cells, [], [])
where
n = length cells
(ini1,lst1) = splitAt (n-1) cells
(ini2, rest) = splitAt (n-2) cells
(sndlst2,lst2) = splitAt 1 rest
in
tr_ $ mconcat $
td_ [styles_ $ [topdoubleborder | isfirstline] ++ [bold], class_ "account"] (toHtml hdr)
: [td_ [styles_ $ [topdoubleborder | isfirstline] ++ [alignright], class_ "amount coltotal"] (toHtml a) | a <- amts]
++ [td_ [styles_ $ [topdoubleborder | isfirstline] ++ [alignright], class_ "amount coltotal"] (toHtml a) | a <- tot]
++ [td_ [styles_ $ [topdoubleborder | isfirstline] ++ [alignright], class_ "amount colaverage"] (toHtml a) | a <- avg]
--thRow :: [String] -> Html ()
--thRow = tr_ . mconcat . map (th_ . toHtml)
-- | Render the ODS table rows for a MultiBalanceReport. -- | Render the ODS table rows for a MultiBalanceReport.
@ -912,37 +893,42 @@ multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, b
multiColumnTableInterColumnBorder = if pretty_ opts then SingleLine else NoLine multiColumnTableInterColumnBorder = if pretty_ opts then SingleLine else NoLine
multiBalanceRowAsTextBuilders :: AmountFormat -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] multiBalanceRowAsTextBuilders :: AmountFormat -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]]
multiBalanceRowAsTextBuilders bopts ropts colspans row = multiBalanceRowAsTextBuilders bopts ropts colspans =
rawTableContent $ rawTableContent .
multiBalanceRowAsCellBuilders bopts ropts colspans row multiBalanceRowAsCellBuilders bopts ropts colspans Value
multiBalanceRowAsCellBuilders :: multiBalanceRowAsCellBuilders ::
AmountFormat -> ReportOpts -> [DateSpan] -> AmountFormat -> ReportOpts -> [DateSpan] ->
PeriodicReportRow a MixedAmount -> [[Ods.Cell Ods.NumLines WideBuilder]] RowClass -> PeriodicReportRow a MixedAmount ->
multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = [[Ods.Cell Ods.NumLines WideBuilder]]
multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans
rc (PeriodicReportRow _ as rowtot rowavg) =
case layout_ of case layout_ of
LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) allamts] LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) clsamts]
LayoutTall -> paddedTranspose Ods.emptyCell LayoutTall -> paddedTranspose Ods.emptyCell
. fmap (cellsFromMixedAmount bopts{displayMaxWidth=Nothing}) . map (cellsFromMixedAmount bopts{displayMaxWidth=Nothing})
$ allamts $ clsamts
LayoutBare -> zipWith (:) (map wbCell cs) -- add symbols LayoutBare -> zipWith (:) (map wbCell cs) -- add symbols
. transpose -- each row becomes a list of Text quantities . transpose -- each row becomes a list of Text quantities
. fmap (cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) . map (cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing})
$ allamts $ clsamts
LayoutTidy -> concat LayoutTidy -> concat
. zipWith (map . addDateColumns) colspans . zipWith (map . addDateColumns) colspans
. fmap ( zipWith (\c a -> [wbCell c, a]) cs . map ( zipWith (\c a -> [wbCell c, a]) cs
. cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) . cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing})
$ as -- Do not include totals column or average for tidy output, as this $ classified
-- Do not include totals column or average for tidy output, as this
-- complicates the data representation and can be easily calculated -- complicates the data representation and can be easily calculated
where where
wbCell = Ods.defaultCell . wbFromText wbCell = Ods.defaultCell . wbFromText
wbDate content = (wbCell content) {Ods.cellType = Ods.TypeDate} wbDate content = (wbCell content) {Ods.cellType = Ods.TypeDate}
totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical]
cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts
allamts = (if not summary_only_ then as else []) ++ classified = map ((,) (amountClass rc)) as
[rowtot | totalscolumn && not (null as)] ++ allamts = map snd clsamts
[rowavg | average_ && not (null as)] clsamts = (if not summary_only_ then classified else []) ++
[(rowTotalClass rc, rowtot) | totalscolumn && not (null as)] ++
[(rowAverageClass rc, rowavg) | average_ && not (null as)]
addDateColumns spn@(DateSpan s e) = (wbCell (showDateSpan spn) :) addDateColumns spn@(DateSpan s e) = (wbCell (showDateSpan spn) :)
. (wbDate (maybe "" showEFDate s) :) . (wbDate (maybe "" showEFDate s) :)
. (wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :) . (wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :)
@ -1242,33 +1228,45 @@ budgetReportAsSpreadsheet
) : ) :
-- account rows -- account rows
concatMap (rowAsTexts prrFullName) items concatMap (rowAsTexts Value prrFullName) items
-- totals row -- totals row
++ addTotalBorders ++ addTotalBorders
(concat [ rowAsTexts (const totalRowHeadingBudgetCsv) totrow | not no_total_ ]) (concat [ rowAsTexts Total (const totalRowHeadingBudgetCsv) totrow | not no_total_ ])
where where
cell = Ods.defaultCell cell = Ods.defaultCell
flattentuples tups = concat [[a,b] | (a,b) <- tups] {-
showNorm = maybe Ods.emptyCell (fmap wbToText . cellFromMixedAmount oneLineNoCostFmt) ToDo: The chosen HTML cell class names are not put in stone.
If you find you need more systematic names,
feel free to develop a more sophisticated scheme.
-}
flattentuples rc tups =
concat [[(amountClass rc, a),(budgetClass rc, b)] | (a,b) <- tups]
showNorm (cls,mval) =
maybe Ods.emptyCell (fmap wbToText . curry (cellFromMixedAmount oneLineNoCostFmt) cls) mval
rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text) rowAsTexts :: RowClass
-> (PeriodicReportRow a BudgetCell -> Text)
-> PeriodicReportRow a BudgetCell -> PeriodicReportRow a BudgetCell
-> [[Ods.Cell Ods.NumLines Text]] -> [[Ods.Cell Ods.NumLines Text]]
rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg)) rowAsTexts rc render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg))
| layout_ /= LayoutBare = [cell (render row) : map showNorm vals] | layout_ /= LayoutBare = [cell (render row) : map showNorm vals]
| otherwise = | otherwise =
joinNames . zipWith (:) (map cell cs) -- add symbols and names joinNames . zipWith (:) (map cell cs) -- add symbols and names
. transpose -- each row becomes a list of Text quantities . transpose -- each row becomes a list of Text quantities
. map (map (fmap wbToText) . cellsFromMixedAmount dopts . fromMaybe nullmixedamt) . map (map (fmap wbToText) . cellsFromMixedAmount dopts . second (fromMaybe nullmixedamt))
$ vals $ vals
where where
cs = S.toList . mconcat . map maCommodities $ catMaybes vals cs = S.toList . mconcat . map maCommodities $ mapMaybe snd vals
dopts = oneLineNoCostFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing} dopts = oneLineNoCostFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing}
vals = flattentuples as vals = flattentuples rc as
++ concat [[rowtot, budgettot] | row_total_] ++ concat [[(rowTotalClass rc, rowtot),
++ concat [[rowavg, budgetavg] | average_] (budgetTotalClass rc, budgettot)]
| row_total_]
++ concat [[(rowAverageClass rc, rowavg),
(budgetAverageClass rc, budgetavg)]
| average_]
joinNames = map (cell (render row) :) joinNames = map (cell (render row) :)

View File

@ -22,6 +22,8 @@ import qualified Data.Text.Lazy.Builder as TB
import Data.Time.Calendar (Day, addDays) import Data.Time.Calendar (Day, addDays)
import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq) import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq)
import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Write.Csv (CSV, printCSV, printTSV)
import qualified Hledger.Write.Html as Html
import qualified Hledger.Write.Spreadsheet as Spr
import Lucid as L hiding (value_) import Lucid as L hiding (value_)
import Safe (tailDef) import Safe (tailDef)
import Text.Tabular.AsciiWide as Tabular hiding (render) import Text.Tabular.AsciiWide as Tabular hiding (render)
@ -362,12 +364,14 @@ compoundBalanceReportAsHtml ropts cbr =
totalrows = totalrows =
if no_total_ ropts || length subreports == 1 then [] if no_total_ ropts || length subreports == 1 then []
else else
multiBalanceRowAsCsvText ropts colspans totalrow -- make a table of rendered lines of the report totals row multiBalanceRowAsCellBuilders machineFmt ropts colspans Total totalrow
& zipWith (:) ("Net:":repeat "") -- insert a headings column, with Net: on the first line only -- make a table of rendered lines of the report totals row
& zipWith3 -- convert to a list of HTML totals rows, marking the first for special styling & map (map (fmap wbToText))
(\f isfirstline r -> f isfirstline r) & zipWith (:) (Spr.defaultCell "Net:" : repeat Spr.emptyCell)
(repeat (multiBalanceReportHtmlFootRow ropts)) -- insert a headings column, with Net: on the first line only
(True : repeat False) & addTotalBorders -- marking the first for special styling
& map (Html.formatRow . map (fmap L.toHtml))
-- convert to a list of HTML totals rows
in do in do
link_ [rel_ "stylesheet", href_ "hledger.css"] link_ [rel_ "stylesheet", href_ "hledger.css"]