From 14b5a1f82a99bef3ab9fe8d10ed7d5e6e18a782b Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Mon, 22 Jul 2024 10:45:15 +0200 Subject: [PATCH 01/15] imp: Hledger.Read.CsvUtils -> Write.Csv --- hledger-lib/Hledger/Read/RulesReader.hs | 2 +- hledger-lib/Hledger/{Read/CsvUtils.hs => Write/Csv.hs} | 6 +++--- hledger-lib/hledger-lib.cabal | 2 +- hledger-lib/package.yaml | 2 +- hledger/Hledger/Cli/Commands/Aregister.hs | 2 +- hledger/Hledger/Cli/Commands/Balance.hs | 2 +- hledger/Hledger/Cli/Commands/Print.hs | 2 +- hledger/Hledger/Cli/Commands/Register.hs | 2 +- hledger/Hledger/Cli/CompoundBalanceCommand.hs | 2 +- 9 files changed, 11 insertions(+), 11 deletions(-) rename hledger-lib/Hledger/{Read/CsvUtils.hs => Write/Csv.hs} (92%) diff --git a/hledger-lib/Hledger/Read/RulesReader.hs b/hledger-lib/Hledger/Read/RulesReader.hs index 5181ec7a8..982baa419 100644 --- a/hledger-lib/Hledger/Read/RulesReader.hs +++ b/hledger-lib/Hledger/Read/RulesReader.hs @@ -77,7 +77,7 @@ import Text.Printf (printf) import Hledger.Data import Hledger.Utils import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep, commenttagsp ) -import Hledger.Read.CsvUtils +import Hledger.Write.Csv import System.Directory (doesFileExist, getHomeDirectory) import Data.Either (fromRight) diff --git a/hledger-lib/Hledger/Read/CsvUtils.hs b/hledger-lib/Hledger/Write/Csv.hs similarity index 92% rename from hledger-lib/Hledger/Read/CsvUtils.hs rename to hledger-lib/Hledger/Write/Csv.hs index a9d4aa9de..42c6393d2 100644 --- a/hledger-lib/Hledger/Read/CsvUtils.hs +++ b/hledger-lib/Hledger/Write/Csv.hs @@ -10,7 +10,7 @@ CSV utilities. {-# LANGUAGE OverloadedStrings #-} --- ** exports -module Hledger.Read.CsvUtils ( +module Hledger.Write.Csv ( CSV, CsvRecord, CsvValue, printCSV, printTSV, @@ -37,12 +37,12 @@ type CSV = [CsvRecord] type CsvRecord = [CsvValue] type CsvValue = Text -printCSV :: [CsvRecord] -> TL.Text +printCSV :: CSV -> TL.Text printCSV = TB.toLazyText . unlinesB . map printRecord where printRecord = foldMap TB.fromText . intersperse "," . map printField printField = wrap "\"" "\"" . T.replace "\"" "\"\"" -printTSV :: [CsvRecord] -> TL.Text +printTSV :: CSV -> TL.Text printTSV = TB.toLazyText . unlinesB . map printRecord where printRecord = foldMap TB.fromText . intersperse "\t" . map printField printField = T.map replaceWhitespace diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index d58619e31..33b22247c 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -80,12 +80,12 @@ library Hledger.Read Hledger.Read.Common Hledger.Read.CsvReader - Hledger.Read.CsvUtils Hledger.Read.InputOptions Hledger.Read.JournalReader Hledger.Read.RulesReader Hledger.Read.TimedotReader Hledger.Read.TimeclockReader + Hledger.Write.Csv Hledger.Reports Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 21fb59f42..6fdf07245 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -142,13 +142,13 @@ library: - Hledger.Read - Hledger.Read.Common - Hledger.Read.CsvReader - - Hledger.Read.CsvUtils - Hledger.Read.InputOptions - Hledger.Read.JournalReader - Hledger.Read.RulesReader # - Hledger.Read.LedgerReader - Hledger.Read.TimedotReader - Hledger.Read.TimeclockReader + - Hledger.Write.Csv - Hledger.Reports - Hledger.Reports.ReportOptions - Hledger.Reports.ReportTypes diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 6f177cbfd..62f543ceb 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -29,7 +29,7 @@ import Lucid as L hiding (value_) import System.Console.CmdArgs.Explicit (flagNone, flagReq) import Hledger -import Hledger.Read.CsvUtils (CSV, CsvRecord, printCSV, printTSV) +import Hledger.Write.Csv (CSV, CsvRecord, printCSV, printTSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils import Text.Tabular.AsciiWide hiding (render) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index b6db9875f..cb7df27c6 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -299,7 +299,7 @@ import Text.Tabular.AsciiWide import Hledger import Hledger.Cli.CliOptions import Hledger.Cli.Utils -import Hledger.Read.CsvUtils (CSV, printCSV, printTSV) +import Hledger.Write.Csv (CSV, printCSV, printTSV) -- | Command line options for this command. diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 3f40d299b..9fffb5102 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -27,7 +27,7 @@ import Lens.Micro ((^.), _Just, has) import System.Console.CmdArgs.Explicit import Hledger -import Hledger.Read.CsvUtils (CSV, printCSV, printTSV) +import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils import System.Exit (exitFailure) diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index d03c277a0..77c89a607 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -27,7 +27,7 @@ import qualified Data.Text.Lazy.Builder as TB import System.Console.CmdArgs.Explicit (flagNone, flagReq) import Hledger hiding (per) -import Hledger.Read.CsvUtils (CSV, CsvRecord, printCSV, printTSV) +import Hledger.Write.Csv (CSV, CsvRecord, printCSV, printTSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils import Text.Tabular.AsciiWide hiding (render) diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 912b19a3e..5500fe738 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -21,7 +21,7 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day, addDays) import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq) -import Hledger.Read.CsvUtils (CSV, printCSV, printTSV) +import Hledger.Write.Csv (CSV, printCSV, printTSV) import Lucid as L hiding (value_) import Safe (tailDef) import Text.Tabular.AsciiWide as Tabular hiding (render) From 0e158d0c3e3b2a37d1112180c52206058dfdd886 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Mon, 22 Jul 2024 10:46:24 +0200 Subject: [PATCH 02/15] cli: lib: Hledger.Write.Ods: basic support for FODS export used in Commands.Balance --- hledger-lib/Hledger/Write/Ods.hs | 109 ++++++++++++++++++++++++ hledger-lib/hledger-lib.cabal | 1 + hledger-lib/package.yaml | 1 + hledger/Hledger/Cli/CliOptions.hs | 2 +- hledger/Hledger/Cli/Commands/Balance.hs | 7 +- 5 files changed, 118 insertions(+), 2 deletions(-) create mode 100644 hledger-lib/Hledger/Write/Ods.hs diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs new file mode 100644 index 000000000..0b93e4d13 --- /dev/null +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -0,0 +1,109 @@ +{- | +Export table data as OpenDocument Spreadsheet +. +This format supports character encodings, fixed header rows and columns, +number formatting, text styles, merged cells, formulas, hyperlinks. +Currently we support Flat ODS, a plain uncompressed XML format. + +This is derived from +-} +module Hledger.Write.Ods where + +import qualified Data.Text.Lazy as TL +import qualified Data.Text as T +import Data.Text (Text) + +import qualified Data.Map as Map +import Data.Foldable (fold) +import Data.Map (Map) + +import qualified System.IO as IO +import Text.Printf (printf) + + +printFods :: + IO.TextEncoding -> Map Text ((Maybe Int, Maybe Int), [[Text]]) -> TL.Text +printFods encoding tables = + let fileOpen = + map (map (\c -> case c of '\'' -> '"'; _ -> c)) $ + printf "" (show encoding) : + "" : + [] + + fileClose = + "" : + [] + + tableConfig tableNames = + " " : + " " : + " " : + " " : + " " : + (fold $ + flip Map.mapWithKey tableNames $ \tableName (mTopRow,mLeftColumn) -> + printf " " tableName : + (flip foldMap mLeftColumn $ \leftColumn -> + " 2" : + printf " %d" leftColumn : + printf " %d" leftColumn : + []) ++ + (flip foldMap mTopRow $ \topRow -> + " 2" : + printf " %d" topRow : + printf " %d" topRow : + []) ++ + " " : + []) ++ + " " : + " " : + " " : + " " : + " " : + [] + + tableOpen name = + "" : + "" : + printf "" name : + [] + + tableClose = + "" : + "" : + "" : + [] + + in TL.unlines $ map (TL.fromStrict . T.pack) $ + fileOpen ++ + tableConfig (fmap fst tables) ++ + (Map.toAscList tables >>= \(name,(_,table)) -> + tableOpen name ++ + (table >>= \row -> + "" : + (row >>= \cell -> + "" : + printf "%s" cell : + "" : + []) ++ + "" : + []) ++ + tableClose) ++ + fileClose diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 33b22247c..da78d3f65 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -86,6 +86,7 @@ library Hledger.Read.TimedotReader Hledger.Read.TimeclockReader Hledger.Write.Csv + Hledger.Write.Ods Hledger.Reports Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 6fdf07245..a7cbef5c4 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -149,6 +149,7 @@ library: - Hledger.Read.TimedotReader - Hledger.Read.TimeclockReader - Hledger.Write.Csv + - Hledger.Write.Ods - Hledger.Reports - Hledger.Reports.ReportOptions - Hledger.Reports.ReportTypes diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 7ba115893..d79a7cf4c 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -718,7 +718,7 @@ defaultOutputFormat = "txt" -- | All the output formats known by any command, for outputFormatFromOpts. -- To automatically infer it from -o/--output-file, it needs to be listed here. outputFormats :: [String] -outputFormats = [defaultOutputFormat, "beancount", "csv", "json", "html", "sql", "tsv"] +outputFormats = [defaultOutputFormat, "beancount", "csv", "json", "html", "sql", "tsv", "fods"] -- | Get the output format from the --output-format option, -- otherwise from a recognised file extension in the --output-file option, diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index cb7df27c6..745be9a91 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -282,6 +282,7 @@ import Data.Decimal (roundTo) import Data.Default (def) import Data.Function (on) import Data.List (find, transpose, foldl') +import qualified Data.Map as Map import qualified Data.Set as S import Data.Maybe (catMaybes, fromMaybe) import Data.Text (Text) @@ -296,10 +297,13 @@ import Text.Tabular.AsciiWide (Header(..), Align(..), Properties(..), Cell(..), Table(..), TableOpts(..), cellWidth, concatTables, renderColumns, renderRowB, renderTableByRowsB, textCell) +import qualified System.IO as IO + import Hledger import Hledger.Cli.CliOptions import Hledger.Cli.Utils import Hledger.Write.Csv (CSV, printCSV, printTSV) +import Hledger.Write.Ods (printFods) -- | Command line options for this command. @@ -354,7 +358,7 @@ balancemode = hledgerCommandMode ,"'tidy' : every attribute in its own column" ]) -- output: - ,outputFormatFlag ["txt","html","csv","tsv","json"] + ,outputFormatFlag ["txt","html","csv","tsv","json","fods"] ,outputFileFlag ] ) @@ -398,6 +402,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 _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: writeOutputLazyText opts $ render ropts report where From 7b136600fa80ed307c3f6598bf981ce01d9f667d Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sat, 10 Aug 2024 10:13:30 +0200 Subject: [PATCH 03/15] cli: Cli.Balance.balanceReportAsFods: use distinguished cell formatting styles --- hledger-lib/Hledger/Write/Ods.hs | 62 ++++++++++++++++++++++--- hledger/Hledger/Cli/Commands/Balance.hs | 40 +++++++++++++++- 2 files changed, 95 insertions(+), 7 deletions(-) diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs index 0b93e4d13..31d95ad6c 100644 --- a/hledger-lib/Hledger/Write/Ods.hs +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -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'>" : + "" : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + "" : [] fileClose = @@ -98,12 +136,24 @@ printFods encoding tables = tableOpen name ++ (table >>= \row -> "" : - (row >>= \cell -> - "" : - printf "%s" cell : - "" : - []) ++ + (row >>= formatCell) ++ "" : []) ++ 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 "" style : + printf "%s" (cellContent cell) : + "" : + [] diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 745be9a91..a78bdbb9c 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -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. From ba0db5feec0466a8b3179d3328c32aff1c314036 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Thu, 1 Aug 2024 23:55:58 +0200 Subject: [PATCH 04/15] cli: Write.Ods: write single amounts as numbers with units This way you can do computations with the numbers in LibreOffice Calc. --- hledger-lib/Hledger/Write/Ods.hs | 73 ++++++++++++++++++++++--- hledger/Hledger/Cli/Commands/Balance.hs | 15 +++-- 2 files changed, 77 insertions(+), 11 deletions(-) diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs index 31d95ad6c..492bc0583 100644 --- a/hledger-lib/Hledger/Write/Ods.hs +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -9,19 +9,28 @@ This is derived from Map Text ((Maybe Int, Maybe Int), [[Cell]]) -> TL.Text printFods encoding tables = - let fileOpen = + let fileOpen customStyles = map (map (\c -> case c of '\'' -> '"'; _ -> c)) $ printf "" (show encoding) : "" : " " : + customStyles ++ "" : [] @@ -130,7 +140,9 @@ printFods encoding tables = [] in TL.unlines $ map (TL.fromStrict . T.pack) $ - fileOpen ++ + fileOpen + (numberConfig + =<< Set.toList (numberStyles (foldMap (concat.snd) tables))) ++ tableConfig (fmap fst tables) ++ (Map.toAscList tables >>= \(name,(_,table)) -> tableOpen name ++ @@ -142,18 +154,65 @@ printFods encoding tables = tableClose) ++ fileClose + +numberStyles :: [Cell] -> Set (CommoditySymbol, AmountPrecision) +numberStyles = + Set.fromList . + mapMaybe (\cell -> + case cellType cell of + TypeAmount amt -> Just (acommodity amt, asprecision $ astyle amt) + _ -> Nothing) + +numberStyleName :: (CommoditySymbol, AmountPrecision) -> String +numberStyleName (comm, prec) = + printf "%s-%s" comm $ + case prec of + NaturalPrecision -> "natural" + Precision k -> show k + +numberConfig :: (CommoditySymbol, AmountPrecision) -> [String] +numberConfig (comm, prec) = + let precStr = + case prec of + NaturalPrecision -> "" + Precision k -> printf " number:decimal-places='%d'" k + name = numberStyleName (comm, prec) + in + printf " " name : + printf " " precStr : + printf " %s%s" + (if T.null comm then "" else " ") comm : + " " : + " " name name : + [] + + formatCell :: Cell -> [String] formatCell cell = - let style :: String + let style, valueType :: String style = case (cellStyle cell, cellType cell) of (Ordinary, TypeString) -> "" - (Ordinary, TypeAmount) -> " table:style-name='amount'" + (Ordinary, TypeMixedAmount) -> " table:style-name='amount'" + (Ordinary, TypeAmount amt) -> numberStyle amt (Foot, TypeString) -> " table:style-name='foot'" - (Foot, TypeAmount) -> " table:style-name='total-amount'" + (Foot, _) -> " table:style-name='total-amount'" (Head, _) -> " table:style-name='head'" + + numberStyle amt = + printf " table:style-name='%s'" + (numberStyleName (acommodity amt, asprecision $ astyle amt)) + valueType = + case cellType cell of + TypeAmount amt -> + printf + "office:value-type='float' office:value='%s'" + (show $ aquantity amt) + _ -> "office:value-type='string'" + in - printf "" style : + printf "" style valueType : printf "%s" (cellContent cell) : "" : [] diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index a78bdbb9c..8b3aeb6ba 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -585,14 +585,21 @@ balanceReportAsFods opts (items, total) = _ -> [[showName name, renderAmount ma]] showName = cell . accountNameDrop (drop_ opts) - renderAmount amt = - (cell $ wbToText $ showMixedAmountB bopts amt) { - Ods.cellType = Ods.TypeAmount + renderAmount mixedAmt = + (cell $ wbToText $ showMixedAmountB bopts mixedAmt) { + Ods.cellType = + case unifyMixedAmount mixedAmt of + Just amt -> + Ods.TypeAmount $ + if showcomm + then amt + else amt {acommodity = T.empty} + Nothing -> Ods.TypeMixedAmount } where bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder} (showcomm, commorder) - | layout_ opts == LayoutBare = (False, Just $ S.toList $ maCommodities amt) + | layout_ opts == LayoutBare = (False, Just $ S.toList $ maCommodities mixedAmt) | otherwise = (True, Nothing) -- Multi-column balance reports From 2a1f3920c678398a53a82eb154703213f40c896c Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sat, 27 Jul 2024 23:51:02 +0200 Subject: [PATCH 05/15] lib: Write.Ods.escape: escape cell contents --- hledger-lib/Hledger/Write/Ods.hs | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs index 492bc0583..6fb68ce52 100644 --- a/hledger-lib/Hledger/Write/Ods.hs +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -213,6 +213,18 @@ formatCell cell = in printf "" style valueType : - printf "%s" (cellContent cell) : + printf "%s" (escape $ T.unpack $ cellContent cell) : "" : [] + +escape :: String -> String +escape = + concatMap $ \c -> + case c of + '\n' -> " " + '&' -> "&" + '<' -> "<" + '>' -> ">" + '"' -> """ + '\'' -> "'" + _ -> [c] From 29b67691fb219b749b314244cbfabc65c0a83801 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Thu, 1 Aug 2024 23:58:12 +0200 Subject: [PATCH 06/15] cli: Write.Ods: also use a number cell if the total amount has a single commodity --- hledger-lib/Hledger/Write/Ods.hs | 64 ++++++++++++++++++------- hledger/Hledger/Cli/Commands/Balance.hs | 2 +- 2 files changed, 49 insertions(+), 17 deletions(-) diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs index 6fb68ce52..d0eba8062 100644 --- a/hledger-lib/Hledger/Write/Ods.hs +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -33,7 +33,10 @@ data Type = | TypeMixedAmount deriving (Eq, Ord, Show) -data Style = Ordinary | Head | Foot +data Style = Body Emphasis | Head + deriving (Eq, Ord, Show) + +data Emphasis = Item | Total deriving (Eq, Ord, Show) data Cell = @@ -47,7 +50,7 @@ defaultCell :: Cell defaultCell = Cell { cellType = TypeString, - cellStyle = Ordinary, + cellStyle = Body Item, cellContent = T.empty } @@ -141,8 +144,10 @@ printFods encoding tables = in TL.unlines $ map (TL.fromStrict . T.pack) $ fileOpen - (numberConfig - =<< Set.toList (numberStyles (foldMap (concat.snd) tables))) ++ + (let styles = cellStyles (foldMap (concat.snd) tables) in + (numberConfig =<< Set.toList (Set.map snd styles)) + ++ + (cellConfig =<< Set.toList styles)) ++ tableConfig (fmap fst tables) ++ (Map.toAscList tables >>= \(name,(_,table)) -> tableOpen name ++ @@ -155,12 +160,17 @@ printFods encoding tables = fileClose -numberStyles :: [Cell] -> Set (CommoditySymbol, AmountPrecision) -numberStyles = +cellStyles :: [Cell] -> Set (Emphasis, (CommoditySymbol, AmountPrecision)) +cellStyles = Set.fromList . mapMaybe (\cell -> case cellType cell of - TypeAmount amt -> Just (acommodity amt, asprecision $ astyle amt) + TypeAmount amt -> + Just + (case cellStyle cell of + Body emph -> emph + Head -> Total, + (acommodity amt, asprecision $ astyle amt)) _ -> Nothing) numberStyleName :: (CommoditySymbol, AmountPrecision) -> String @@ -183,25 +193,47 @@ numberConfig (comm, prec) = printf " %s%s" (if T.null comm then "" else " ") comm : " " : - " " name name : [] +emphasisName :: Emphasis -> String +emphasisName emph = + case emph of + Item -> "item" + Total -> "total" + +cellConfig :: (Emphasis, (CommoditySymbol, AmountPrecision)) -> [String] +cellConfig (emph, numParam) = + let name = numberStyleName numParam in + let style :: String + style = + printf "style:name='%s-%s' style:data-style-name='number-%s'" + (emphasisName emph) name name in + case emph of + Item -> + printf " " style : + [] + Total -> + printf " " style : + " " : + " " : + [] + formatCell :: Cell -> [String] formatCell cell = let style, valueType :: String style = case (cellStyle cell, cellType cell) of - (Ordinary, TypeString) -> "" - (Ordinary, TypeMixedAmount) -> " table:style-name='amount'" - (Ordinary, TypeAmount amt) -> numberStyle amt - (Foot, TypeString) -> " table:style-name='foot'" - (Foot, _) -> " table:style-name='total-amount'" + (Body emph, TypeAmount amt) -> numberStyle emph amt + (Body Item, TypeString) -> "" + (Body Item, TypeMixedAmount) -> " table:style-name='amount'" + (Body Total, TypeString) -> " table:style-name='foot'" + (Body Total, TypeMixedAmount) -> " table:style-name='total-amount'" (Head, _) -> " table:style-name='head'" - numberStyle amt = - printf " table:style-name='%s'" + numberStyle emph amt = + printf " table:style-name='%s-%s'" + (emphasisName emph) (numberStyleName (acommodity amt, asprecision $ astyle amt)) valueType = case cellType cell of diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 8b3aeb6ba..83a630dc9 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -565,7 +565,7 @@ 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})) $ + else map (map (\c -> c {Ods.cellStyle = Ods.Body Ods.Total})) $ rows totalRowHeadingCsv total where cell content = Ods.defaultCell { Ods.cellContent = content } From 8c42a735c2d0b15dc6ad27b4a0a874f33a884d22 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Fri, 2 Aug 2024 10:16:55 +0200 Subject: [PATCH 07/15] cli: lib: Write.Spreadsheet: common data types for Write.Ods and Write.Html Write.Html: write spreadsheet data to a HTML table enables HTML export for the balance command --- hledger-lib/Hledger/Write/Html.hs | 58 ++++++++++++++++++++++++ hledger-lib/Hledger/Write/Ods.hs | 38 +++------------- hledger-lib/Hledger/Write/Spreadsheet.hs | 44 ++++++++++++++++++ hledger-lib/hledger-lib.cabal | 2 + hledger-lib/package.yaml | 2 + hledger/Hledger/Cli/Commands/Balance.hs | 13 +++--- 6 files changed, 120 insertions(+), 37 deletions(-) create mode 100644 hledger-lib/Hledger/Write/Html.hs create mode 100644 hledger-lib/Hledger/Write/Spreadsheet.hs diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs new file mode 100644 index 000000000..fcbf16cdf --- /dev/null +++ b/hledger-lib/Hledger/Write/Html.hs @@ -0,0 +1,58 @@ +{- | +Export spreadsheet table data as HTML table. + +This is derived from +-} +module Hledger.Write.Html ( + printHtml, + ) where + +import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) + +import qualified Data.Text.Lazy as TL +import qualified Data.Text as T + +import Text.Printf (printf) + + +printHtml :: [[Cell]] -> TL.Text +printHtml table = + TL.unlines $ map (TL.fromStrict . T.pack) $ + "" : + (table >>= \row -> + "" : + (row >>= formatCell) ++ + "" : + []) ++ + "
" : + [] + +formatCell :: Cell -> [String] +formatCell cell = + (let str = escape $ T.unpack $ cellContent cell in + case cellStyle cell of + Head -> printf "%s" str + Body emph -> + let align = + case cellType cell of + TypeString -> "" + _ -> " align=right" + (emphOpen, emphClose) = + case emph of + Item -> ("", "") + Total -> ("", "") + in printf "%s%s%s" align emphOpen str emphClose) : + [] + + +escape :: String -> String +escape = + concatMap $ \c -> + case c of + '\n' -> "
" + '&' -> "&" + '<' -> "<" + '>' -> ">" + '"' -> """ + '\'' -> "'" + _ -> [c] diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs index d0eba8062..82bade471 100644 --- a/hledger-lib/Hledger/Write/Ods.hs +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -6,10 +6,14 @@ number formatting, text styles, merged cells, formulas, hyperlinks. Currently we support Flat ODS, a plain uncompressed XML format. This is derived from --} -module Hledger.Write.Ods where -import Hledger.Data.Types (CommoditySymbol, Amount, AmountPrecision(..)) +-} +module Hledger.Write.Ods ( + printFods, + ) where + +import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) +import Hledger.Data.Types (CommoditySymbol, AmountPrecision(..)) import Hledger.Data.Types (acommodity, aquantity, astyle, asprecision) import qualified Data.Text.Lazy as TL @@ -27,34 +31,6 @@ import qualified System.IO as IO import Text.Printf (printf) -data Type = - TypeString - | TypeAmount !Amount - | TypeMixedAmount - deriving (Eq, Ord, Show) - -data Style = Body Emphasis | Head - deriving (Eq, Ord, Show) - -data Emphasis = Item | Total - deriving (Eq, Ord, Show) - -data Cell = - Cell { - cellType :: Type, - cellStyle :: Style, - cellContent :: Text - } - -defaultCell :: Cell -defaultCell = - Cell { - cellType = TypeString, - cellStyle = Body Item, - cellContent = T.empty - } - - printFods :: IO.TextEncoding -> Map Text ((Maybe Int, Maybe Int), [[Cell]]) -> TL.Text printFods encoding tables = diff --git a/hledger-lib/Hledger/Write/Spreadsheet.hs b/hledger-lib/Hledger/Write/Spreadsheet.hs new file mode 100644 index 000000000..ae3d4a26d --- /dev/null +++ b/hledger-lib/Hledger/Write/Spreadsheet.hs @@ -0,0 +1,44 @@ +{- | +Rich data type to describe data in a table. +This is the basis for ODS and HTML export. +-} +module Hledger.Write.Spreadsheet ( + Type(..), + Style(..), + Emphasis(..), + Cell(..), + defaultCell, + ) where + +import Hledger.Data.Types (Amount) + +import qualified Data.Text as T +import Data.Text (Text) + + +data Type = + TypeString + | TypeAmount !Amount + | TypeMixedAmount + deriving (Eq, Ord, Show) + +data Style = Body Emphasis | Head + deriving (Eq, Ord, Show) + +data Emphasis = Item | Total + deriving (Eq, Ord, Show) + +data Cell = + Cell { + cellType :: Type, + cellStyle :: Style, + cellContent :: Text + } + +defaultCell :: Cell +defaultCell = + Cell { + cellType = TypeString, + cellStyle = Body Item, + cellContent = T.empty + } diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index da78d3f65..990ddc047 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -87,6 +87,8 @@ library Hledger.Read.TimeclockReader Hledger.Write.Csv Hledger.Write.Ods + Hledger.Write.Html + Hledger.Write.Spreadsheet Hledger.Reports Hledger.Reports.ReportOptions Hledger.Reports.ReportTypes diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index a7cbef5c4..12b8a848c 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -150,6 +150,8 @@ library: - Hledger.Read.TimeclockReader - Hledger.Write.Csv - Hledger.Write.Ods + - Hledger.Write.Html + - Hledger.Write.Spreadsheet - Hledger.Reports - Hledger.Reports.ReportOptions - Hledger.Reports.ReportTypes diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 83a630dc9..680b66561 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -248,7 +248,7 @@ module Hledger.Cli.Commands.Balance ( -- ** balance output rendering ,balanceReportAsText ,balanceReportAsCsv - ,balanceReportAsFods + ,balanceReportAsSpreadsheet ,balanceReportItemAsText ,multiBalanceRowAsCsvText ,multiBalanceRowAsText @@ -305,7 +305,8 @@ 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 +import Hledger.Write.Html (printHtml) +import qualified Hledger.Write.Spreadsheet as Ods -- | Command line options for this command. @@ -402,9 +403,9 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of "txt" -> \ropts1 -> TB.toLazyText . balanceReportAsText ropts1 "csv" -> \ropts1 -> printCSV . balanceReportAsCsv ropts1 "tsv" -> \ropts1 -> printTSV . balanceReportAsCsv ropts1 - -- "html" -> \ropts -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts . balanceReportAsMultiBalanceReport ropts + "html" -> \ropts1 -> printHtml . balanceReportAsSpreadsheet ropts1 "json" -> const $ (<>"\n") . toJsonText - "fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsFods ropts1 + "fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsSpreadsheet ropts1 _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: writeOutputLazyText opts $ render ropts report where @@ -560,8 +561,8 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus } -- | Render a single-column balance report as FODS. -balanceReportAsFods :: ReportOpts -> BalanceReport -> [[Ods.Cell]] -balanceReportAsFods opts (items, total) = +balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Ods.Cell]] +balanceReportAsSpreadsheet opts (items, total) = headers : concatMap (\(a, _, _, b) -> rows a b) items ++ if no_total_ opts then [] From 37be7695404047cb0579e052bd5a99ca2f79d99a Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Fri, 2 Aug 2024 10:18:22 +0200 Subject: [PATCH 08/15] doc: Commands/Balance.md: mention FODS export format --- hledger/Hledger/Cli/Commands/Balance.md | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/hledger/Hledger/Cli/Commands/Balance.md b/hledger/Hledger/Cli/Commands/Balance.md index 5ea0f27cd..147c54148 100644 --- a/hledger/Hledger/Cli/Commands/Balance.md +++ b/hledger/Hledger/Cli/Commands/Balance.md @@ -59,7 +59,7 @@ Flags: 'bare' : commodity symbols in one column 'tidy' : every attribute in its own column -O --output-format=FMT select the output format. Supported formats: - txt, html, csv, tsv, json. + txt, html, csv, tsv, json, fods. -o --output-file=FILE write output to FILE. A file extension matching one of the above formats selects that format. ``` @@ -133,7 +133,7 @@ Many of these work with the higher-level commands as well. This command supports the [output destination](#output-destination) and [output format](#output-format) options, -with output formats `txt`, `csv`, `tsv` (*Added in 1.32*), `json`, and (multi-period reports only:) `html`. +with output formats `txt`, `csv`, `tsv` (*Added in 1.32*), `json`, and (multi-period reports only:) `html`, `fods` (*Added in 1.40*). In `txt` output in a colour-supporting terminal, negative amounts are shown in red. ### Simple balance report From 48723c930c2a6ef93bd61fa0cc02aa417bff4ca7 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sat, 10 Aug 2024 11:00:49 +0200 Subject: [PATCH 09/15] cli: Cli.Balance.balanceReportAsCvs: now based on balanceReportAsSpreadsheet This warrants consistency of ODS, HTML and CSV export. --- hledger/Hledger/Cli/Commands/Balance.hs | 22 ++-------------------- 1 file changed, 2 insertions(+), 20 deletions(-) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 680b66561..6dc45ad58 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -430,26 +430,8 @@ totalRowHeadingBudgetCsv = "Total:" -- | Render a single-column balance report as CSV. balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV -balanceReportAsCsv opts (items, total) = - headers : concatMap (\(a, _, _, b) -> rows a b) items ++ if no_total_ opts then [] else rows totalRowHeadingCsv total - where - headers = "account" : case layout_ opts of - LayoutBare -> ["commodity", "balance"] - _ -> ["balance"] - rows :: AccountName -> MixedAmount -> [[T.Text]] - rows name ma = case layout_ opts of - LayoutBare -> - map (\a -> [showName name, acommodity a, renderAmount $ mixedAmount a]) - . amounts $ mixedAmountStripCosts ma - _ -> [[showName name, renderAmount ma]] - - showName = accountNameDrop (drop_ opts) - renderAmount amt = wbToText $ showMixedAmountB bopts amt - where - bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder} - (showcomm, commorder) - | layout_ opts == LayoutBare = (False, Just $ S.toList $ maCommodities amt) - | otherwise = (True, Nothing) +balanceReportAsCsv opts = + map (map Ods.cellContent) . balanceReportAsSpreadsheet opts -- | Render a single-column balance report as plain text. balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder From f306df6d612b231f1af73429499e57c7c112e5da Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sat, 10 Aug 2024 12:04:13 +0200 Subject: [PATCH 10/15] imp: lib: Write.Html: use Lucid to generate HTML --- hledger-lib/Hledger/Write/Html.hs | 56 ++++++++----------------- hledger-lib/hledger-lib.cabal | 1 + hledger-lib/package.yaml | 1 + hledger/Hledger/Cli/Commands/Balance.hs | 3 +- 4 files changed, 22 insertions(+), 39 deletions(-) diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs index fcbf16cdf..282caa468 100644 --- a/hledger-lib/Hledger/Write/Html.hs +++ b/hledger-lib/Hledger/Write/Html.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE OverloadedStrings #-} {- | Export spreadsheet table data as HTML table. @@ -9,50 +10,29 @@ module Hledger.Write.Html ( import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) -import qualified Data.Text.Lazy as TL -import qualified Data.Text as T - -import Text.Printf (printf) +import qualified Lucid.Base as LucidBase +import qualified Lucid +import Data.Foldable (for_) -printHtml :: [[Cell]] -> TL.Text +printHtml :: [[Cell]] -> Lucid.Html () printHtml table = - TL.unlines $ map (TL.fromStrict . T.pack) $ - "" : - (table >>= \row -> - "" : - (row >>= formatCell) ++ - "" : - []) ++ - "
" : - [] + Lucid.table_ $ for_ table $ \row -> + Lucid.tr_ $ for_ row $ \cell -> + formatCell cell -formatCell :: Cell -> [String] +formatCell :: Cell -> Lucid.Html () formatCell cell = - (let str = escape $ T.unpack $ cellContent cell in - case cellStyle cell of - Head -> printf "%s" str + let str = Lucid.toHtml $ cellContent cell in + case cellStyle cell of + Head -> Lucid.th_ str Body emph -> let align = case cellType cell of - TypeString -> "" - _ -> " align=right" - (emphOpen, emphClose) = + TypeString -> [] + _ -> [LucidBase.makeAttribute "align" "right"] + withEmph = case emph of - Item -> ("", "") - Total -> ("", "") - in printf "%s%s%s" align emphOpen str emphClose) : - [] - - -escape :: String -> String -escape = - concatMap $ \c -> - case c of - '\n' -> "
" - '&' -> "&" - '<' -> "<" - '>' -> ">" - '"' -> """ - '\'' -> "'" - _ -> [c] + Item -> id + Total -> Lucid.b_ + in Lucid.td_ align $ withEmph str diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index 990ddc047..6efe19c8a 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/hledger-lib/hledger-lib.cabal @@ -138,6 +138,7 @@ library , file-embed >=0.0.10 , filepath , hashtables >=1.2.3.1 + , lucid , megaparsec >=7.0.0 && <9.7 , microlens >=0.4 , microlens-th >=0.4 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 12b8a848c..a8a6f1c80 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -61,6 +61,7 @@ dependencies: - file-embed >=0.0.10 - filepath - hashtables >=1.2.3.1 +- lucid - megaparsec >=7.0.0 && <9.7 - microlens >=0.4 - microlens-th >=0.4 diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 6dc45ad58..77936e4bd 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -403,7 +403,8 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of "txt" -> \ropts1 -> TB.toLazyText . balanceReportAsText ropts1 "csv" -> \ropts1 -> printCSV . balanceReportAsCsv ropts1 "tsv" -> \ropts1 -> printTSV . balanceReportAsCsv ropts1 - "html" -> \ropts1 -> printHtml . balanceReportAsSpreadsheet ropts1 + "html" -> \ropts1 -> (<>"\n") . L.renderText . + printHtml . balanceReportAsSpreadsheet ropts1 "json" -> const $ (<>"\n") . toJsonText "fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsSpreadsheet ropts1 _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: From 66a047aade9a599aca09ac2e98fb42366c69986b Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sun, 11 Aug 2024 08:43:44 +0200 Subject: [PATCH 11/15] lib: Write.Spreadsheet.Cell: add type parameter for the text type instance Functor Cell This way you can choose between Text, Lazy.Text, WideBuilder for cell content. --- hledger-lib/Hledger/Write/Html.hs | 6 +++--- hledger-lib/Hledger/Write/Ods.hs | 7 ++++--- hledger-lib/Hledger/Write/Spreadsheet.hs | 20 ++++++++++++-------- hledger/Hledger/Cli/Commands/Balance.hs | 8 ++++---- 4 files changed, 23 insertions(+), 18 deletions(-) diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs index 282caa468..037d3dc8a 100644 --- a/hledger-lib/Hledger/Write/Html.hs +++ b/hledger-lib/Hledger/Write/Html.hs @@ -15,15 +15,15 @@ import qualified Lucid import Data.Foldable (for_) -printHtml :: [[Cell]] -> Lucid.Html () +printHtml :: [[Cell (Lucid.Html ())]] -> Lucid.Html () printHtml table = Lucid.table_ $ for_ table $ \row -> Lucid.tr_ $ for_ row $ \cell -> formatCell cell -formatCell :: Cell -> Lucid.Html () +formatCell :: Cell (Lucid.Html ()) -> Lucid.Html () formatCell cell = - let str = Lucid.toHtml $ cellContent cell in + let str = cellContent cell in case cellStyle cell of Head -> Lucid.th_ str Body emph -> diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs index 82bade471..b87b9fbe5 100644 --- a/hledger-lib/Hledger/Write/Ods.hs +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -32,7 +32,8 @@ import Text.Printf (printf) printFods :: - IO.TextEncoding -> Map Text ((Maybe Int, Maybe Int), [[Cell]]) -> TL.Text + IO.TextEncoding -> + Map Text ((Maybe Int, Maybe Int), [[Cell Text]]) -> TL.Text printFods encoding tables = let fileOpen customStyles = map (map (\c -> case c of '\'' -> '"'; _ -> c)) $ @@ -136,7 +137,7 @@ printFods encoding tables = fileClose -cellStyles :: [Cell] -> Set (Emphasis, (CommoditySymbol, AmountPrecision)) +cellStyles :: [Cell Text] -> Set (Emphasis, (CommoditySymbol, AmountPrecision)) cellStyles = Set.fromList . mapMaybe (\cell -> @@ -195,7 +196,7 @@ cellConfig (emph, numParam) = [] -formatCell :: Cell -> [String] +formatCell :: Cell Text -> [String] formatCell cell = let style, valueType :: String style = diff --git a/hledger-lib/Hledger/Write/Spreadsheet.hs b/hledger-lib/Hledger/Write/Spreadsheet.hs index ae3d4a26d..3724c61f0 100644 --- a/hledger-lib/Hledger/Write/Spreadsheet.hs +++ b/hledger-lib/Hledger/Write/Spreadsheet.hs @@ -8,13 +8,11 @@ module Hledger.Write.Spreadsheet ( Emphasis(..), Cell(..), defaultCell, + emptyCell, ) where import Hledger.Data.Types (Amount) -import qualified Data.Text as T -import Data.Text (Text) - data Type = TypeString @@ -28,17 +26,23 @@ data Style = Body Emphasis | Head data Emphasis = Item | Total deriving (Eq, Ord, Show) -data Cell = +data Cell text = Cell { cellType :: Type, cellStyle :: Style, - cellContent :: Text + cellContent :: text } -defaultCell :: Cell -defaultCell = +instance Functor Cell where + fmap f (Cell typ style content) = Cell typ style $ f content + +defaultCell :: text -> Cell text +defaultCell text = Cell { cellType = TypeString, cellStyle = Body Item, - cellContent = T.empty + cellContent = text } + +emptyCell :: (Monoid text) => Cell text +emptyCell = defaultCell mempty diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 77936e4bd..5c32ff065 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -404,7 +404,7 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of "csv" -> \ropts1 -> printCSV . balanceReportAsCsv ropts1 "tsv" -> \ropts1 -> printTSV . balanceReportAsCsv ropts1 "html" -> \ropts1 -> (<>"\n") . L.renderText . - printHtml . balanceReportAsSpreadsheet ropts1 + printHtml . map (map (fmap L.toHtml)) . balanceReportAsSpreadsheet ropts1 "json" -> const $ (<>"\n") . toJsonText "fods" -> \ropts1 -> printFods IO.localeEncoding . Map.singleton "Hledger" . (,) (Just 1, Nothing) . balanceReportAsSpreadsheet ropts1 _ -> error' $ unsupportedOutputFormatError fmt -- PARTIAL: @@ -544,7 +544,7 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus } -- | Render a single-column balance report as FODS. -balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Ods.Cell]] +balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Ods.Cell Text]] balanceReportAsSpreadsheet opts (items, total) = headers : concatMap (\(a, _, _, b) -> rows a b) items ++ @@ -552,13 +552,13 @@ balanceReportAsSpreadsheet opts (items, total) = else map (map (\c -> c {Ods.cellStyle = Ods.Body Ods.Total})) $ rows totalRowHeadingCsv total where - cell content = Ods.defaultCell { Ods.cellContent = content } + cell = Ods.defaultCell headers = map (\content -> (cell content) {Ods.cellStyle = Ods.Head}) $ "account" : case layout_ opts of LayoutBare -> ["commodity", "balance"] _ -> ["balance"] - rows :: AccountName -> MixedAmount -> [[Ods.Cell]] + rows :: AccountName -> MixedAmount -> [[Ods.Cell Text]] rows name ma = case layout_ opts of LayoutBare -> map (\a -> From da61b64f9459816409aec758fbc31c202ea05efe Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sun, 11 Aug 2024 10:15:47 +0200 Subject: [PATCH 12/15] cli: Command.Balance: support FODS export for multibalance Data.Amount.showMixedAmountLinesPartsB: new helper function --- hledger-lib/Hledger/Data/Amount.hs | 14 ++- hledger/Hledger/Cli/Commands/Balance.hs | 113 +++++++++++++++++------- 2 files changed, 91 insertions(+), 36 deletions(-) diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 0b255e3ad..aa61d9898 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -155,6 +155,7 @@ module Hledger.Data.Amount ( showMixedAmountWithZeroCommodity, showMixedAmountB, showMixedAmountLinesB, + showMixedAmountLinesPartsB, wbToText, wbUnpack, mixedAmountSetPrecision, @@ -1120,10 +1121,17 @@ showMixedAmountB opts ma -- This returns the list of WideBuilders: one for each Amount, and padded/elided to the appropriate width. -- This does not honour displayOneLine; all amounts will be displayed as if displayOneLine were False. showMixedAmountLinesB :: AmountFormat -> MixedAmount -> [WideBuilder] -showMixedAmountLinesB opts@AmountFormat{displayMaxWidth=mmax,displayMinWidth=mmin} ma = - map (adBuilder . pad) elided +showMixedAmountLinesB opts ma = + map fst $ showMixedAmountLinesPartsB opts ma + +-- | Like 'showMixedAmountLinesB' but also returns +-- the amounts associated with each text builder. +showMixedAmountLinesPartsB :: AmountFormat -> MixedAmount -> [(WideBuilder, Amount)] +showMixedAmountLinesPartsB opts@AmountFormat{displayMaxWidth=mmax,displayMinWidth=mmin} ma = + zip (map (adBuilder . pad) elided) amts where - astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $ + astrs = amtDisplayList (wbWidth sep) (showAmountB opts) amts + amts = orderedAmounts opts $ if displayCost opts then ma else mixedAmountStripCosts ma sep = WideBuilder (TB.singleton '\n') 0 width = maximum $ map (wbWidth . adBuilder) elided diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 5c32ff065..2f4059c5b 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -259,6 +259,7 @@ module Hledger.Cli.Commands.Balance ( ,multiBalanceReportHtmlFootRow ,multiBalanceReportAsTable ,multiBalanceReportTableAsText + ,multiBalanceReportAsSpreadsheet -- ** HTML output helpers ,stylesheet_ ,styles_ @@ -394,6 +395,8 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of "tsv" -> printTSV . multiBalanceReportAsCsv ropts "html" -> (<>"\n") . L.renderText . multiBalanceReportAsHtml ropts "json" -> (<>"\n") . toJsonText + "fods" -> printFods IO.localeEncoding . + Map.singleton "Hledger" . multiBalanceReportAsSpreadsheet ropts _ -> const $ error' $ unsupportedOutputFormatError fmt -- PARTIAL: writeOutputLazyText opts $ render report @@ -569,23 +572,38 @@ balanceReportAsSpreadsheet opts (items, total) = _ -> [[showName name, renderAmount ma]] showName = cell . accountNameDrop (drop_ opts) - renderAmount mixedAmt = - (cell $ wbToText $ showMixedAmountB bopts mixedAmt) { - Ods.cellType = - case unifyMixedAmount mixedAmt of - Just amt -> - Ods.TypeAmount $ - if showcomm - then amt - else amt {acommodity = T.empty} - Nothing -> Ods.TypeMixedAmount - } + renderAmount mixedAmt = wbToText <$> cellFromMixedAmount bopts mixedAmt where bopts = machineFmt{displayCommodity=showcomm, displayCommodityOrder = commorder} (showcomm, commorder) | layout_ opts == LayoutBare = (False, Just $ S.toList $ maCommodities mixedAmt) | otherwise = (True, Nothing) +cellFromMixedAmount :: AmountFormat -> MixedAmount -> Ods.Cell WideBuilder +cellFromMixedAmount bopts mixedAmt = + (Ods.defaultCell $ showMixedAmountB bopts mixedAmt) { + Ods.cellType = + case unifyMixedAmount mixedAmt of + Just amt -> amountType bopts amt + Nothing -> Ods.TypeMixedAmount + } + +cellsFromMixedAmount :: AmountFormat -> MixedAmount -> [Ods.Cell WideBuilder] +cellsFromMixedAmount bopts mixedAmt = + map + (\(str,amt) -> + (Ods.defaultCell str) {Ods.cellType = amountType bopts amt}) + (showMixedAmountLinesPartsB bopts mixedAmt) + +amountType :: AmountFormat -> Amount -> Ods.Type +amountType bopts amt = + Ods.TypeAmount $ + if displayCommodity bopts + then amt + else amt {acommodity = T.empty} + + + -- Multi-column balance reports -- | Render a multi-column balance report as CSV. @@ -602,21 +620,35 @@ multiBalanceReportAsCsv opts@ReportOpts{..} report = maybeTranspose allRows -- Helper for CSV (and HTML) rendering. multiBalanceReportAsCsvHelper :: Bool -> ReportOpts -> MultiBalanceReport -> (CSV, CSV) -multiBalanceReportAsCsvHelper ishtml opts@ReportOpts{..} (PeriodicReport colspans items tr) = - (headers : concatMap fullRowAsTexts items, totalrows) +multiBalanceReportAsCsvHelper ishtml opts = + (map (map Ods.cellContent) *** map (map Ods.cellContent)) . + multiBalanceReportAsSpreadsheetHelper ishtml opts + +-- Helper for CSV and ODS and HTML rendering. +multiBalanceReportAsSpreadsheetHelper :: + Bool -> ReportOpts -> MultiBalanceReport -> ([[Ods.Cell Text]], [[Ods.Cell Text]]) +multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport colspans items tr) = + (headers : concatMap fullRowAsTexts items, + map (map (\c -> c{Ods.cellStyle = Ods.Body Ods.Total})) totalrows) where - headers = "account" : case layout_ of + cell = Ods.defaultCell + headers = + map (\content -> (cell content) {Ods.cellStyle = Ods.Head}) $ + "account" : + case layout_ of LayoutTidy -> ["period", "start_date", "end_date", "commodity", "value"] LayoutBare -> "commodity" : dateHeaders _ -> dateHeaders dateHeaders = map showDateSpan colspans ++ ["total" | row_total_] ++ ["average" | average_] - fullRowAsTexts row = map (showName row :) $ rowAsText opts colspans row + fullRowAsTexts row = map (cell (showName row) :) $ rowAsText row where showName = accountNameDrop drop_ . prrFullName totalrows - | no_total_ = mempty - | ishtml = zipWith (:) (totalRowHeadingHtml : repeat "") $ rowAsText opts colspans tr - | otherwise = map (totalRowHeadingCsv :) $ rowAsText opts colspans tr - rowAsText = if ishtml then multiBalanceRowAsHtmlText else multiBalanceRowAsCsvText + | no_total_ = [] + | ishtml = zipWith (:) (cell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText tr + | otherwise = map (cell totalRowHeadingCsv :) $ rowAsText tr + rowAsText = + let fmt = if ishtml then oneLineNoCostFmt else machineFmt + in map (map (fmap wbToText)) . multiBalanceRowAsCellBuilders fmt opts colspans -- Helpers and CSS styles for HTML output. @@ -742,6 +774,17 @@ multiBalanceReportHtmlFootRow ropts isfirstline (hdr:cells) = --thRow :: [String] -> Html () --thRow = tr_ . mconcat . map (th_ . toHtml) + +-- | Render the ODS table rows for a MultiBalanceReport. +-- Returns the heading row, 0 or more body rows, and the totals row if enabled. +multiBalanceReportAsSpreadsheet :: + ReportOpts -> MultiBalanceReport -> ((Maybe Int, Maybe Int), [[Ods.Cell Text]]) +multiBalanceReportAsSpreadsheet ropts mbr = + let (upper,lower) = multiBalanceReportAsSpreadsheetHelper True ropts mbr + in ((Just 1, case layout_ ropts of LayoutWide _ -> Just 1; _ -> Nothing), + upper ++ lower) + + -- | Render a multi-column balance report as plain text suitable for console output. multiBalanceReportAsText :: ReportOpts -> MultiBalanceReport -> TL.Text multiBalanceReportAsText ropts@ReportOpts{..} r = TB.toLazyText $ @@ -833,31 +876,38 @@ multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, b multiColumnTableInterColumnBorder = if pretty_ opts then SingleLine else NoLine multiBalanceRowAsTextBuilders :: AmountFormat -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[WideBuilder]] -multiBalanceRowAsTextBuilders bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = +multiBalanceRowAsTextBuilders bopts ropts colspans row = + map (map Ods.cellContent) $ + multiBalanceRowAsCellBuilders bopts ropts colspans row + +multiBalanceRowAsCellBuilders :: + AmountFormat -> ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[Ods.Cell WideBuilder]] +multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans (PeriodicReportRow _ as rowtot rowavg) = case layout_ of - LayoutWide width -> [fmap (showMixedAmountB bopts{displayMaxWidth=width}) allamts] - LayoutTall -> paddedTranspose mempty - . fmap (showMixedAmountLinesB bopts{displayMaxWidth=Nothing}) + LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) allamts] + LayoutTall -> paddedTranspose Ods.emptyCell + . fmap (cellsFromMixedAmount bopts{displayMaxWidth=Nothing}) $ allamts - LayoutBare -> zipWith (:) (fmap wbFromText cs) -- add symbols + LayoutBare -> zipWith (:) (map wbCell cs) -- add symbols . transpose -- each row becomes a list of Text quantities - . fmap (showMixedAmountLinesB bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) + . fmap (cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) $ allamts LayoutTidy -> concat . zipWith (map . addDateColumns) colspans - . fmap ( zipWith (\c a -> [wbFromText c, a]) cs - . showMixedAmountLinesB bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) + . fmap ( zipWith (\c a -> [wbCell c, a]) cs + . cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing}) $ as -- Do not include totals column or average for tidy output, as this -- complicates the data representation and can be easily calculated where + wbCell = Ods.defaultCell . wbFromText totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts allamts = (if not summary_only_ then as else []) ++ [rowtot | totalscolumn && not (null as)] ++ [rowavg | average_ && not (null as)] - addDateColumns spn@(DateSpan s e) = (wbFromText (showDateSpan spn) :) - . (wbFromText (maybe "" showEFDate s) :) - . (wbFromText (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :) + addDateColumns spn@(DateSpan s e) = (wbCell (showDateSpan spn) :) + . (wbCell (maybe "" showEFDate s) :) + . (wbCell (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :) paddedTranspose :: a -> [[a]] -> [[a]] paddedTranspose _ [] = [[]] @@ -880,9 +930,6 @@ multiBalanceRowAsText opts = multiBalanceRowAsTextBuilders oneLineNoCostFmt{disp multiBalanceRowAsCsvText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]] multiBalanceRowAsCsvText opts colspans = fmap (fmap wbToText) . multiBalanceRowAsTextBuilders machineFmt opts colspans -multiBalanceRowAsHtmlText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]] -multiBalanceRowAsHtmlText opts colspans = fmap (fmap wbToText) . multiBalanceRowAsTextBuilders oneLineNoCostFmt opts colspans - -- Budget reports -- A BudgetCell's data values rendered for display - the actual change amount, From 3af8eb3bc64a81b3eba0e852509db0473a0ee09c Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sun, 11 Aug 2024 11:44:21 +0200 Subject: [PATCH 13/15] cli: Command.Balance: use Date format for dates in LayoutTidy --- hledger-lib/Hledger/Write/Html.hs | 1 + hledger-lib/Hledger/Write/Ods.hs | 34 +++++++++++++++++++----- hledger-lib/Hledger/Write/Spreadsheet.hs | 1 + hledger/Hledger/Cli/Commands/Balance.hs | 5 ++-- 4 files changed, 32 insertions(+), 9 deletions(-) diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs index 037d3dc8a..b748876cb 100644 --- a/hledger-lib/Hledger/Write/Html.hs +++ b/hledger-lib/Hledger/Write/Html.hs @@ -30,6 +30,7 @@ formatCell cell = let align = case cellType cell of TypeString -> [] + TypeDate -> [] _ -> [LucidBase.makeAttribute "align" "right"] withEmph = case emph of diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs index b87b9fbe5..cdeb014f6 100644 --- a/hledger-lib/Hledger/Write/Ods.hs +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -71,6 +71,19 @@ printFods encoding tables = " " : " " : " " : + " " : + " " : + " -" : + " " : + " -" : + " " : + " " : + " " : + " " : + " " : + " " : customStyles ++ "" : [] @@ -201,23 +214,30 @@ formatCell cell = let style, valueType :: String style = case (cellStyle cell, cellType cell) of - (Body emph, TypeAmount amt) -> numberStyle emph amt + (Body emph, TypeAmount amt) -> tableStyle $ numberStyle emph amt (Body Item, TypeString) -> "" - (Body Item, TypeMixedAmount) -> " table:style-name='amount'" - (Body Total, TypeString) -> " table:style-name='foot'" - (Body Total, TypeMixedAmount) -> " table:style-name='total-amount'" - (Head, _) -> " table:style-name='head'" - + (Body Item, TypeMixedAmount) -> tableStyle "amount" + (Body Item, TypeDate) -> tableStyle "date" + (Body Total, TypeString) -> tableStyle "foot" + (Body Total, TypeMixedAmount) -> tableStyle "total-amount" + (Body Total, TypeDate) -> tableStyle "foot-date" + (Head, _) -> tableStyle "head" numberStyle emph amt = - printf " table:style-name='%s-%s'" + printf "%s-%s" (emphasisName emph) (numberStyleName (acommodity amt, asprecision $ astyle amt)) + tableStyle = printf " table:style-name='%s'" + valueType = case cellType cell of TypeAmount amt -> printf "office:value-type='float' office:value='%s'" (show $ aquantity amt) + TypeDate -> + printf + "office:value-type='date' office:date-value='%s'" + (cellContent cell) _ -> "office:value-type='string'" in diff --git a/hledger-lib/Hledger/Write/Spreadsheet.hs b/hledger-lib/Hledger/Write/Spreadsheet.hs index 3724c61f0..96fb14610 100644 --- a/hledger-lib/Hledger/Write/Spreadsheet.hs +++ b/hledger-lib/Hledger/Write/Spreadsheet.hs @@ -18,6 +18,7 @@ data Type = TypeString | TypeAmount !Amount | TypeMixedAmount + | TypeDate deriving (Eq, Ord, Show) data Style = Body Emphasis | Head diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 2f4059c5b..f55aa96f7 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -900,14 +900,15 @@ multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans (PeriodicReportRow _ -- complicates the data representation and can be easily calculated where wbCell = Ods.defaultCell . wbFromText + wbDate content = (wbCell content) {Ods.cellType = Ods.TypeDate} totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] cs = if all mixedAmountLooksZero allamts then [""] else S.toList $ foldMap maCommodities allamts allamts = (if not summary_only_ then as else []) ++ [rowtot | totalscolumn && not (null as)] ++ [rowavg | average_ && not (null as)] addDateColumns spn@(DateSpan s e) = (wbCell (showDateSpan spn) :) - . (wbCell (maybe "" showEFDate s) :) - . (wbCell (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :) + . (wbDate (maybe "" showEFDate s) :) + . (wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :) paddedTranspose :: a -> [[a]] -> [[a]] paddedTranspose _ [] = [[]] From 70e556998f4e62db400ac7e011967d8e7f0d93f4 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sun, 11 Aug 2024 19:18:13 +0200 Subject: [PATCH 14/15] cli: Command.Balance.budgetReportAsSpreadsheet: support for budget export to HTML and FODS --- hledger/Hledger/Cli/Commands/Balance.hs | 40 ++++++++++++++++++------- 1 file changed, 30 insertions(+), 10 deletions(-) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index f55aa96f7..81b5b634b 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -384,6 +384,10 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of "json" -> (<>"\n") . toJsonText "csv" -> printCSV . budgetReportAsCsv ropts "tsv" -> printTSV . budgetReportAsCsv ropts + "html" -> (<>"\n") . L.renderText . + printHtml . map (map (fmap L.toHtml)) . budgetReportAsSpreadsheet ropts + "fods" -> printFods IO.localeEncoding . + Map.singleton "Hledger" . (,) (Just 1, Nothing) . budgetReportAsSpreadsheet ropts _ -> error' $ unsupportedOutputFormatError fmt writeOutputLazyText opts $ render budgetreport @@ -1184,13 +1188,27 @@ budgetReportAsTable ReportOpts{..} (PeriodicReport spans items totrow) = -- | Render a budget report as CSV. Like multiBalanceReportAsCsv, -- but includes alternating actual and budget amount columns. budgetReportAsCsv :: ReportOpts -> BudgetReport -> [[Text]] -budgetReportAsCsv +budgetReportAsCsv ropts report + = (if transpose_ ropts then transpose else id) $ + map (map Ods.cellContent) $ + budgetReportAsSpreadsheetHelper ropts report + +budgetReportAsSpreadsheet :: ReportOpts -> BudgetReport -> [[Ods.Cell Text]] +budgetReportAsSpreadsheet ropts report + = (if transpose_ ropts + then error' "Sorry, --transpose with FODS or HTML output is not yet supported" -- PARTIAL: + else id) + budgetReportAsSpreadsheetHelper ropts report + +budgetReportAsSpreadsheetHelper :: ReportOpts -> BudgetReport -> [[Ods.Cell Text]] +budgetReportAsSpreadsheetHelper ReportOpts{..} (PeriodicReport colspans items totrow) = (if transpose_ then transpose else id) $ -- heading row - ("Account" : + (map (\content -> (cell content) {Ods.cellStyle = Ods.Head}) $ + "Account" : ["Commodity" | layout_ == LayoutBare ] ++ concatMap (\spn -> [showDateSpan spn, "budget"]) colspans ++ concat [["Total" ,"budget"] | row_total_] @@ -1201,30 +1219,32 @@ budgetReportAsCsv concatMap (rowAsTexts prrFullName) items -- totals row - ++ concat [ rowAsTexts (const totalRowHeadingBudgetCsv) totrow | not no_total_ ] + ++ map (map (\c -> c {Ods.cellStyle = Ods.Body Ods.Total})) + (concat [ rowAsTexts (const totalRowHeadingBudgetCsv) totrow | not no_total_ ]) where + cell = Ods.defaultCell flattentuples tups = concat [[a,b] | (a,b) <- tups] - showNorm = maybe "" (wbToText . showMixedAmountB oneLineNoCostFmt) + showNorm = maybe Ods.emptyCell (fmap wbToText . cellFromMixedAmount oneLineNoCostFmt) rowAsTexts :: (PeriodicReportRow a BudgetCell -> Text) -> PeriodicReportRow a BudgetCell - -> [[Text]] + -> [[Ods.Cell Text]] rowAsTexts render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg)) - | layout_ /= LayoutBare = [render row : map showNorm vals] + | layout_ /= LayoutBare = [cell (render row) : map showNorm vals] | otherwise = - joinNames . zipWith (:) cs -- add symbols and names + joinNames . zipWith (:) (map cell cs) -- add symbols and names . transpose -- each row becomes a list of Text quantities - . map (map wbToText . showMixedAmountLinesB dopts . fromMaybe nullmixedamt) + . map (map (fmap wbToText) . cellsFromMixedAmount dopts . fromMaybe nullmixedamt) $ vals where - cs = S.toList . foldl' S.union mempty . map maCommodities $ catMaybes vals + cs = S.toList . mconcat . map maCommodities $ catMaybes vals dopts = oneLineNoCostFmt{displayCommodity=layout_ /= LayoutBare, displayCommodityOrder=Just cs, displayMinWidth=Nothing} vals = flattentuples as ++ concat [[rowtot, budgettot] | row_total_] ++ concat [[rowavg, budgetavg] | average_] - joinNames = map (render row :) + joinNames = map (cell (render row) :) -- tests From fdc007d44694a535458dfbfb3d76a89bc3c1af31 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Mon, 12 Aug 2024 07:42:24 +0200 Subject: [PATCH 15/15] doc: hledger.m4.md: new column for FODS balance support for HTML export is now complete --- hledger/hledger.m4.md | 21 ++++++++++----------- 1 file changed, 10 insertions(+), 11 deletions(-) diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 00c9a7958..787cba7d4 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -564,19 +564,18 @@ $ hledger print -o - # write to stdout (the default) Some commands offer other kinds of output, not just text on the terminal. Here are those commands and the formats currently supported: -| - | txt | csv/tsv | html | json | sql | -|--------------------|------------------|------------------|--------------------|------|-----| -| aregister | Y | Y | Y | Y | | -| balance | Y *1* | Y *1* | Y *1,2* | Y | | -| balancesheet | Y *1* | Y *1* | Y *1* | Y | | -| balancesheetequity | Y *1* | Y *1* | Y *1* | Y | | -| cashflow | Y *1* | Y *1* | Y *1* | Y | | -| incomestatement | Y *1* | Y *1* | Y *1* | Y | | -| print | Y | Y | | Y | Y | -| register | Y | Y | | Y | | +| - | txt | csv/tsv | html | fods | json | sql | +|--------------------|------------------|------------------|------------------|------------------|------|-----| +| aregister | Y | Y | Y | | Y | | +| balance | Y *1* | Y *1* | Y *1* | Y *1* | Y | | +| balancesheet | Y *1* | Y *1* | Y *1* | | Y | | +| balancesheetequity | Y *1* | Y *1* | Y *1* | | Y | | +| cashflow | Y *1* | Y *1* | Y *1* | | Y | | +| incomestatement | Y *1* | Y *1* | Y *1* | | Y | | +| print | Y | Y | | | Y | Y | +| register | Y | Y | | | Y | | - *1 Also affected by the balance commands' [`--layout` option](#balance-report-layout).* -- *2 `balance` does not support html output without a report interval or with `--budget`.*