bs/bse/cf/is: html output fixes and styling/styleability

This commit is contained in:
Simon Michael 2018-01-19 14:16:23 -08:00
parent 5b1883fcdf
commit 2e9ae3f400
2 changed files with 87 additions and 27 deletions

View File

@ -560,21 +560,73 @@ multiBalanceReportHtmlRows ropts mbr =
(bodyrows, mtotalsrow) | no_total_ ropts = (rest, Nothing)
| otherwise = (init rest, Just $ last rest)
in
(thRow headingsrow
,map multiBalanceReportHtmlBodyRow bodyrows
,thRow <$> mtotalsrow
(multiBalanceReportHtmlHeadRow ropts headingsrow
,map (multiBalanceReportHtmlBodyRow ropts) bodyrows
,multiBalanceReportHtmlFootRow ropts <$> mtotalsrow -- TODO pad totals row with zeros when there are
)
-- | Render one MultiBalanceReport data row as a HTML table row.
multiBalanceReportHtmlBodyRow :: [String] -> Html ()
multiBalanceReportHtmlBodyRow [] = mempty -- shouldn't happen
multiBalanceReportHtmlBodyRow (acct:amts) =
tr_ $ mconcat $
td_ (toHtml acct) :
[td_ [style_ "text-align:right"] (toHtml amt) | amt <- amts]
-- | Render one MultiBalanceReport heading row as a HTML table row.
multiBalanceReportHtmlHeadRow :: ReportOpts -> [String] -> Html ()
multiBalanceReportHtmlHeadRow _ [] = mempty -- shouldn't happen
multiBalanceReportHtmlHeadRow ropts (acct:rest) =
let
defstyle = style_ ""
(amts,tot,avg)
| row_total_ ropts && average_ ropts = (init $ init rest, [last $ init rest], [last rest])
| row_total_ ropts = (init rest, [last rest], [])
| average_ ropts = (init rest, [], [last rest])
| otherwise = (rest, [], [])
in
tr_ $ mconcat $
td_ [class_ "account"] (toHtml acct)
: [td_ [class_ "", defstyle] (toHtml a) | a <- amts]
++ [td_ [class_ "rowtotal", defstyle] (toHtml a) | a <- tot]
++ [td_ [class_ "rowaverage", defstyle] (toHtml a) | a <- avg]
thRow :: [String] -> Html ()
thRow = tr_ . mconcat . map (th_ . toHtml)
-- | Render one MultiBalanceReport data row as a HTML table row.
multiBalanceReportHtmlBodyRow :: ReportOpts -> [String] -> Html ()
multiBalanceReportHtmlBodyRow _ [] = mempty -- shouldn't happen
multiBalanceReportHtmlBodyRow ropts (label:rest) =
let
defstyle = style_ "text-align:right"
(amts,tot,avg)
| row_total_ ropts && average_ ropts = (init $ init rest, [last $ init rest], [last rest])
| row_total_ ropts = (init rest, [last rest], [])
| average_ ropts = (init rest, [], [last rest])
| otherwise = (rest, [], [])
in
tr_ $ mconcat $
td_ [class_ "account", style_ "text-align:left"] (toHtml label)
: [td_ [class_ "amount", defstyle] (toHtml a) | a <- amts]
++ [td_ [class_ "amount rowtotal", defstyle] (toHtml a) | a <- tot]
++ [td_ [class_ "amount rowaverage", defstyle] (toHtml a) | a <- avg]
-- | Render one MultiBalanceReport totals row as a HTML table row.
multiBalanceReportHtmlFootRow :: ReportOpts -> [String] -> Html ()
multiBalanceReportHtmlFootRow _ropts [] = mempty
-- TODO pad totals row with zeros when subreport is empty
-- multiBalanceReportHtmlFootRow ropts $
-- ""
-- : repeat nullmixedamt zeros
-- ++ (if row_total_ ropts then [nullmixedamt] else [])
-- ++ (if average_ ropts then [nullmixedamt] else [])
multiBalanceReportHtmlFootRow ropts (acct:rest) =
let
defstyle = style_ "text-align:right"
(amts,tot,avg)
| row_total_ ropts && average_ ropts = (init $ init rest, [last $ init rest], [last rest])
| row_total_ ropts = (init rest, [last rest], [])
| average_ ropts = (init rest, [], [last rest])
| otherwise = (rest, [], [])
in
tr_ $ mconcat $
th_ [style_ "text-align:left"] (toHtml acct)
: [th_ [class_ "amount coltotal", defstyle] (toHtml a) | a <- amts]
++ [th_ [class_ "amount coltotal", defstyle] (toHtml a) | a <- tot]
++ [th_ [class_ "amount colaverage", defstyle] (toHtml a) | a <- avg]
--thRow :: [String] -> Html ()
--thRow = tr_ . mconcat . map (th_ . toHtml)
-- | Render a multi-column balance report as plain text suitable for console output.
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String

View File

@ -16,7 +16,7 @@ module Hledger.Cli.CompoundBalanceCommand (
import Data.List (intercalate, foldl')
import Data.Maybe (fromMaybe)
import Data.Monoid (Sum(..), (<>))
import qualified Data.Text
import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL
import System.Console.CmdArgs.Explicit as C
import Text.CSV
@ -401,12 +401,13 @@ compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
compoundBalanceReportAsHtml ropts cbr =
let
(title, colspans, subreports, (coltotals, grandtotal, grandavg)) = cbr
colspanattr = colspan_ $ Data.Text.pack $ show $ length colspans + 1
colspanattr = colspan_ $ TS.pack $ show $
1 + length colspans + (if row_total_ ropts then 1 else 0) + (if average_ ropts then 1 else 0)
leftattr = style_ "text-align:left"
blankrow = tr_ $ td_ [colspanattr] $ toHtmlRaw ("&nbsp;"::String)
titlerows =
[tr_ $ th_ [colspanattr, leftattr] $ toHtml title]
[tr_ $ th_ [colspanattr, leftattr] $ h2_ $ toHtml title]
++ [thRow $
"" :
map showDateSpanMonthAbbrev colspans
@ -414,6 +415,9 @@ compoundBalanceReportAsHtml ropts cbr =
++ (if average_ ropts then ["Average"] else [])
]
thRow :: [String] -> Html ()
thRow = tr_ . mconcat . map (th_ . toHtml)
-- Make rows for a subreport: its title row, not the headings row,
-- the data rows, any totals row, and a blank row for whitespace.
subreportrows :: (String, MultiBalanceReport, Bool) -> [Html ()]
@ -428,21 +432,25 @@ compoundBalanceReportAsHtml ropts cbr =
totalrows | no_total_ ropts || length subreports == 1 = []
| otherwise =
[thRow $
"Net:" :
map showMixedAmountOneLineWithoutPrice (
coltotals
++ (if row_total_ ropts then [grandtotal] else [])
++ (if average_ ropts then [grandavg] else [])
)
]
in
let defstyle = style_ "text-align:right"
in
[tr_ $ mconcat $
th_ [class_ "", style_ "text-align:left"] "Net:"
: [th_ [class_ "amount coltotal", defstyle] (toHtml $ showMixedAmountOneLineWithoutPrice a) | a <- coltotals]
++ (if row_total_ ropts then [th_ [class_ "amount coltotal", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice $ grandtotal] else [])
++ (if average_ ropts then [th_ [class_ "amount colaverage", defstyle] $ toHtml $ showMixedAmountOneLineWithoutPrice $ grandavg] else [])
]
in do
style_ (TS.unlines [""
,"td { padding:0 0.5em; }"
,"td:nth-child(1) { white-space:nowrap; }"
,"tr:nth-child(even) td { background-color:#eee; }"
])
link_ [rel_ "stylesheet", href_ "hledger.css"]
table_ $ mconcat $
titlerows
++ [blankrow]
++ concatMap subreportrows subreports
++ totalrows
thRow :: [String] -> Html ()
thRow = tr_ . mconcat . map (th_ . toHtml)