diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index 0b255e3ad..aa61d9898 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -155,6 +155,7 @@ module Hledger.Data.Amount ( showMixedAmountWithZeroCommodity, showMixedAmountB, showMixedAmountLinesB, + showMixedAmountLinesPartsB, wbToText, wbUnpack, mixedAmountSetPrecision, @@ -1120,10 +1121,17 @@ showMixedAmountB opts ma -- This returns the list of WideBuilders: one for each Amount, and padded/elided to the appropriate width. -- This does not honour displayOneLine; all amounts will be displayed as if displayOneLine were False. showMixedAmountLinesB :: AmountFormat -> MixedAmount -> [WideBuilder] -showMixedAmountLinesB opts@AmountFormat{displayMaxWidth=mmax,displayMinWidth=mmin} ma = - map (adBuilder . pad) elided +showMixedAmountLinesB opts ma = + map fst $ showMixedAmountLinesPartsB opts ma + +-- | Like 'showMixedAmountLinesB' but also returns +-- the amounts associated with each text builder. +showMixedAmountLinesPartsB :: AmountFormat -> MixedAmount -> [(WideBuilder, Amount)] +showMixedAmountLinesPartsB opts@AmountFormat{displayMaxWidth=mmax,displayMinWidth=mmin} ma = + zip (map (adBuilder . pad) elided) amts where - astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $ + astrs = amtDisplayList (wbWidth sep) (showAmountB opts) amts + amts = orderedAmounts opts $ if displayCost opts then ma else mixedAmountStripCosts ma sep = WideBuilder (TB.singleton '\n') 0 width = maximum $ map (wbWidth . adBuilder) elided diff --git a/hledger-lib/Hledger/Read/RulesReader.hs b/hledger-lib/Hledger/Read/RulesReader.hs index 5181ec7a8..982baa419 100644 --- a/hledger-lib/Hledger/Read/RulesReader.hs +++ b/hledger-lib/Hledger/Read/RulesReader.hs @@ -77,7 +77,7 @@ import Text.Printf (printf) import Hledger.Data import Hledger.Utils import Hledger.Read.Common (aliasesFromOpts, Reader(..), InputOpts(..), amountp, statusp, journalFinalise, accountnamep, commenttagsp ) -import Hledger.Read.CsvUtils +import Hledger.Write.Csv import System.Directory (doesFileExist, getHomeDirectory) import Data.Either (fromRight) diff --git a/hledger-lib/Hledger/Read/CsvUtils.hs b/hledger-lib/Hledger/Write/Csv.hs similarity index 92% rename from hledger-lib/Hledger/Read/CsvUtils.hs rename to hledger-lib/Hledger/Write/Csv.hs index a9d4aa9de..42c6393d2 100644 --- a/hledger-lib/Hledger/Read/CsvUtils.hs +++ b/hledger-lib/Hledger/Write/Csv.hs @@ -10,7 +10,7 @@ CSV utilities. {-# LANGUAGE OverloadedStrings #-} --- ** exports -module Hledger.Read.CsvUtils ( +module Hledger.Write.Csv ( CSV, CsvRecord, CsvValue, printCSV, printTSV, @@ -37,12 +37,12 @@ type CSV = [CsvRecord] type CsvRecord = [CsvValue] type CsvValue = Text -printCSV :: [CsvRecord] -> TL.Text +printCSV :: CSV -> TL.Text printCSV = TB.toLazyText . unlinesB . map printRecord where printRecord = foldMap TB.fromText . intersperse "," . map printField printField = wrap "\"" "\"" . T.replace "\"" "\"\"" -printTSV :: [CsvRecord] -> TL.Text +printTSV :: CSV -> TL.Text printTSV = TB.toLazyText . unlinesB . map printRecord where printRecord = foldMap TB.fromText . intersperse "\t" . map printField printField = T.map replaceWhitespace diff --git a/hledger-lib/Hledger/Write/Html.hs b/hledger-lib/Hledger/Write/Html.hs new file mode 100644 index 000000000..b748876cb --- /dev/null +++ b/hledger-lib/Hledger/Write/Html.hs @@ -0,0 +1,39 @@ +{-# LANGUAGE OverloadedStrings #-} +{- | +Export spreadsheet table data as HTML table. + +This is derived from +-} +module Hledger.Write.Html ( + printHtml, + ) where + +import Hledger.Write.Spreadsheet (Type(..), Style(..), Emphasis(..), Cell(..)) + +import qualified 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 diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs new file mode 100644 index 000000000..cdeb014f6 --- /dev/null +++ b/hledger-lib/Hledger/Write/Ods.hs @@ -0,0 +1,259 @@ +{- | +Export table data as OpenDocument Spreadsheet +. +This format supports character encodings, fixed header rows and columns, +number formatting, text styles, merged cells, formulas, hyperlinks. +Currently we support Flat ODS, a plain uncompressed XML format. + +This is derived from + +-} +module Hledger.Write.Ods ( + 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 "" (show encoding) : + "" : + "" : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " " : + " -" : + " " : + " -" : + " " : + " " : + " " : + " " : + " " : + " " : + customStyles ++ + "" : + [] + + fileClose = + "" : + [] + + tableConfig tableNames = + " " : + " " : + " " : + " " : + " " : + (fold $ + flip Map.mapWithKey tableNames $ \tableName (mTopRow,mLeftColumn) -> + printf " " tableName : + (flip foldMap mLeftColumn $ \leftColumn -> + " 2" : + printf " %d" leftColumn : + printf " %d" leftColumn : + []) ++ + (flip foldMap mTopRow $ \topRow -> + " 2" : + printf " %d" topRow : + printf " %d" topRow : + []) ++ + " " : + []) ++ + " " : + " " : + " " : + " " : + " " : + [] + + tableOpen name = + "" : + "" : + printf "" name : + [] + + tableClose = + "" : + "" : + "" : + [] + + in TL.unlines $ map (TL.fromStrict . T.pack) $ + fileOpen + (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 -> + "" : + (row >>= formatCell) ++ + "" : + []) ++ + 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 " " name : + printf " " precStr : + printf " %s%s" + (if T.null comm then "" else " ") comm : + " " : + [] + +emphasisName :: Emphasis -> String +emphasisName emph = + case emph of + Item -> "item" + Total -> "total" + +cellConfig :: (Emphasis, (CommoditySymbol, AmountPrecision)) -> [String] +cellConfig (emph, numParam) = + let name = numberStyleName numParam in + let style :: String + style = + printf "style:name='%s-%s' style:data-style-name='number-%s'" + (emphasisName emph) name name in + case emph of + Item -> + printf " " style : + [] + Total -> + printf " " style : + " " : + " " : + [] + + +formatCell :: Cell 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 "" style valueType : + printf "%s" (escape $ T.unpack $ cellContent cell) : + "" : + [] + +escape :: String -> String +escape = + concatMap $ \c -> + case c of + '\n' -> " " + '&' -> "&" + '<' -> "<" + '>' -> ">" + '"' -> """ + '\'' -> "'" + _ -> [c] diff --git a/hledger-lib/Hledger/Write/Spreadsheet.hs b/hledger-lib/Hledger/Write/Spreadsheet.hs new file mode 100644 index 000000000..96fb14610 --- /dev/null +++ b/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 diff --git a/hledger-lib/hledger-lib.cabal b/hledger-lib/hledger-lib.cabal index d58619e31..6efe19c8a 100644 --- a/hledger-lib/hledger-lib.cabal +++ b/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 diff --git a/hledger-lib/package.yaml b/hledger-lib/package.yaml index 21fb59f42..a8a6f1c80 100644 --- a/hledger-lib/package.yaml +++ b/hledger-lib/package.yaml @@ -61,6 +61,7 @@ dependencies: - file-embed >=0.0.10 - filepath - hashtables >=1.2.3.1 +- lucid - megaparsec >=7.0.0 && <9.7 - microlens >=0.4 - microlens-th >=0.4 @@ -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 diff --git a/hledger/Hledger/Cli/CliOptions.hs b/hledger/Hledger/Cli/CliOptions.hs index 7ba115893..d79a7cf4c 100644 --- a/hledger/Hledger/Cli/CliOptions.hs +++ b/hledger/Hledger/Cli/CliOptions.hs @@ -718,7 +718,7 @@ defaultOutputFormat = "txt" -- | All the output formats known by any command, for outputFormatFromOpts. -- To automatically infer it from -o/--output-file, it needs to be listed here. outputFormats :: [String] -outputFormats = [defaultOutputFormat, "beancount", "csv", "json", "html", "sql", "tsv"] +outputFormats = [defaultOutputFormat, "beancount", "csv", "json", "html", "sql", "tsv", "fods"] -- | Get the output format from the --output-format option, -- otherwise from a recognised file extension in the --output-file option, diff --git a/hledger/Hledger/Cli/Commands/Aregister.hs b/hledger/Hledger/Cli/Commands/Aregister.hs index 6f177cbfd..62f543ceb 100644 --- a/hledger/Hledger/Cli/Commands/Aregister.hs +++ b/hledger/Hledger/Cli/Commands/Aregister.hs @@ -29,7 +29,7 @@ import Lucid as L hiding (value_) import System.Console.CmdArgs.Explicit (flagNone, flagReq) import Hledger -import Hledger.Read.CsvUtils (CSV, CsvRecord, printCSV, printTSV) +import Hledger.Write.Csv (CSV, CsvRecord, printCSV, printTSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils import Text.Tabular.AsciiWide hiding (render) diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index b6db9875f..81b5b634b 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -248,6 +248,7 @@ module Hledger.Cli.Commands.Balance ( -- ** balance output rendering ,balanceReportAsText ,balanceReportAsCsv + ,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 diff --git a/hledger/Hledger/Cli/Commands/Balance.md b/hledger/Hledger/Cli/Commands/Balance.md index 5ea0f27cd..147c54148 100644 --- a/hledger/Hledger/Cli/Commands/Balance.md +++ b/hledger/Hledger/Cli/Commands/Balance.md @@ -59,7 +59,7 @@ Flags: 'bare' : commodity symbols in one column 'tidy' : every attribute in its own column -O --output-format=FMT select the output format. Supported formats: - txt, html, csv, tsv, json. + txt, html, csv, tsv, json, fods. -o --output-file=FILE write output to FILE. A file extension matching one of the above formats selects that format. ``` @@ -133,7 +133,7 @@ Many of these work with the higher-level commands as well. This command supports the [output destination](#output-destination) and [output format](#output-format) options, -with output formats `txt`, `csv`, `tsv` (*Added in 1.32*), `json`, and (multi-period reports only:) `html`. +with output formats `txt`, `csv`, `tsv` (*Added in 1.32*), `json`, and (multi-period reports only:) `html`, `fods` (*Added in 1.40*). In `txt` output in a colour-supporting terminal, negative amounts are shown in red. ### Simple balance report diff --git a/hledger/Hledger/Cli/Commands/Print.hs b/hledger/Hledger/Cli/Commands/Print.hs index 3f40d299b..9fffb5102 100644 --- a/hledger/Hledger/Cli/Commands/Print.hs +++ b/hledger/Hledger/Cli/Commands/Print.hs @@ -27,7 +27,7 @@ import Lens.Micro ((^.), _Just, has) import System.Console.CmdArgs.Explicit import Hledger -import Hledger.Read.CsvUtils (CSV, printCSV, printTSV) +import Hledger.Write.Csv (CSV, printCSV, printTSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils import System.Exit (exitFailure) diff --git a/hledger/Hledger/Cli/Commands/Register.hs b/hledger/Hledger/Cli/Commands/Register.hs index d03c277a0..77c89a607 100644 --- a/hledger/Hledger/Cli/Commands/Register.hs +++ b/hledger/Hledger/Cli/Commands/Register.hs @@ -27,7 +27,7 @@ import qualified Data.Text.Lazy.Builder as TB import System.Console.CmdArgs.Explicit (flagNone, flagReq) import Hledger hiding (per) -import Hledger.Read.CsvUtils (CSV, CsvRecord, printCSV, printTSV) +import Hledger.Write.Csv (CSV, CsvRecord, printCSV, printTSV) import Hledger.Cli.CliOptions import Hledger.Cli.Utils import Text.Tabular.AsciiWide hiding (render) diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 912b19a3e..5500fe738 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -21,7 +21,7 @@ import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time.Calendar (Day, addDays) import System.Console.CmdArgs.Explicit as C (Mode, flagNone, flagReq) -import Hledger.Read.CsvUtils (CSV, printCSV, printTSV) +import Hledger.Write.Csv (CSV, printCSV, printTSV) import Lucid as L hiding (value_) import Safe (tailDef) import Text.Tabular.AsciiWide as Tabular hiding (render) diff --git a/hledger/hledger.m4.md b/hledger/hledger.m4.md index 00c9a7958..787cba7d4 100644 --- a/hledger/hledger.m4.md +++ b/hledger/hledger.m4.md @@ -564,19 +564,18 @@ $ hledger print -o - # write to stdout (the default) Some commands offer other kinds of output, not just text on the terminal. Here are those commands and the formats currently supported: -| - | txt | csv/tsv | html | json | sql | -|--------------------|------------------|------------------|--------------------|------|-----| -| aregister | Y | Y | Y | Y | | -| balance | Y *1* | Y *1* | Y *1,2* | Y | | -| balancesheet | Y *1* | Y *1* | Y *1* | Y | | -| balancesheetequity | Y *1* | Y *1* | Y *1* | Y | | -| cashflow | Y *1* | Y *1* | Y *1* | Y | | -| incomestatement | Y *1* | Y *1* | Y *1* | Y | | -| print | Y | Y | | Y | Y | -| register | Y | Y | | Y | | +| - | txt | csv/tsv | html | fods | json | sql | +|--------------------|------------------|------------------|------------------|------------------|------|-----| +| aregister | Y | Y | Y | | Y | | +| balance | Y *1* | Y *1* | Y *1* | Y *1* | Y | | +| balancesheet | Y *1* | Y *1* | Y *1* | | Y | | +| balancesheetequity | Y *1* | Y *1* | Y *1* | | Y | | +| cashflow | Y *1* | Y *1* | Y *1* | | Y | | +| incomestatement | Y *1* | Y *1* | Y *1* | | Y | | +| print | Y | Y | | | Y | Y | +| register | Y | Y | | | Y | | - *1 Also affected by the balance commands' [`--layout` option](#balance-report-layout).* -- *2 `balance` does not support html output without a report interval or with `--budget`.*