cli: lib: Hledger.Write.Ods: basic support for FODS export

used in Commands.Balance

hledger-lib/Hledger/Write/Ods.hs

@@ -0,0 +1,109 @@
+{- |
+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 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 "<?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'>" :
+          []
+
+        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 ++
+        tableConfig (fmap fst tables) ++
+        (Map.toAscList tables >>= \(name,(_,table)) ->
+            tableOpen name ++
+            (table >>= \row ->
+                "<table:table-row>" :
+                (row >>= \cell ->
+                    "<table:table-cell office:value-type='string'>" :
+                    printf "<text:p>%s</text:p>" cell :
+                    "</table:table-cell>" :
+                    []) ++
+                "</table:table-row>" :
+                []) ++
+            tableClose) ++
+        fileClose

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

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

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