cli: Cli.Balance.balanceReportAsFods: use distinguished cell formatting styles
This commit is contained in:
parent
0e158d0c3e
commit
7b136600fa
@ -21,8 +21,30 @@ import qualified System.IO as IO
|
|||||||
import Text.Printf (printf)
|
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 ::
|
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 =
|
printFods encoding tables =
|
||||||
let fileOpen =
|
let fileOpen =
|
||||||
map (map (\c -> case c of '\'' -> '"'; _ -> c)) $
|
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:of='urn:oasis:names:tc:opendocument:xmlns:of:1.2'" :
|
||||||
" xmlns:field='urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0'" :
|
" xmlns:field='urn:openoffice:names:experimental:ooo-ms-interop:xmlns:field:1.0'" :
|
||||||
" xmlns:form='urn:oasis:names:tc:opendocument:xmlns:form: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 =
|
fileClose =
|
||||||
@ -98,12 +136,24 @@ printFods encoding tables =
|
|||||||
tableOpen name ++
|
tableOpen name ++
|
||||||
(table >>= \row ->
|
(table >>= \row ->
|
||||||
"<table:table-row>" :
|
"<table:table-row>" :
|
||||||
(row >>= \cell ->
|
(row >>= formatCell) ++
|
||||||
"<table:table-cell office:value-type='string'>" :
|
|
||||||
printf "<text:p>%s</text:p>" cell :
|
|
||||||
"</table:table-cell>" :
|
|
||||||
[]) ++
|
|
||||||
"</table:table-row>" :
|
"</table:table-row>" :
|
||||||
[]) ++
|
[]) ++
|
||||||
tableClose) ++
|
tableClose) ++
|
||||||
fileClose
|
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>" :
|
||||||
|
[]
|
||||||
|
|||||||
@ -248,6 +248,7 @@ module Hledger.Cli.Commands.Balance (
|
|||||||
-- ** balance output rendering
|
-- ** balance output rendering
|
||||||
,balanceReportAsText
|
,balanceReportAsText
|
||||||
,balanceReportAsCsv
|
,balanceReportAsCsv
|
||||||
|
,balanceReportAsFods
|
||||||
,balanceReportItemAsText
|
,balanceReportItemAsText
|
||||||
,multiBalanceRowAsCsvText
|
,multiBalanceRowAsCsvText
|
||||||
,multiBalanceRowAsText
|
,multiBalanceRowAsText
|
||||||
@ -304,6 +305,7 @@ import Hledger.Cli.CliOptions
|
|||||||
import Hledger.Cli.Utils
|
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 qualified Hledger.Write.Ods as Ods
|
||||||
|
|
||||||
|
|
||||||
-- | Command line options for this command.
|
-- | Command line options for this command.
|
||||||
@ -402,7 +404,7 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of
|
|||||||
"tsv" -> \ropts1 -> printTSV . balanceReportAsCsv ropts1
|
"tsv" -> \ropts1 -> printTSV . balanceReportAsCsv ropts1
|
||||||
-- "html" -> \ropts -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts . balanceReportAsMultiBalanceReport ropts
|
-- "html" -> \ropts -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts . balanceReportAsMultiBalanceReport ropts
|
||||||
"json" -> const $ (<>"\n") . toJsonText
|
"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:
|
_ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL:
|
||||||
writeOutputLazyText opts $ render ropts report
|
writeOutputLazyText opts $ render ropts report
|
||||||
where
|
where
|
||||||
@ -557,6 +559,42 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus
|
|||||||
,displayColour = color_ opts
|
,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
|
-- Multi-column balance reports
|
||||||
|
|
||||||
-- | Render a multi-column balance report as CSV.
|
-- | Render a multi-column balance report as CSV.
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user