mirror of
https://github.com/simonmichael/hledger.git
synced 2024-12-28 12:54:07 +03:00
cli: Commands.Balance.multiBalanceReportAsSpreadsheetHelper: vertically merge cells showing account names and Total
lib: Write.Spreadsheet: add support for cell spans
This commit is contained in:
Henning Thielemann
Simon Michael
parent
d12ec3b015
commit
5565f11c73
@ -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_
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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'/>" :
|
||||
" <style:text-properties fo:font-weight='bold'/>" :
|
||||
alignParagraph "center" :
|
||||
boldStyle :
|
||||
[]
|
||||
)
|
||||
++
|
||||
(
|
||||
case dataStyle of
|
||||
DataMixedAmount ->
|
||||
[" <style:paragraph-properties fo:text-align='end'/>"]
|
||||
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 "<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
|
||||
|
||||
@ -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)
|
||||
|
||||
@ -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)) .
|
||||
|
||||
@ -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))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user