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

Balance export FODS and HTML

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 =
+showMixedAmountLinesB opts ma =
-    map (adBuilder . pad) elided
+    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

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)
 

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

hledger-lib/Hledger/Write/Html.hs

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

hledger-lib/Hledger/Write/Ods.hs

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

hledger-lib/Hledger/Write/Spreadsheet.hs

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

hledger-lib/hledger-lib.cabal

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

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

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,

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)

hledger/Hledger/Cli/Commands/Balance.hs

@@ -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) =
+balanceReportAsCsv opts =
-    headers : concatMap (\(a, _, _, b) -> rows a b) items ++ if no_total_ opts then [] else rows totalRowHeadingCsv total
+    map (map Ods.cellContent) . balanceReportAsSpreadsheet opts
-  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)
 
 -- | 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) =
+multiBalanceReportAsCsvHelper ishtml opts =
-    (headers : concatMap fullRowAsTexts items, totalrows)
+    (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
+      | no_total_ = []
-      | ishtml    = zipWith (:) (totalRowHeadingHtml : repeat "") $ rowAsText opts colspans tr
+      | ishtml    = zipWith (:) (cell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText tr
-      | otherwise = map (totalRowHeadingCsv :)                    $ rowAsText opts colspans tr
+      | otherwise = map (cell totalRowHeadingCsv :) $ rowAsText tr
-    rowAsText = if ishtml then multiBalanceRowAsHtmlText else multiBalanceRowAsCsvText
+    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]
+      LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) allamts]
-      LayoutTall       -> paddedTranspose mempty
+      LayoutTall       -> paddedTranspose Ods.emptyCell
-                           . fmap (showMixedAmountLinesB bopts{displayMaxWidth=Nothing})
+                           . 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
+                           . fmap ( zipWith (\c a -> [wbCell c, a]) cs
-                                  . showMixedAmountLinesB bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing})
+                                  . cellsFromMixedAmount bopts{displayCommodity=False, displayCommodityOrder=Just cs, displayMinWidth=Nothing})
                            $ as  -- Do not include totals column or average for tidy output, as this
                                  -- 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) :)
+    addDateColumns spn@(DateSpan s e) = (wbCell (showDateSpan spn) :)
-                                       . (wbFromText (maybe "" showEFDate s) :)
+                                       . (wbDate (maybe "" showEFDate s) :)
-                                       . (wbFromText (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :)
+                                       . (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

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

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)

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)

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)

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 |
+| -                  | txt              | csv/tsv          | html             | fods             | json | sql |
-|--------------------|------------------|------------------|--------------------|------|-----|
+|--------------------|------------------|------------------|------------------|------------------|------|-----|
-| aregister          | Y                | Y                | Y                  | Y    |     |
+| aregister          | Y                | Y                | Y                |                  | Y    |     |
-| balance            | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1,2</sup>* | 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    |     |
+| 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    |     |
+| 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    |     |
+| 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    |     |
+| incomestatement    | Y *<sup>1</sup>* | Y *<sup>1</sup>* | Y *<sup>1</sup>* |                  | Y    |     |
-| print              | Y                | Y                |                    | Y    | Y   |
+| print              | Y                | Y                |                  |                  | Y    | Y   |
-| register           | 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              |     |     |      |      |     |