diff --git a/hledger-lib/Hledger/Write/Html/Blaze.hs b/hledger-lib/Hledger/Write/Html/Blaze.hs
index 4a99f5f5e..79c5e1b6f 100644
--- a/hledger-lib/Hledger/Write/Html/Blaze.hs
+++ b/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)
- (style++align++valign++class_)
+ in span_ (Html.td $ withEmph content) $
+ style++align++valign++class_
diff --git a/hledger-lib/Hledger/Write/Html/Lucid.hs b/hledger-lib/Hledger/Write/Html/Lucid.hs
index d4bdea8ac..1e1215b0f 100644
--- a/hledger-lib/Hledger/Write/Html/Lucid.hs
+++ b/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
diff --git a/hledger-lib/Hledger/Write/Ods.hs b/hledger-lib/Hledger/Write/Ods.hs
index 7d299b222..0e75f55b3 100644
--- a/hledger-lib/Hledger/Write/Ods.hs
+++ b/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 = " "
+ alignTop =
+ " "
+ alignParagraph =
+ printf " "
+ moreStyles =
borderStyle border
++
(
case cstyle of
- Body Item -> []
+ Body Item ->
+ alignTop :
+ []
Body Total ->
- [" "]
+ alignTop :
+ boldStyle :
+ []
Head ->
- " " :
- " " :
+ alignParagraph "center" :
+ boldStyle :
[]
)
++
(
case dataStyle of
- DataMixedAmount ->
- [" "]
+ DataMixedAmount -> [alignParagraph "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 "" style valueType :
+ printf "" covered style span_ valueType :
printf "%s"
(anchor $ escape $ T.unpack $ cellContent cell) :
- "" :
+ printf "" covered :
[]
escape :: String -> String
diff --git a/hledger-lib/Hledger/Write/Spreadsheet.hs b/hledger-lib/Hledger/Write/Spreadsheet.hs
index 538fc1994..9a66fa06b 100644
--- a/hledger-lib/Hledger/Write/Spreadsheet.hs
+++ b/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) =
- Cell typ border style anchor class_ $ f content
+ fmap f (Cell typ border style span anchor class_ 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)
diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs
index 6ce211879..dea47eee4 100644
--- a/hledger/Hledger/Cli/Commands/Balance.hs
+++ b/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.
-totalRowHeadingText = ""
-totalRowHeadingBudgetText = ""
-totalRowHeadingHtml = "Total:"
-totalRowHeadingCsv = "Total:"
-totalRowHeadingBudgetCsv = "Total:"
+-- Currently nothing in terminal, Total: in HTML, FODS and xSV output.
+totalRowHeadingText = ""
+totalRowHeadingSpreadsheet = "Total:"
+totalRowHeadingBudgetText = ""
+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 ->
- [accountCell,
- cell $ acommodity a,
- renderAmount rc $ mixedAmount a])
+ map (\a -> [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
- | no_total_ = []
- | ishtml = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $
- rowAsText Total simpleDateSpanCell tr
- | otherwise = map (accountCell totalRowHeadingCsv :) $
- rowAsText Total simpleDateSpanCell tr
+ totalrows =
+ if no_total_
+ then []
+ else addRowSpanHeader (accountCell totalRowHeadingSpreadsheet) $
+ rowAsText Total simpleDateSpanCell tr
rowAsText rc dsCell =
let fmt = if ishtml then oneLineNoCostFmt else machineFmt
in map (map (fmap wbToText)) .
diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs
index 5f42f87a0..2a5a59ac3 100644
--- a/hledger/Hledger/Cli/CompoundBalanceCommand.hs
+++ b/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))