cli: lib: Hledger.Write.Ods: basic support for FODS export
used in Commands.Balance
This commit is contained in:
Henning Thielemann
parent
14b5a1f82a
commit
0e158d0c3e
109
hledger-lib/Hledger/Write/Ods.hs
Normal file
109
hledger-lib/Hledger/Write/Ods.hs
Normal file
@ -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
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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,
|
||||
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user