cli: Cli.Balance.balanceReportAsFods: use distinguished cell formatting styles

This commit is contained in:
Henning Thielemann 2024-08-10 10:13:30 +02:00
parent 0e158d0c3e
commit 7b136600fa
2 changed files with 95 additions and 7 deletions

View File

@ -21,8 +21,30 @@ import qualified System.IO as IO
import Text.Printf (printf)
data Type = TypeString | TypeAmount
deriving (Eq, Ord, Show)
data Style = Ordinary | Head | Foot
deriving (Eq, Ord, Show)
data Cell =
Cell {
cellType :: Type,
cellStyle :: Style,
cellContent :: Text
}
defaultCell :: Cell
defaultCell =
Cell {
cellType = TypeString,
cellStyle = Ordinary,
cellContent = T.empty
}
printFods ::
IO.TextEncoding -> Map Text ((Maybe Int, Maybe Int), [[Text]]) -> TL.Text
IO.TextEncoding -> Map Text ((Maybe Int, Maybe Int), [[Cell]]) -> TL.Text
printFods encoding tables =
let fileOpen =
map (map (\c -> case c of '\'' -> '"'; _ -> c)) $
@ -45,6 +67,22 @@ printFods encoding tables =
" xmlns:of='urn:oasis:names:tc:opendocument:xmlns:of:1.2'" :
" xmlns:field='urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0'" :
" xmlns:form='urn:oasis:names:tc:opendocument:xmlns:form:1.0'>" :
"<office:styles>" :
" <style:style style:name='head' style:family='table-cell'>" :
" <style:paragraph-properties fo:text-align='center'/>" :
" <style:text-properties fo:font-weight='bold'/>" :
" </style:style>" :
" <style:style style:name='foot' style:family='table-cell'>" :
" <style:text-properties fo:font-weight='bold'/>" :
" </style:style>" :
" <style:style style:name='amount' style:family='table-cell'>" :
" <style:paragraph-properties fo:text-align='end'/>" :
" </style:style>" :
" <style:style style:name='total-amount' style:family='table-cell'>" :
" <style:paragraph-properties fo:text-align='end'/>" :
" <style:text-properties fo:font-weight='bold'/>" :
" </style:style>" :
"</office:styles>" :
[]
fileClose =
@ -98,12 +136,24 @@ printFods encoding tables =
tableOpen name ++
(table >>= \row ->
"<table:table-row>" :
(row >>= \cell ->
"<table:table-cell office:value-type='string'>" :
printf "<text:p>%s</text:p>" cell :
"</table:table-cell>" :
[]) ++
(row >>= formatCell) ++
"</table:table-row>" :
[]) ++
tableClose) ++
fileClose
formatCell :: Cell -> [String]
formatCell cell =
let style :: String
style =
case (cellStyle cell, cellType cell) of
(Ordinary, TypeString) -> ""
(Ordinary, TypeAmount) -> " table:style-name='amount'"
(Foot, TypeString) -> " table:style-name='foot'"
(Foot, TypeAmount) -> " table:style-name='total-amount'"
(Head, _) -> " table:style-name='head'"
in
printf "<table:table-cell%s office:value-type='string'>" style :
printf "<text:p>%s</text:p>" (cellContent cell) :
"</table:table-cell>" :
[]

View File

@ -248,6 +248,7 @@ module Hledger.Cli.Commands.Balance (
-- ** balance output rendering
,balanceReportAsText
,balanceReportAsCsv
,balanceReportAsFods
,balanceReportItemAsText
,multiBalanceRowAsCsvText
,multiBalanceRowAsText
@ -304,6 +305,7 @@ import Hledger.Cli.CliOptions
import Hledger.Cli.Utils
import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Ods (printFods)
import qualified Hledger.Write.Ods as Ods
-- | Command line options for this command.
@ -402,7 +404,7 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of
"tsv" -> \ropts1 -> printTSV . balanceReportAsCsv ropts1
-- "html" -> \ropts -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts . balanceReportAsMultiBalanceReport ropts
"json" -> const $ (<>"\n") . toJsonText
"fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsCsv ropts1
"fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsFods ropts1
_ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL:
writeOutputLazyText opts $ render ropts report
where
@ -557,6 +559,42 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus
,displayColour = color_ opts
}
-- | Render a single-column balance report as FODS.
balanceReportAsFods :: ReportOpts -> BalanceReport -> [[Ods.Cell]]
balanceReportAsFods opts (items, total) =
headers :
concatMap (\(a, _, _, b) -> rows a b) items ++
if no_total_ opts then []
else map (map (\c -> c {Ods.cellStyle = Ods.Foot})) $
rows totalRowHeadingCsv total
where
cell content = Ods.defaultCell { Ods.cellContent = content }
headers =
map (\content -> (cell content) {Ods.cellStyle = Ods.Head}) $
"account" : case layout_ opts of
LayoutBare -> ["commodity", "balance"]
_ -> ["balance"]
rows :: AccountName -> MixedAmount -> [[Ods.Cell]]
rows name ma = case layout_ opts of
LayoutBare ->
map (\a ->
[showName name,
cell $ acommodity a,
renderAmount $ mixedAmount a])
. amounts $ mixedAmountStripCosts ma
_ -> [[showName name, renderAmount ma]]
showName = cell . accountNameDrop (drop_ opts)
renderAmount amt =
(cell $ wbToText $ showMixedAmountB bopts amt) {
Ods.cellType = Ods.TypeAmount
}
where
bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder}
(showcomm, commorder)
| layout_ opts == LayoutBare = (False, Just $ S.toList $ maCommodities amt)
| otherwise = (True, Nothing)
-- Multi-column balance reports
-- | Render a multi-column balance report as CSV.