Merge pull request #2213 from thielema/balance-export-fods

Balance export FODS and HTML
This commit is contained in:
Simon Michael 2024-08-16 17:35:38 +01:00 committed by GitHub
commit 982401704f
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
16 changed files with 546 additions and 82 deletions

View File

@ -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

View File

@ -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)

View File

@ -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

View File

@ -0,0 +1,39 @@
{-# LANGUAGE OverloadedStrings #-}
{- |
Export spreadsheet table data as HTML table.
This is derived from <https://hackage.haskell.org/package/classify-frog-0.2.4.3/src/src/Spreadsheet/Format.hs>
-}
module Hledger.Write.Html (
printHtml,
) where
import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..))
import qualified Lucid.Base as LucidBase
import qualified Lucid
import Data.Foldable (for_)
printHtml :: [[Cell (Lucid.Html ())]] -> Lucid.Html ()
printHtml table =
Lucid.table_ $ for_ table $ \row ->
Lucid.tr_ $ for_ row $ \cell ->
formatCell cell
formatCell :: Cell (Lucid.Html ()) -> Lucid.Html ()
formatCell cell =
let str = cellContent cell in
case cellStyle cell of
Head -> Lucid.th_ str
Body emph ->
let align =
case cellType cell of
TypeString -> []
TypeDate -> []
_ -> [LucidBase.makeAttribute "align" "right"]
withEmph =
case emph of
Item -> id
Total -> Lucid.b_
in Lucid.td_ align $ withEmph str

View File

@ -0,0 +1,259 @@
{- |
Export table data as OpenDocument Spreadsheet
<https://docs.oasis-open.org/office/OpenDocument/v1.3/>.
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 <https://hackage.haskell.org/package/classify-frog-0.2.4.3/src/src/Spreadsheet/Format.hs>
-}
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
import qualified Data.Text as T
import Data.Text (Text)
import qualified Data.Map as Map
import qualified Data.Set as Set
import Data.Foldable (fold)
import Data.Map (Map)
import Data.Set (Set)
import Data.Maybe (mapMaybe)
import qualified System.IO as IO
import Text.Printf (printf)
printFods ::
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)) $
printf "<?xml version='1.0' encoding='%s'?>" (show encoding) :
"<office:document" :
" office:mimetype='application/vnd.oasis.opendocument.spreadsheet'" :
" office:version='1.3'" :
" xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance'" :
" xmlns:xsd='http://www.w3.org/2001/XMLSchema'" :
" xmlns:text='urn:oasis:names:tc:opendocument:xmlns:text:1.0'" :
" xmlns:style='urn:oasis:names:tc:opendocument:xmlns:style:1.0'" :
" xmlns:meta='urn:oasis:names:tc:opendocument:xmlns:meta:1.0'" :
" xmlns:config='urn:oasis:names:tc:opendocument:xmlns:config:1.0'" :
" xmlns:xlink='http://www.w3.org/1999/xlink'" :
" xmlns:fo='urn:oasis:names:tc:opendocument:xmlns:xsl-fo-compatible:1.0'" :
" xmlns:ooo='http://openoffice.org/2004/office'" :
" xmlns:office='urn:oasis:names:tc:opendocument:xmlns:office:1.0'" :
" xmlns:table='urn:oasis:names:tc:opendocument:xmlns:table:1.0'" :
" xmlns:number='urn:oasis:names:tc:opendocument:xmlns:datastyle:1.0'" :
" 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>" :
" <number:date-style style:name='iso-date'>" :
" <number:year number:style='long'/>" :
" <number:text>-</number:text>" :
" <number:month number:style='long'/>" :
" <number:text>-</number:text>" :
" <number:day number:style='long'/>" :
" </number:date-style>" :
" <style:style style:name='date' style:family='table-cell'" :
" style:data-style-name='iso-date'/>" :
" <style:style style:name='foot-date' style:family='table-cell'" :
" style:data-style-name='iso-date'>" :
" <style:text-properties fo:font-weight='bold'/>" :
" </style:style>" :
customStyles ++
"</office:styles>" :
[]
fileClose =
"</office:document>" :
[]
tableConfig tableNames =
" <office:settings>" :
" <config:config-item-set config:name='ooo:view-settings'>" :
" <config:config-item-map-indexed config:name='Views'>" :
" <config:config-item-map-entry>" :
" <config:config-item-map-named config:name='Tables'>" :
(fold $
flip Map.mapWithKey tableNames $ \tableName (mTopRow,mLeftColumn) ->
printf " <config:config-item-map-entry config:name='%s'>" tableName :
(flip foldMap mLeftColumn $ \leftColumn ->
" <config:config-item config:name='HorizontalSplitMode' config:type='short'>2</config:config-item>" :
printf " <config:config-item config:name='HorizontalSplitPosition' config:type='int'>%d</config:config-item>" leftColumn :
printf " <config:config-item config:name='PositionRight' config:type='int'>%d</config:config-item>" leftColumn :
[]) ++
(flip foldMap mTopRow $ \topRow ->
" <config:config-item config:name='VerticalSplitMode' config:type='short'>2</config:config-item>" :
printf " <config:config-item config:name='VerticalSplitPosition' config:type='int'>%d</config:config-item>" topRow :
printf " <config:config-item config:name='PositionBottom' config:type='int'>%d</config:config-item>" topRow :
[]) ++
" </config:config-item-map-entry>" :
[]) ++
" </config:config-item-map-named>" :
" </config:config-item-map-entry>" :
" </config:config-item-map-indexed>" :
" </config:config-item-set>" :
" </office:settings>" :
[]
tableOpen name =
"<office:body>" :
"<office:spreadsheet>" :
printf "<table:table table:name='%s'>" name :
[]
tableClose =
"</table:table>" :
"</office:spreadsheet>" :
"</office:body>" :
[]
in TL.unlines $ map (TL.fromStrict . T.pack) $
fileOpen
(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 ++
(table >>= \row ->
"<table:table-row>" :
(row >>= formatCell) ++
"</table:table-row>" :
[]) ++
tableClose) ++
fileClose
cellStyles :: [Cell Text] -> Set (Emphasis, (CommoditySymbol, AmountPrecision))
cellStyles =
Set.fromList .
mapMaybe (\cell ->
case cellType cell of
TypeAmount amt ->
Just
(case cellStyle cell of
Body emph -> emph
Head -> Total,
(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 " <number:number-style style:name='number-%s'>" name :
printf " <number:number number:min-integer-digits='1'%s/>" precStr :
printf " <number:text>%s%s</number:text>"
(if T.null comm then "" else " ") comm :
" </number:number-style>" :
[]
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:style style:family='table-cell' %s/>" style :
[]
Total ->
printf " <style:style style:family='table-cell' %s>" style :
" <style:text-properties fo:font-weight='bold'/>" :
" </style:style>" :
[]
formatCell :: Cell Text -> [String]
formatCell cell =
let style, valueType :: String
style =
case (cellStyle cell, cellType cell) of
(Body emph, TypeAmount amt) -> tableStyle $ numberStyle emph amt
(Body Item, TypeString) -> ""
(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 "%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
printf "<table:table-cell%s %s>" style valueType :
printf "<text:p>%s</text:p>" (escape $ T.unpack $ cellContent cell) :
"</table:table-cell>" :
[]
escape :: String -> String
escape =
concatMap $ \c ->
case c of
'\n' -> "&#10;"
'&' -> "&amp;"
'<' -> "&lt;"
'>' -> "&gt;"
'"' -> "&quot;"
'\'' -> "&apos;"
_ -> [c]

View File

@ -0,0 +1,49 @@
{- |
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,
emptyCell,
) where
import Hledger.Data.Types (Amount)
data Type =
TypeString
| TypeAmount !Amount
| TypeMixedAmount
| TypeDate
deriving (Eq, Ord, Show)
data Style = Body Emphasis | Head
deriving (Eq, Ord, Show)
data Emphasis = Item | Total
deriving (Eq, Ord, Show)
data Cell text =
Cell {
cellType :: Type,
cellStyle :: Style,
cellContent :: text
}
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 = text
}
emptyCell :: (Monoid text) => Cell text
emptyCell = defaultCell mempty

View File

@ -80,12 +80,15 @@ 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.Write.Ods
Hledger.Write.Html
Hledger.Write.Spreadsheet
Hledger.Reports
Hledger.Reports.ReportOptions
Hledger.Reports.ReportTypes
@ -135,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

View File

@ -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
@ -142,13 +143,16 @@ 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.Write.Ods
- Hledger.Write.Html
- Hledger.Write.Spreadsheet
- Hledger.Reports
- Hledger.Reports.ReportOptions
- Hledger.Reports.ReportTypes

View File

@ -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,

View File

@ -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)

View File

@ -248,6 +248,7 @@ module Hledger.Cli.Commands.Balance (
-- ** balance output rendering
,balanceReportAsText
,balanceReportAsCsv
,balanceReportAsSpreadsheet
,balanceReportItemAsText
,multiBalanceRowAsCsvText
,multiBalanceRowAsText
@ -258,6 +259,7 @@ module Hledger.Cli.Commands.Balance (
,multiBalanceReportHtmlFootRow
,multiBalanceReportAsTable
,multiBalanceReportTableAsText
,multiBalanceReportAsSpreadsheet
-- ** HTML output helpers
,stylesheet_
,styles_
@ -282,6 +284,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 +299,15 @@ 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.Read.CsvUtils (CSV, printCSV, printTSV)
import Hledger.Write.Csv (CSV, printCSV, printTSV)
import Hledger.Write.Ods (printFods)
import Hledger.Write.Html (printHtml)
import qualified Hledger.Write.Spreadsheet as Ods
-- | Command line options for this command.
@ -354,7 +362,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
]
)
@ -376,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
@ -387,6 +399,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
@ -396,8 +410,10 @@ 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 -> (<>"\n") . L.renderText .
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:
writeOutputLazyText opts $ render ropts report
where
@ -422,26 +438,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
@ -552,6 +550,64 @@ renderComponent topaligned oneline opts (acctname, dep, total) (FormatField ljus
,displayColour = color_ opts
}
-- | Render a single-column balance report as FODS.
balanceReportAsSpreadsheet :: ReportOpts -> BalanceReport -> [[Ods.Cell Text]]
balanceReportAsSpreadsheet opts (items, total) =
headers :
concatMap (\(a, _, _, b) -> rows a b) items ++
if no_total_ opts then []
else map (map (\c -> c {Ods.cellStyle = Ods.Body Ods.Total})) $
rows totalRowHeadingCsv total
where
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 Text]]
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 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.
@ -568,21 +624,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.
@ -708,6 +778,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 $
@ -799,31 +880,39 @@ 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
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) = (wbFromText (showDateSpan spn) :)
. (wbFromText (maybe "" showEFDate s) :)
. (wbFromText (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :)
addDateColumns spn@(DateSpan s e) = (wbCell (showDateSpan spn) :)
. (wbDate (maybe "" showEFDate s) :)
. (wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :)
paddedTranspose :: a -> [[a]] -> [[a]]
paddedTranspose _ [] = [[]]
@ -846,9 +935,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,
@ -1102,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_]
@ -1119,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

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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)

View File

@ -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 *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1,2</sup>* | Y | |
| balancesheet | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y | |
| balancesheetequity | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y | |
| cashflow | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y | |
| incomestatement | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y | |
| print | Y | Y | | Y | Y |
| register | Y | Y | | Y | |
| - | txt | csv/tsv | html | fods | json | sql |
|--------------------|------------------|------------------|------------------|------------------|------|-----|
| aregister | Y | Y | Y | | Y | |
| balance | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y | |
| balancesheet | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | | Y | |
| balancesheetequity | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | | Y | |
| cashflow | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | | Y | |
| incomestatement | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* | | Y | |
| print | Y | Y | | | Y | Y |
| register | Y | Y | | | Y | |
- *<sup>1</sup> Also affected by the balance commands' [`--layout` option](#balance-report-layout).*
- *<sup>2</sup> `balance` does not support html output without a report interval or with `--budget`.*
<!--
| accounts | | | | | |