cli: Commands.Balance.multiBalanceReportAsSpreadsheetHelper: vertically merge cells showing account names and Total

lib: Write.Spreadsheet: add support for cell spans

hledger-lib/Hledger/Write/Html/Blaze.hs

@@ -46,18 +46,33 @@ formatCell cell =
     let class_ =
             map (HtmlAttr.class_ . Html.textValue) $
             filter (not . Text.null) [Spr.textFromClass $ cellClass cell] in
+    let span_ makeCell attrs =
+            case Spr.cellSpan cell of
+                Spr.NoSpan -> foldl (!) makeCell attrs
+                Spr.Covered -> pure ()
+                Spr.SpanHorizontal n ->
+                    foldl (!) makeCell
+                        (HtmlAttr.colspan (Html.stringValue $ show n) : attrs)
+                Spr.SpanVertical n ->
+                    foldl (!) makeCell
+                        (HtmlAttr.rowspan (Html.stringValue $ show n) : attrs)
+            in
     case cellStyle cell of
-        Head -> foldl (!) (Html.th content) (style++class_)
+        Head -> span_ (Html.th content) (style++class_)
         Body emph ->
             let align =
                     case cellType cell of
                         TypeString -> []
                         TypeDate -> []
                         _ -> [HtmlAttr.align "right"]
-                valign = [HtmlAttr.valign "top"]
+                valign =
+                    case Spr.cellSpan cell of
+                        Spr.SpanVertical n ->
+                            if n>1 then [HtmlAttr.valign "top"] else []
+                        _ -> []
                 withEmph =
                     case emph of
                         Item -> id
                         Total -> Html.b
-            in  foldl (!) (Html.td $ withEmph content)
+            in  span_ (Html.td $ withEmph content) $
-                    (style++align++valign++class_)
+                style++align++valign++class_

hledger-lib/Hledger/Write/Html/Lucid.hs

@@ -45,16 +45,33 @@ formatCell cell =
     let class_ =
             map Html.class_ $
             filter (not . Text.null) [Spr.textFromClass $ cellClass cell] in
+    let span_ makeCell attrs cont =
+            case Spr.cellSpan cell of
+                Spr.NoSpan -> makeCell attrs cont
+                Spr.Covered -> pure ()
+                Spr.SpanHorizontal n ->
+                    makeCell (Html.colspan_ (Text.pack $ show n) : attrs) cont
+                Spr.SpanVertical n ->
+                    makeCell (Html.rowspan_ (Text.pack $ show n) : attrs) cont
+            in
     case cellStyle cell of
-        Head -> Html.th_ (style++class_) content
+        Head -> span_ Html.th_ (style++class_) content
         Body emph ->
             let align =
                     case cellType cell of
                         TypeString -> []
                         TypeDate -> []
                         _ -> [HtmlBase.makeAttribute "align" "right"]
+                valign =
+                    case Spr.cellSpan cell of
+                        Spr.SpanVertical n ->
+                            if n>1
+                                then [HtmlBase.makeAttribute "valign" "top"]
+                                else []
+                        _ -> []
                 withEmph =
                     case emph of
                         Item -> id
                         Total -> Html.b_
-            in  Html.td_ (style++align++class_) $ withEmph content
+            in  span_ Html.td_ (style++align++valign++class_) $
+                withEmph content

hledger-lib/Hledger/Write/Ods.hs

@@ -239,24 +239,32 @@ data DataStyle =
 
 cellConfig :: ((Spr.Border Spr.NumLines, Style), DataStyle) -> [String]
 cellConfig ((border, cstyle), dataStyle) =
-    let moreStyles =
+    let boldStyle = "    <style:text-properties fo:font-weight='bold'/>"
+        alignTop =
+            "    <style:table-cell-properties style:vertical-align='top'/>"
+        alignParagraph =
+            printf "    <style:paragraph-properties fo:text-align='%s'/>"
+        moreStyles =
             borderStyle border
             ++
             (
             case cstyle of
-                Body Item -> []
+                Body Item ->
+                    alignTop :
+                    []
                 Body Total ->
-                    ["    <style:text-properties fo:font-weight='bold'/>"]
+                    alignTop :
+                    boldStyle :
+                    []
                 Head ->
-                    "    <style:paragraph-properties fo:text-align='center'/>" :
+                    alignParagraph "center" :
-                    "    <style:text-properties fo:font-weight='bold'/>" :
+                    boldStyle :
                     []
             )
             ++
             (
             case dataStyle of
-                DataMixedAmount ->
+                DataMixedAmount -> [alignParagraph "end"]
-                    ["    <style:paragraph-properties fo:text-align='end'/>"]
                 _ -> []
             )
         cstyleName = cellStyleName cstyle
@@ -314,6 +322,19 @@ formatCell cell =
                         (cellContent cell)
                 _ -> "office:value-type='string'"
 
+        covered =
+            case cellSpan cell of
+                Spr.Covered -> "covered-"
+                _ -> ""
+
+        span_ =
+            case cellSpan cell of
+                Spr.SpanHorizontal n | n>1 ->
+                    printf " table:number-columns-spanned='%d'" n
+                Spr.SpanVertical n | n>1 ->
+                    printf " table:number-rows-spanned='%d'" n
+                _ -> ""
+
         anchor text =
             if T.null $ Spr.cellAnchor cell
                 then text
@@ -321,10 +342,10 @@ formatCell cell =
                         (escape $ T.unpack $ Spr.cellAnchor cell) text
 
     in
-    printf "<table:table-cell%s %s>" style valueType :
+    printf "<table:%stable-cell%s%s %s>" covered style span_ valueType :
     printf "<text:p>%s</text:p>"
         (anchor $ escape $ T.unpack $ cellContent cell) :
-    "</table:table-cell>" :
+    printf "</table:%stable-cell>" covered :
     []
 
 escape :: String -> String

hledger-lib/Hledger/Write/Spreadsheet.hs

@@ -8,6 +8,7 @@ module Hledger.Write.Spreadsheet (
     Emphasis(..),
     Cell(..),
     Class(Class), textFromClass,
+    Span(..),
     Border(..),
     Lines(..),
     NumLines(..),
@@ -23,6 +24,8 @@ import Hledger.Data.Types (Amount)
 import qualified Data.List as List
 import Data.Text (Text)
 
+import Prelude hiding (span)
+
 
 data Type =
       TypeString
@@ -82,19 +85,59 @@ newtype Class = Class Text
 textFromClass :: Class -> Text
 textFromClass (Class cls) = cls
 
+
+{- |
+* 'NoSpan' means a single unmerged cell.
+
+* 'Covered' is a cell if it is part of a horizontally or vertically merged cell.
+  We maintain these cells although they are ignored in HTML output.
+  In contrast to that, FODS can store covered cells
+  and allows to access the hidden cell content via formulas.
+  CSV does not support merged cells
+  and thus simply writes the content of covered cells.
+  Maintaining 'Covered' cells also simplifies transposing.
+
+* @'SpanHorizontal' n@ denotes the first cell in a row
+  that is part of a merged cell.
+  The merged cell contains @n@ atomic cells, including the first one.
+  That is @SpanHorizontal 1@ is actually like @NoSpan@.
+  The content of this cell is shown as content of the merged cell.
+
+* @'SpanVertical' n@ starts a vertically merged cell.
+
+The writer functions expect consistent data,
+that is, 'Covered' cells must actually be part of a merged cell
+and merged cells must only cover 'Covered' cells.
+-}
+data Span =
+      NoSpan
+    | Covered
+    | SpanHorizontal Int
+    | SpanVertical Int
+    deriving (Eq)
+
+transposeSpan :: Span -> Span
+transposeSpan span =
+    case span of
+        NoSpan -> NoSpan
+        Covered -> Covered
+        SpanHorizontal n -> SpanVertical n
+        SpanVertical n -> SpanHorizontal n
+
 data Cell border text =
     Cell {
         cellType :: Type,
         cellBorder :: Border border,
         cellStyle :: Style,
+        cellSpan :: Span,
         cellAnchor :: Text,
         cellClass :: Class,
         cellContent :: text
     }
 
 instance Functor (Cell border) where
-    fmap f (Cell typ border style anchor class_ content) =
+    fmap f (Cell typ border style span anchor class_ content) =
-        Cell typ border style anchor class_ $ f content
+        Cell typ border style span anchor class_ $ f content
 
 defaultCell :: (Lines border) => text -> Cell border text
 defaultCell text =
@@ -102,6 +145,7 @@ defaultCell text =
         cellType = TypeString,
         cellBorder = noBorder,
         cellStyle = Body Item,
+        cellSpan = NoSpan,
         cellAnchor = mempty,
         cellClass = Class mempty,
         cellContent = text
@@ -112,7 +156,10 @@ emptyCell = defaultCell mempty
 
 transposeCell :: Cell border text -> Cell border text
 transposeCell cell =
-    cell {cellBorder = transposeBorder $ cellBorder cell}
+    cell {
+        cellBorder = transposeBorder $ cellBorder cell,
+        cellSpan = transposeSpan $ cellSpan cell
+    }
 
 transpose :: [[Cell border text]] -> [[Cell border text]]
 transpose = List.transpose . map (map transposeCell)

hledger/Hledger/Cli/Commands/Balance.hs

@@ -260,6 +260,7 @@ module Hledger.Cli.Commands.Balance (
  ,multiBalanceReportTableAsText
  ,multiBalanceReportAsSpreadsheet
  ,addTotalBorders
+ ,addRowSpanHeader
  ,simpleDateSpanCell
  ,RowClass(..)
   -- ** Tests
@@ -458,12 +459,11 @@ budgetAverageClass rc =
     case rc of Value -> "budget rowaverage"; Total -> "budget colaverage"
 
 -- What to show as heading for the totals row in balance reports ?
--- Currently nothing in terminal, Total: in html and xSV output.
+-- Currently nothing in terminal, Total: in HTML, FODS and xSV output.
-totalRowHeadingText       = ""
+totalRowHeadingText        = ""
-totalRowHeadingBudgetText = ""
+totalRowHeadingSpreadsheet = "Total:"
-totalRowHeadingHtml       = "Total:"
+totalRowHeadingBudgetText  = ""
-totalRowHeadingCsv        = "Total:"
+totalRowHeadingBudgetCsv   = "Total:"
-totalRowHeadingBudgetCsv  = "Total:"
 
 -- Single-column balance reports
 
@@ -663,6 +663,19 @@ addTotalBorders =
 rawTableContent :: [[Ods.Cell border text]] -> [[text]]
 rawTableContent = map (map Ods.cellContent)
 
+addRowSpanHeader ::
+    Ods.Cell border text ->
+    [[Ods.Cell border text]] -> [[Ods.Cell border text]]
+addRowSpanHeader header rows =
+    case rows of
+        [] -> []
+        [row] -> [header:row]
+        _ ->
+            zipWith (:)
+                (header{Ods.cellSpan = Ods.SpanVertical (length rows)} :
+                 repeat header{Ods.cellSpan = Ods.Covered})
+                rows
+
 setAccountAnchor ::
     Maybe Text -> [Text] -> Text -> Ods.Cell border text -> Ods.Cell border text
 setAccountAnchor base query acct cell =
@@ -677,7 +690,7 @@ balanceReportAsSpreadsheet opts (items, total) =
     headers :
     concatMap (\(a, _, _, b) -> rows Value a b) items ++
     if no_total_ opts then []
-      else addTotalBorders $ rows Total totalRowHeadingCsv total
+      else addTotalBorders $ rows Total totalRowHeadingSpreadsheet total
   where
     cell = Ods.defaultCell
     headers =
@@ -694,14 +707,12 @@ balanceReportAsSpreadsheet opts (items, total) =
                   (guard (rc==Value) >> balance_base_url_ opts)
                   (querystring_ opts) name $
               cell $ accountNameDrop (drop_ opts) name in
+      addRowSpanHeader accountCell $
       case layout_ opts of
       LayoutBare ->
-          map (\a ->
+          map (\a -> [cell $ acommodity a, renderAmount rc $ mixedAmount a])
-                [accountCell,
-                 cell $ acommodity a,
-                 renderAmount rc $ mixedAmount a])
           . amounts $ mixedAmountStripCosts ma
-      _ -> [[accountCell, renderAmount rc ma]]
+      _ -> [[renderAmount rc ma]]
 
     renderAmount rc mixedAmt =
         wbToText <$> cellFromMixedAmount bopts (amountClass rc, mixedAmt)
@@ -787,18 +798,17 @@ multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport
       [hCell "rowtotal" "total" | row_total_] ++
       [hCell "rowaverage" "average" | average_]
     fullRowAsTexts row =
-        map (anchorCell:) $
+        addRowSpanHeader anchorCell $
         rowAsText Value (dateSpanCell balance_base_url_ querystring_ acctName) row
       where acctName = prrFullName row
             anchorCell =
               setAccountAnchor balance_base_url_ querystring_ acctName $
               accountCell $ accountNameDrop drop_ acctName
-    totalrows
+    totalrows =
-      | no_total_ = []
+      if no_total_
-      | ishtml    = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $
+        then []
-                    rowAsText Total simpleDateSpanCell tr
+        else addRowSpanHeader (accountCell totalRowHeadingSpreadsheet) $
-      | otherwise = map (accountCell totalRowHeadingCsv :) $
+                rowAsText Total simpleDateSpanCell tr
-                    rowAsText Total simpleDateSpanCell tr
     rowAsText rc dsCell =
         let fmt = if ishtml then oneLineNoCostFmt else machineFmt
         in  map (map (fmap wbToText)) .

hledger/Hledger/Cli/CompoundBalanceCommand.hs

@@ -376,7 +376,7 @@ compoundBalanceReportAsHtml ropts cbr =
             Total simpleDateSpanCell totalrow
                              -- make a table of rendered lines of the report totals row
         & map (map (fmap wbToText))
-        & zipWith (:) (Spr.defaultCell "Net:" : repeat Spr.emptyCell)
+        & addRowSpanHeader (Spr.defaultCell "Net:")
                              -- insert a headings column, with Net: on the first line only
         & addTotalBorders    -- marking the first for special styling
         & map (Html.formatRow . map (fmap L.toHtml))