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) (bodyrows, mtotalsrow) | no_total_ ropts = (rest, Nothing)
| otherwise = (init rest, Just $ last rest) | otherwise = (init rest, Just $ last rest)
in in
(thRow headingsrow (multiBalanceReportHtmlHeadRow ropts headingsrow
,map multiBalanceReportHtmlBodyRow bodyrows ,map (multiBalanceReportHtmlBodyRow ropts) bodyrows
,thRow <$> mtotalsrow ,multiBalanceReportHtmlFootRow ropts <$> mtotalsrow -- TODO pad totals row with zeros when there are
) )
-- | Render one MultiBalanceReport data row as a HTML table row. -- | Render one MultiBalanceReport heading row as a HTML table row.
multiBalanceReportHtmlBodyRow :: [String] -> Html () multiBalanceReportHtmlHeadRow :: ReportOpts -> [String] -> Html ()
multiBalanceReportHtmlBodyRow [] = mempty -- shouldn't happen multiBalanceReportHtmlHeadRow _ [] = mempty -- shouldn't happen
multiBalanceReportHtmlBodyRow (acct:amts) = multiBalanceReportHtmlHeadRow ropts (acct:rest) =
tr_ $ mconcat $ let
td_ (toHtml acct) : defstyle = style_ ""
[td_ [style_ "text-align:right"] (toHtml amt) | amt <- amts] (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 () -- | Render one MultiBalanceReport data row as a HTML table row.
thRow = tr_ . mconcat . map (th_ . toHtml) 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. -- | Render a multi-column balance report as plain text suitable for console output.
multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> String

View File

@ -16,7 +16,7 @@ module Hledger.Cli.CompoundBalanceCommand (
import Data.List (intercalate, foldl') import Data.List (intercalate, foldl')
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Monoid (Sum(..), (<>)) import Data.Monoid (Sum(..), (<>))
import qualified Data.Text import qualified Data.Text as TS
import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy as TL
import System.Console.CmdArgs.Explicit as C import System.Console.CmdArgs.Explicit as C
import Text.CSV import Text.CSV
@ -401,12 +401,13 @@ compoundBalanceReportAsHtml :: ReportOpts -> CompoundBalanceReport -> Html ()
compoundBalanceReportAsHtml ropts cbr = compoundBalanceReportAsHtml ropts cbr =
let let
(title, colspans, subreports, (coltotals, grandtotal, grandavg)) = cbr (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" leftattr = style_ "text-align:left"
blankrow = tr_ $ td_ [colspanattr] $ toHtmlRaw ("&nbsp;"::String) blankrow = tr_ $ td_ [colspanattr] $ toHtmlRaw ("&nbsp;"::String)
titlerows = titlerows =
[tr_ $ th_ [colspanattr, leftattr] $ toHtml title] [tr_ $ th_ [colspanattr, leftattr] $ h2_ $ toHtml title]
++ [thRow $ ++ [thRow $
"" : "" :
map showDateSpanMonthAbbrev colspans map showDateSpanMonthAbbrev colspans
@ -414,6 +415,9 @@ compoundBalanceReportAsHtml ropts cbr =
++ (if average_ ropts then ["Average"] else []) ++ (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, -- Make rows for a subreport: its title row, not the headings row,
-- the data rows, any totals row, and a blank row for whitespace. -- the data rows, any totals row, and a blank row for whitespace.
subreportrows :: (String, MultiBalanceReport, Bool) -> [Html ()] subreportrows :: (String, MultiBalanceReport, Bool) -> [Html ()]
@ -428,21 +432,25 @@ compoundBalanceReportAsHtml ropts cbr =
totalrows | no_total_ ropts || length subreports == 1 = [] totalrows | no_total_ ropts || length subreports == 1 = []
| otherwise = | otherwise =
[thRow $ let defstyle = style_ "text-align:right"
"Net:" : in
map showMixedAmountOneLineWithoutPrice ( [tr_ $ mconcat $
coltotals th_ [class_ "", style_ "text-align:left"] "Net:"
++ (if row_total_ ropts then [grandtotal] else []) : [th_ [class_ "amount coltotal", defstyle] (toHtml $ showMixedAmountOneLineWithoutPrice a) | a <- coltotals]
++ (if average_ ropts then [grandavg] else []) ++ (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
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 $ table_ $ mconcat $
titlerows titlerows
++ [blankrow] ++ [blankrow]
++ concatMap subreportrows subreports ++ concatMap subreportrows subreports
++ totalrows ++ totalrows
thRow :: [String] -> Html ()
thRow = tr_ . mconcat . map (th_ . toHtml)