diff --git a/hledger-lib/Hledger/Data/Amount.hs b/hledger-lib/Hledger/Data/Amount.hs index fd462aa48..5e5d65ab1 100644 --- a/hledger-lib/Hledger/Data/Amount.hs +++ b/hledger-lib/Hledger/Data/Amount.hs @@ -152,7 +152,7 @@ import Data.Foldable (toList) import Data.List (find, foldl', intercalate, intersperse, mapAccumL, partition) import Data.List.NonEmpty (NonEmpty(..), nonEmpty) import qualified Data.Map.Strict as M -import Data.Maybe (fromMaybe, isNothing) +import Data.Maybe (fromMaybe, isNothing, isJust) import Data.Semigroup (Semigroup(..)) import qualified Data.Text as T import qualified Data.Text.Lazy.Builder as TB @@ -175,6 +175,9 @@ data AmountDisplayOpts = AmountDisplayOpts , displayOneLine :: Bool -- ^ Whether to display on one line. , displayMinWidth :: Maybe Int -- ^ Minimum width to pad to , displayMaxWidth :: Maybe Int -- ^ Maximum width to clip to + -- | Display amounts in this order (without the commodity symbol) and display + -- a 0 in case a corresponding commodity does not exist + , displayOrder :: Maybe [CommoditySymbol] } deriving (Show) -- | Display Amount and MixedAmount with no colour. @@ -186,8 +189,9 @@ noColour = AmountDisplayOpts { displayPrice = True , displayColour = False , displayZeroCommodity = False , displayOneLine = False - , displayMinWidth = Nothing + , displayMinWidth = Just 0 , displayMaxWidth = Nothing + , displayOrder = Nothing } -- | Display Amount and MixedAmount with no prices. @@ -429,14 +433,15 @@ showAmountB :: AmountDisplayOpts -> Amount -> WideBuilder showAmountB _ Amount{acommodity="AUTO"} = mempty showAmountB opts a@Amount{astyle=style} = color $ case ascommodityside style of - L -> c' <> space <> quantity' <> price - R -> quantity' <> space <> c' <> price + L -> showC c' space <> quantity' <> price + R -> quantity' <> showC space c' <> price where quantity = showamountquantity a (quantity',c) | amountLooksZero a && not (displayZeroCommodity opts) = (WideBuilder (TB.singleton '0') 1,"") | otherwise = (quantity, quoteCommoditySymbolIfNeeded $ acommodity a) space = if not (T.null c) && ascommodityspaced style then WideBuilder (TB.singleton ' ') 1 else mempty c' = WideBuilder (TB.fromText c) (textWidth c) + showC l r = if isJust (displayOrder opts) then mempty else l <> r price = if displayPrice opts then showAmountPrice a else mempty color = if displayColour opts && isNegativeAmount a then colorB Dull Red else id @@ -820,13 +825,16 @@ showMixedAmountLinesB :: AmountDisplayOpts -> MixedAmount -> [WideBuilder] showMixedAmountLinesB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWidth=mmin} ma = map (adBuilder . pad) elided where - astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . amounts $ + astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $ if displayPrice opts then ma else mixedAmountStripPrices ma sep = WideBuilder (TB.singleton '\n') 0 - width = maximum $ fromMaybe 0 mmin : map (wbWidth . adBuilder) elided + width = maximum $ map (wbWidth . adBuilder) elided - pad amt = amt{ adBuilder = WideBuilder (TB.fromText $ T.replicate w " ") w <> adBuilder amt } - where w = width - wbWidth (adBuilder amt) + pad amt + | Just mw <- mmin = + let w = (max width mw) - wbWidth (adBuilder amt) + in amt{ adBuilder = WideBuilder (TB.fromText $ T.replicate w " ") w <> adBuilder amt } + | otherwise = amt elided = maybe id elideTo mmax astrs elideTo m xs = maybeAppend elisionStr short @@ -843,7 +851,7 @@ showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWi . max width $ fromMaybe 0 mmin where width = maybe 0 adTotal $ lastMay elided - astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . amounts $ + astrs = amtDisplayList (wbWidth sep) (showAmountB opts) . orderedAmounts opts $ if displayPrice opts then ma else mixedAmountStripPrices ma sep = WideBuilder (TB.fromString ", ") 2 n = length astrs @@ -866,6 +874,15 @@ showMixedAmountOneLineB opts@AmountDisplayOpts{displayMaxWidth=mmax,displayMinWi -- Add the elision strings (if any) to each amount withElided = zipWith (\num amt -> (amt, elisionDisplay Nothing (wbWidth sep) num amt)) [n-1,n-2..0] +orderedAmounts :: AmountDisplayOpts -> MixedAmount -> [Amount] +orderedAmounts AmountDisplayOpts{displayOrder=ord} ma + | Just cs <- ord = fmap pad cs + | otherwise = as + where + as = amounts ma + pad c = fromMaybe (amountWithCommodity c nullamt) . find ((==) c . acommodity) $ as + + data AmountDisplay = AmountDisplay { adBuilder :: !WideBuilder -- ^ String representation of the Amount , adTotal :: !Int -- ^ Cumulative length of MixedAmount this Amount is part of, diff --git a/hledger-lib/Hledger/Data/StringFormat.hs b/hledger-lib/Hledger/Data/StringFormat.hs index 3282bdc45..b70551e6b 100644 --- a/hledger-lib/Hledger/Data/StringFormat.hs +++ b/hledger-lib/Hledger/Data/StringFormat.hs @@ -136,7 +136,7 @@ formatfieldp = do char '(' f <- fieldp char ')' - return $ FormatField (isJust leftJustified) (parseDec minWidth) (parseDec maxWidth) f + return $ FormatField (isJust leftJustified) (parseDec minWidth <|> Just 0) (parseDec maxWidth) f where parseDec s = case s of Just text -> Just m where ((m,_):_) = readDec text @@ -175,20 +175,20 @@ tests_StringFormat = tests "StringFormat" [ in tests "parseStringFormat" [ "" `gives` (defaultStringFormatStyle []) , "D" `gives` (defaultStringFormatStyle [FormatLiteral "D"]) - , "%(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing DescriptionField]) - , "%(total)" `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField]) + , "%(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 0) Nothing DescriptionField]) + , "%(total)" `gives` (defaultStringFormatStyle [FormatField False (Just 0) Nothing TotalField]) -- TODO -- , "^%(total)" `gives` (TopAligned [FormatField False Nothing Nothing TotalField]) -- , "_%(total)" `gives` (BottomAligned [FormatField False Nothing Nothing TotalField]) -- , ",%(total)" `gives` (OneLine [FormatField False Nothing Nothing TotalField]) - , "Hello %(date)!" `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False Nothing Nothing DescriptionField, FormatLiteral "!"]) - , "%-(date)" `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField]) + , "Hello %(date)!" `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False (Just 0) Nothing DescriptionField, FormatLiteral "!"]) + , "%-(date)" `gives` (defaultStringFormatStyle [FormatField True (Just 0) Nothing DescriptionField]) , "%20(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing DescriptionField]) - , "%.10(date)" `gives` (defaultStringFormatStyle [FormatField False Nothing (Just 10) DescriptionField]) + , "%.10(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 0) (Just 10) DescriptionField]) , "%20.10(date)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) (Just 10) DescriptionField]) , "%20(account) %.10(total)" `gives` (defaultStringFormatStyle [FormatField False (Just 20) Nothing AccountField ,FormatLiteral " " - ,FormatField False Nothing (Just 10) TotalField + ,FormatField False (Just 0) (Just 10) TotalField ]) , test "newline not parsed" $ assertLeft $ parseStringFormat "\n" ] diff --git a/hledger-lib/Hledger/Reports/ReportOptions.hs b/hledger-lib/Hledger/Reports/ReportOptions.hs index f88b063f7..baa03b063 100644 --- a/hledger-lib/Hledger/Reports/ReportOptions.hs +++ b/hledger-lib/Hledger/Reports/ReportOptions.hs @@ -156,6 +156,7 @@ data ReportOpts = ReportOpts { -- whether stdout is an interactive terminal, and the value of -- TERM and existence of NO_COLOR environment variables. ,transpose_ :: Bool + ,commodity_column_:: Bool } deriving (Show) instance Default ReportOpts where def = defreportopts @@ -193,6 +194,7 @@ defreportopts = ReportOpts , normalbalance_ = Nothing , color_ = False , transpose_ = False + , commodity_column_ = False } -- | Generate a ReportOpts from raw command-line input, given a day. @@ -243,6 +245,7 @@ rawOptsToReportOpts d rawopts = ,pretty_tables_ = boolopt "pretty-tables" rawopts ,color_ = useColorOnStdout -- a lower-level helper ,transpose_ = boolopt "transpose" rawopts + ,commodity_column_= boolopt "commodity-column" rawopts } -- | The result of successfully parsing a ReportOpts on a particular diff --git a/hledger-lib/Hledger/Utils/Text.hs b/hledger-lib/Hledger/Utils/Text.hs index 88cb423c2..c2e0d429b 100644 --- a/hledger-lib/Hledger/Utils/Text.hs +++ b/hledger-lib/Hledger/Utils/Text.hs @@ -41,6 +41,7 @@ module Hledger.Utils.Text -- * wide-character-aware layout WideBuilder(..), wbToText, + wbFromText, wbUnpack, textWidth, textTakeWidth, @@ -61,7 +62,7 @@ import qualified Data.Text.Lazy.Builder as TB import Hledger.Utils.Test ((@?=), test, tests) import Text.Tabular.AsciiWide (Align(..), Header(..), Properties(..), TableOpts(..), renderRow, textCell) -import Text.WideString (WideBuilder(..), wbToText, wbUnpack, charWidth, textWidth) +import Text.WideString (WideBuilder(..), wbToText, wbFromText, wbUnpack, charWidth, textWidth) -- lowercase, uppercase :: String -> String diff --git a/hledger-lib/Text/Tabular/AsciiWide.hs b/hledger-lib/Text/Tabular/AsciiWide.hs index 3b4073952..cce099ac7 100644 --- a/hledger-lib/Text/Tabular/AsciiWide.hs +++ b/hledger-lib/Text/Tabular/AsciiWide.hs @@ -10,13 +10,16 @@ module Text.Tabular.AsciiWide , render , renderTable , renderTableB +, renderTableByRowsB , renderRow , renderRowB +, renderColumns , Cell(..) , Align(..) , emptyCell , textCell +, textsCell , cellWidth ) where @@ -30,7 +33,7 @@ import qualified Data.Text.Lazy as TL import Data.Text.Lazy.Builder (Builder, fromString, fromText, singleton, toLazyText) import Safe (maximumMay) import Text.Tabular -import Text.WideString (WideBuilder(..), textWidth) +import Text.WideString (WideBuilder(..), wbFromText, textWidth) -- | The options to use for rendering a table. @@ -60,6 +63,10 @@ emptyCell = Cell TopRight [] textCell :: Align -> Text -> Cell textCell a x = Cell a . map (\x -> WideBuilder (fromText x) (textWidth x)) $ if T.null x then [""] else T.lines x +-- | Create a multi-line cell from the given contents with its natural width. +textsCell :: Align -> [Text] -> Cell +textsCell a = Cell a . fmap wbFromText + -- | Return the width of a Cell. cellWidth :: Cell -> Int cellWidth (Cell _ xs) = fromMaybe 0 . maximumMay $ map wbWidth xs @@ -86,20 +93,31 @@ renderTableB :: TableOpts -- ^ Options controlling Table rendering -> (a -> Cell) -- ^ Function determining the string and width of a cell -> Table rh ch a -> Builder -renderTableB topts@TableOpts{prettyTable=pretty, tableBorders=borders} fr fc f (Table rh ch cells) = +renderTableB topts fr fc f = renderTableByRowsB topts (fmap fc) (\(rh, as) -> (fr rh, fmap f as)) + +-- | A version of renderTable that operates on rows (including the 'row' of +-- column headers) and returns the underlying Builder. +renderTableByRowsB :: TableOpts -- ^ Options controlling Table rendering + -> ([ch] -> [Cell]) -- ^ Rendering function for column headers + -> ((rh, [a]) -> (Cell, [Cell])) -- ^ Rendering function for row and row header + -> Table rh ch a + -> Builder +renderTableByRowsB topts@TableOpts{prettyTable=pretty, tableBorders=borders} fc f (Table rh ch cells) = unlinesB . addBorders $ renderColumns topts sizes ch2 : bar VM DoubleLine -- +======================================+ : renderRs (fmap renderR $ zipHeader [] cellContents rowHeaders) where + renderR :: ([Cell], Cell) -> Builder renderR (cs,h) = renderColumns topts sizes $ Group DoubleLine [ Header h , fmap fst $ zipHeader emptyCell cs colHeaders ] - rowHeaders = fmap fr rh - colHeaders = fmap fc ch - cellContents = map (map f) cells + rows = unzip . fmap f $ zip (headerContents rh) cells + rowHeaders = fmap fst $ zipHeader emptyCell (fst rows) rh + colHeaders = fmap fst $ zipHeader emptyCell (fc $ headerContents ch) ch + cellContents = snd rows -- ch2 and cell2 include the row and column labels ch2 = Group DoubleLine [Header emptyCell, colHeaders] @@ -162,6 +180,7 @@ renderColumns TableOpts{prettyTable=pretty, tableBorders=borders, borderSpaces=s padCell (w, Cell TopRight ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls padCell (w, Cell BottomRight ls) = map (\x -> fromText (T.replicate (w - wbWidth x) " ") <> wbBuilder x) ls + -- Pad each cell to have the same number of lines padRow (Cell TopLeft ls) = Cell TopLeft $ ls ++ replicate (nLines - length ls) mempty padRow (Cell TopRight ls) = Cell TopRight $ ls ++ replicate (nLines - length ls) mempty diff --git a/hledger-lib/Text/WideString.hs b/hledger-lib/Text/WideString.hs index 3adfad36b..ae10074c2 100644 --- a/hledger-lib/Text/WideString.hs +++ b/hledger-lib/Text/WideString.hs @@ -8,7 +8,8 @@ module Text.WideString ( -- * Text Builders which keep track of length WideBuilder(..), wbUnpack, - wbToText + wbToText, + wbFromText ) where import Data.Text (Text) @@ -33,6 +34,10 @@ instance Monoid WideBuilder where wbToText :: WideBuilder -> Text wbToText = TL.toStrict . TB.toLazyText . wbBuilder +-- | Convert a WideBuilder to a strict Text. +wbFromText :: Text -> WideBuilder +wbFromText t = WideBuilder (TB.fromText t) (textWidth t) + -- | Convert a WideBuilder to a String. wbUnpack :: WideBuilder -> String wbUnpack = TL.unpack . TB.toLazyText . wbBuilder diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs index 30aec8a77..15848d2ab 100644 --- a/hledger/Hledger/Cli/Commands/Balance.hs +++ b/hledger/Hledger/Cli/Commands/Balance.hs @@ -244,6 +244,7 @@ module Hledger.Cli.Commands.Balance ( balancemode ,balance ,balanceReportAsText + ,balanceReportAsCsv ,balanceReportItemAsText ,multiBalanceReportAsText ,multiBalanceReportAsCsv @@ -255,14 +256,17 @@ module Hledger.Cli.Commands.Balance ( ) where import Data.Default (def) -import Data.List (intersperse, transpose) -import Data.Maybe (fromMaybe, maybeToList) +import Data.List (intersperse, transpose, foldl', transpose) +import qualified Data.Map as M +import qualified Data.Set as S +import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TB import Data.Time (fromGregorian) import System.Console.CmdArgs.Explicit as C import Lucid as L +import Safe (headMay, maximumMay) import Text.Tabular.AsciiWide as Tab import Hledger @@ -306,6 +310,8 @@ balancemode = hledgerCommandMode ,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total" ,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign" ,flagNone ["transpose"] (setboolopt "transpose") "transpose rows and columns" + ,flagNone ["commodity-column"] (setboolopt "commodity-column") + "shows each commodity in its own automatically-generated subaccount, for tidier reports" ,outputFormatFlag ["txt","html","csv","json"] ,outputFileFlag ] @@ -385,31 +391,65 @@ balance opts@CliOpts{reportspec_=rspec} j = case balancecalc_ of -- | Render a single-column balance report as CSV. balanceReportAsCsv :: ReportOpts -> BalanceReport -> CSV balanceReportAsCsv opts (items, total) = - ["account","balance"] : - [[accountNameDrop (drop_ opts) a, wbToText $ showMixedAmountB (balanceOpts False opts) b] | (a, _, _, b) <- items] - ++ - if no_total_ opts - then [] - else [["total", wbToText $ showMixedAmountB (balanceOpts False opts) total]] + ("account" : ((if commodity_column_ opts then (:) "commodity" else id) $ "balance" : [])) + : (concatMap (\(a, _, _, b) -> rows a b) items) + ++ if no_total_ opts then [] else rows "total" total + where + rows :: AccountName -> MixedAmount -> [[T.Text]] + rows name ma + | commodity_column_ opts = + fmap (\(k, a) -> [showName name, k, renderAmount . mixedAmount . amountStripPrices $ a]) + . M.toList . foldl' sumAmounts mempty . amounts $ ma + | otherwise = [[showName name, renderAmount ma]] + + showName = accountNameDrop (drop_ opts) + renderAmount amt = wbToText $ showMixedAmountB bopts amt + where bopts = (balanceOpts False opts){displayOrder = order} + order = if commodity_column_ opts then Just (commodities [amt]) else Nothing + sumAmounts mp am = M.insertWith (+) (acommodity am) am mp -- | Render a single-column balance report as plain text. balanceReportAsText :: ReportOpts -> BalanceReport -> TB.Builder -balanceReportAsText opts ((items, total)) = - unlinesB lines - <> unlinesB (if no_total_ opts then [] else [overline, totalLines]) +balanceReportAsText opts ((items, total)) + | not (commodity_column_ opts) = + unlinesB lines + <> unlinesB (if no_total_ opts then [] else [overline, totalLines]) + | iscustom = error' "Custom format not supported with --commodity-column" -- PARTIAL: + | otherwise = balanceReportAsText' opts ((items, total)) where (lines, sizes) = unzip $ map (balanceReportItemAsText opts) items -- abuse renderBalanceReportItem to render the total with similar format (totalLines, _) = renderBalanceReportItem opts ("",0,total) -- with a custom format, extend the line to the full report width; -- otherwise show the usual 20-char line for compatibility - overlinewidth = case format_ opts of - OneLine ((FormatField _ _ _ TotalField):_) -> 20 - TopAligned ((FormatField _ _ _ TotalField):_) -> 20 - BottomAligned ((FormatField _ _ _ TotalField):_) -> 20 - _ -> sum (map maximum' $ transpose sizes) + iscustom = case format_ opts of + OneLine ((FormatField _ _ _ TotalField):_) -> False + TopAligned ((FormatField _ _ _ TotalField):_) -> False + BottomAligned ((FormatField _ _ _ TotalField):_) -> False + _ -> True + overlinewidth = if iscustom then sum (map maximum' $ transpose sizes) else 20 overline = TB.fromText $ T.replicate overlinewidth "-" +-- | Render a single-column balance report as plain text in commodity-column mode +balanceReportAsText' :: ReportOpts -> BalanceReport -> TB.Builder +balanceReportAsText' opts ((items, total)) = + unlinesB . fmap (renderColumns def{tableBorders=False} sizes . Tab.Group NoLine . fmap Header) $ + lines ++ concat [[[overline], totalline] | not (no_total_ opts)] + where + render (_, acctname, depth, amt) = + [ Cell TopRight damts + , Cell TopLeft (fmap wbFromText cs) + , Cell TopLeft (replicate (length damts - 1) mempty ++ [wbFromText dispname]) ] + where dopts = (balanceOpts True opts){displayOrder=Just cs} + cs = commodities [amt] + dispname = T.replicate ((depth - 1) * 2) " " <> acctname + damts = showMixedAmountLinesB dopts amt + lines = fmap render items + totalline = render ("", "", 0, total) + sizes = fmap (fromMaybe 0 . maximumMay . map cellWidth) $ + transpose ([totalline | not (no_total_ opts)] ++ lines) + overline = Cell TopLeft . pure . wbFromText . flip T.replicate "-" . fromMaybe 0 $ headMay sizes + {- :r This implementation turned out to be a bit convoluted but implements the following algorithm for formatting: @@ -468,56 +508,64 @@ renderComponent topaligned opts (acctname, depth, total) (FormatField ljust mmin -- The CSV will always include the initial headings row, -- and will include the final totals row unless --no-total is set. multiBalanceReportAsCsv :: ReportOpts -> MultiBalanceReport -> CSV -multiBalanceReportAsCsv opts@ReportOpts{average_, row_total_} - (PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) = - maybetranspose $ - ("account" : map showDateSpan colspans +multiBalanceReportAsCsv opts@ReportOpts{..} = + (if transpose_ then transpose else id) . uncurry (++) . multiBalanceReportAsCsv' opts + +multiBalanceReportAsCsv' :: ReportOpts -> MultiBalanceReport -> (CSV, CSV) +multiBalanceReportAsCsv' opts@ReportOpts{..} + (PeriodicReport colspans items tr) = + flip (,) totalrows $ + ("account" : ["commodity" | commodity_column_] ++ map showDateSpan colspans ++ ["total" | row_total_] ++ ["average" | average_] ) : - [accountNameDrop (drop_ opts) (displayFull a) : - map (wbToText . showMixedAmountB (balanceOpts False opts)) - (amts - ++ [rowtot | row_total_] - ++ [rowavg | average_]) - | PeriodicReportRow a amts rowtot rowavg <- items] - ++ - if no_total_ opts - then [] - else ["total" : - map (wbToText . showMixedAmountB (balanceOpts False opts)) ( - coltotals - ++ [tot | row_total_] - ++ [avg | average_] - )] + concatMap (rowAsTexts (accountNameDrop drop_ . prrFullName)) items where - maybetranspose | transpose_ opts = transpose - | otherwise = id + rowAsTexts render row@(PeriodicReportRow _ as rowtot rowavg) + | not commodity_column_ = [render row : fmap (wbToText . showMixedAmountB bopts) all] + | otherwise = + joinNames . zipWith (:) cs -- add symbols and names + . transpose -- each row becomes a list of Text quantities + . fmap (fmap wbToText . showMixedAmountLinesB bopts{displayOrder=Just cs, displayMinWidth=Nothing}) + $ all + where + bopts = balanceOpts False opts + cs = commodities $ rowtot : rowavg : as + all = as + ++ [rowtot | row_total_] + ++ [rowavg | average_] + + joinNames = fmap ((:) (render row)) + + totalrows :: [[T.Text]] + totalrows + | no_total_ = mempty + | otherwise = rowAsTexts (const "total") tr -- | Render a multi-column balance report as HTML. multiBalanceReportAsHtml :: ReportOpts -> MultiBalanceReport -> Html () multiBalanceReportAsHtml ropts mbr = let - (headingsrow,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr + (headingsrow,bodyrows,mtotalsrows) = multiBalanceReportHtmlRows ropts mbr in table_ $ mconcat $ [headingsrow] ++ bodyrows - ++ maybeToList mtotalsrow + ++ mtotalsrows -- | Render the HTML table rows for a MultiBalanceReport. -- Returns the heading row, 0 or more body rows, and the totals row if enabled. -multiBalanceReportHtmlRows :: ReportOpts -> MultiBalanceReport -> (Html (), [Html ()], Maybe (Html ())) +multiBalanceReportHtmlRows :: ReportOpts -> MultiBalanceReport -> (Html (), [Html ()], [Html ()]) multiBalanceReportHtmlRows ropts mbr = let - headingsrow:rest | transpose_ ropts = error' "Sorry, --transpose with HTML output is not yet supported" -- PARTIAL: - | otherwise = multiBalanceReportAsCsv ropts mbr - (bodyrows, mtotalsrow) | no_total_ ropts = (rest, Nothing) - | otherwise = (init rest, Just $ last rest) + -- TODO: should the commodity_column be displayed as a subaccount in this case as well? + (headingsrow:bodyrows, mtotalsrows) + | transpose_ ropts = error' "Sorry, --transpose with HTML output is not yet supported" -- PARTIAL: + | otherwise = multiBalanceReportAsCsv' ropts mbr in (multiBalanceReportHtmlHeadRow ropts headingsrow ,map (multiBalanceReportHtmlBodyRow ropts) bodyrows - ,multiBalanceReportHtmlFootRow ropts <$> mtotalsrow -- TODO pad totals row with zeros when there are + ,multiBalanceReportHtmlFootRow ropts <$> mtotalsrows -- TODO pad totals row with zeros when there are ) -- | Render one MultiBalanceReport heading row as a HTML table row. @@ -627,7 +675,8 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} (map rowvals items) where totalscolumn = row_total_ && balanceaccum_ `notElem` [Cumulative, Historical] - colheadings = map (reportPeriodName balanceaccum_ spans) spans + colheadings = ["Commodity" | commodity_column_ opts] + ++ map (reportPeriodName balanceaccum_ spans) spans ++ [" Total" | totalscolumn] ++ ["Average" | average_] accts = map renderacct items @@ -651,9 +700,28 @@ balanceReportAsTable opts@ReportOpts{average_, row_total_, balanceaccum_} -- unless --no-elide is used. balanceReportTableAsText :: ReportOpts -> Table T.Text T.Text MixedAmount -> TB.Builder balanceReportTableAsText ropts@ReportOpts{..} = - Tab.renderTableB def{tableBorders=False, prettyTable=pretty_tables_} - (Tab.textCell TopLeft) (Tab.textCell TopRight) $ - Cell TopRight . pure . showMixedAmountB (balanceOpts True ropts) + Tab.renderTableByRowsB def{tableBorders=False, prettyTable=pretty_tables_} renderCh renderRow + where + renderCh + | not commodity_column_ = fmap (Tab.textCell TopRight) + | otherwise = zipWith ($) (Tab.textCell TopLeft : repeat (Tab.textCell TopRight)) + + renderRow :: (T.Text, [MixedAmount]) -> (Cell, [Cell]) + renderRow (rh, row) + | not commodity_column_ = + (Tab.textCell TopLeft rh, fmap (Cell TopRight . pure . showMixedAmountB bopts) row) + | otherwise = + ( Tab.textsCell TopLeft (replicate (length cs) rh) + , Tab.textsCell TopLeft cs + : fmap (Cell TopRight . showMixedAmountLinesB bopts{displayOrder = Just cs}) row) + where + bopts = balanceOpts True ropts + cs = commodities row + +commodities :: [MixedAmount] -> [CommoditySymbol] +commodities = filter (not . T.null) . S.toList + . foldl' S.union mempty + . fmap (S.fromList . fmap acommodity . amounts) -- | Amount display options to use for balance reports balanceOpts :: Bool -> ReportOpts -> AmountDisplayOpts diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs index 5746f10b7..d69fae624 100644 --- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs +++ b/hledger/Hledger/Cli/CompoundBalanceCommand.hs @@ -297,11 +297,11 @@ compoundBalanceReportAsHtml ropts cbr = subreportrows :: (T.Text, MultiBalanceReport, Bool) -> [Html ()] subreportrows (subreporttitle, mbr, _increasestotal) = let - (_,bodyrows,mtotalsrow) = multiBalanceReportHtmlRows ropts mbr + (_,bodyrows,mtotalsrows) = multiBalanceReportHtmlRows ropts mbr in [tr_ $ th_ [colspanattr, leftattr] $ toHtml subreporttitle] ++ bodyrows - ++ maybe [] (:[]) mtotalsrow + ++ mtotalsrows ++ [blankrow] totalrows | no_total_ ropts || length subreports == 1 = []