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:
parent
2fcf793221
commit
ff397f79cc
@ -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
|
||||||
|
|||||||
@ -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
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@ -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) :)
|
||||||
|
|
||||||
|
|||||||
@ -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"]
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user