bal: option to view one commodity per row

This adds the `--commodity-column` option that displays each commodity
on a separate line and the commodities themselves as a separate column.
The initial design considerations are at
simonmichael.hledger.issues.1559

The single-period balance report with `--commodity-column` does not
interoperate with custom formats.

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
+      L -> showC c' space <> quantity' <> price
-      R -> quantity' <> space <> c' <> 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 }
+    pad amt
-      where w = width - wbWidth (adBuilder 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,

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])
+    , "%(date)"                    `gives` (defaultStringFormatStyle [FormatField False (Just 0) Nothing DescriptionField])
-    , "%(total)"                   `gives` (defaultStringFormatStyle [FormatField False Nothing Nothing TotalField])
+    , "%(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 "!"])
+    , "Hello %(date)!"             `gives` (defaultStringFormatStyle [FormatLiteral "Hello ", FormatField False (Just 0) Nothing DescriptionField, FormatLiteral "!"])
-    , "%-(date)"                   `gives` (defaultStringFormatStyle [FormatField True Nothing Nothing DescriptionField])
+    , "%-(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"
     ]

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

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

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
+  rows         = unzip . fmap f $ zip (headerContents rh) cells
-  colHeaders   = fmap fc ch
+  rowHeaders   = fmap fst $ zipHeader emptyCell (fst rows) rh
-  cellContents = map (map f) cells
+  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

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

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.List (intersperse, transpose, foldl', transpose)
-import Data.Maybe (fromMaybe, maybeToList)
+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"] :
+  ("account" : ((if commodity_column_ opts then (:) "commodity" else id) $ "balance" : []))
-  [[accountNameDrop (drop_ opts) a, wbToText $ showMixedAmountB (balanceOpts False opts) b] | (a, _, _, b) <- items]
+  :  (concatMap (\(a, _, _, b) -> rows a b) items)
-  ++
+  ++ if no_total_ opts then [] else rows "total" total
-  if no_total_ opts
+  where
-  then []
+    rows :: AccountName -> MixedAmount -> [[T.Text]]
-  else [["total", wbToText $ showMixedAmountB (balanceOpts False opts) total]]
+    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)) =
+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
+    iscustom = case format_ opts of
-        OneLine       ((FormatField _ _ _ TotalField):_) -> 20
+        OneLine       ((FormatField _ _ _ TotalField):_) -> False
-        TopAligned    ((FormatField _ _ _ TotalField):_) -> 20
+        TopAligned    ((FormatField _ _ _ TotalField):_) -> False
-        BottomAligned ((FormatField _ _ _ TotalField):_) -> 20
+        BottomAligned ((FormatField _ _ _ TotalField):_) -> False
-        _ -> sum (map maximum' $ transpose sizes)
+        _ -> 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_}
+multiBalanceReportAsCsv opts@ReportOpts{..} =
-    (PeriodicReport colspans items (PeriodicReportRow _ coltotals tot avg)) =
+  (if transpose_ then transpose else id) . uncurry (++) . multiBalanceReportAsCsv' opts
-  maybetranspose $
+
-  ("account" : map showDateSpan colspans
+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) :
+  concatMap (rowAsTexts (accountNameDrop drop_ . prrFullName)) items
-   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_]
-          )]
   where
-    maybetranspose | transpose_ opts = transpose
+    rowAsTexts render row@(PeriodicReportRow _ as rowtot rowavg)
-                   | otherwise = id
+      | 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:
+    -- TODO: should the commodity_column be displayed as a subaccount in this case as well?
-                     | otherwise = multiBalanceReportAsCsv ropts mbr
+    (headingsrow:bodyrows, mtotalsrows)
-    (bodyrows, mtotalsrow) | no_total_ ropts = (rest,      Nothing)
+      | transpose_ ropts = error' "Sorry, --transpose with HTML output is not yet supported"  -- PARTIAL:
-                           | otherwise       = (init rest, Just $ last rest)
+      | 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.renderTableByRowsB def{tableBorders=False, prettyTable=pretty_tables_} renderCh renderRow
-        (Tab.textCell TopLeft) (Tab.textCell TopRight) $
+  where
-        Cell TopRight . pure . showMixedAmountB (balanceOpts True ropts)
+    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

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 = []