cli: Commands.Balance.multiBalanceReportAsSpreadsheet: add date query…

… anchors to period headers
simonmichael · Sep 12, 2024 · be469c8 · be469c8
1 parent f6075b7
commit be469c8
Show file tree

Hide file tree

Showing 2 changed files with 53 additions and 18 deletions.
diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs
@@ -261,6 +261,7 @@ module Hledger.Cli.Commands.Balance (
  ,multiBalanceReportTableAsText
  ,multiBalanceReportAsSpreadsheet
  ,addTotalBorders
+ ,simpleDateSpanCell
  ,RowClass(..)
   -- ** HTML output helpers
  ,stylesheet_
@@ -600,6 +601,30 @@ headerCell text =
             (Ods.cellBorder deflt) {Ods.borderBottom = Ods.DoubleLine}
     }
 
+headerDateSpanCell :: Maybe Text -> DateSpan -> Ods.Cell Ods.NumLines Text
+headerDateSpanCell base spn =
+    let prd = showDateSpan spn in
+    (headerCell prd) {
+        Ods.cellAnchor =
+            maybe mempty (\url -> url <> "register?q=date:" <> prd) base
+    }
+
+simpleDateSpanCell :: DateSpan -> Ods.Cell Ods.NumLines Text
+simpleDateSpanCell = Ods.defaultCell . showDateSpan
+
+dateSpanCell ::
+    (Ods.Lines border) => Maybe Text -> Text -> DateSpan -> Ods.Cell border Text
+dateSpanCell base acct spn =
+    let prd = showDateSpan spn in
+    (Ods.defaultCell prd) {
+        Ods.cellAnchor =
+            maybe mempty
+                (\url -> url <>
+                    "register?q=inacct:" <> quoteIfSpaced acct <>
+                    " date:" <> prd)
+                base
+    }
+
 addTotalBorders :: [[Ods.Cell border text]] -> [[Ods.Cell Ods.NumLines text]]
 addTotalBorders =
     zipWith
@@ -734,21 +759,25 @@ multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport
       LayoutBare -> headerCell "commodity" : dateHeaders
       _          -> dateHeaders
     dateHeaders =
-      map (headerCell . showDateSpan) colspans ++
+      map (headerDateSpanCell anchor_) colspans ++
       [hCell "rowtotal" "total" | row_total_] ++
       [hCell "rowaverage" "average" | average_]
-    fullRowAsTexts row = map (anchorCell:) $ rowAsText Value row
-      where anchorCell =
-              let name = prrFullName row in
-              setAccountAnchor anchor_ name $
-              accountCell $ accountNameDrop drop_ name
+    fullRowAsTexts row =
+        map (anchorCell:) $ rowAsText Value (dateSpanCell anchor_ acctName) row
+      where acctName = prrFullName row
+            anchorCell =
+              setAccountAnchor anchor_ acctName $
+              accountCell $ accountNameDrop drop_ acctName
     totalrows
       | no_total_ = []
-      | ishtml    = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText Total tr
-      | otherwise = map (accountCell totalRowHeadingCsv :) $ rowAsText Total tr
-    rowAsText rc =
+      | ishtml    = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $
+                    rowAsText Total simpleDateSpanCell tr
+      | otherwise = map (accountCell totalRowHeadingCsv :) $
+                    rowAsText Total simpleDateSpanCell tr
+    rowAsText rc dsCell =
         let fmt = if ishtml then oneLineNoCostFmt else machineFmt
-        in  map (map (fmap wbToText)) . multiBalanceRowAsCellBuilders fmt opts colspans rc
+        in  map (map (fmap wbToText)) .
+            multiBalanceRowAsCellBuilders fmt opts colspans rc dsCell
 
 -- Helpers and CSS styles for HTML output.
 
@@ -901,10 +930,11 @@ multiBalanceReportAsTable opts@ReportOpts{summary_only_, average_, row_total_, b
 
 multiBalanceRowAsCellBuilders ::
     AmountFormat -> ReportOpts -> [DateSpan] ->
-    RowClass -> PeriodicReportRow a MixedAmount ->
+    RowClass -> (DateSpan -> Ods.Cell Ods.NumLines Text) ->
+    PeriodicReportRow a MixedAmount ->
     [[Ods.Cell Ods.NumLines WideBuilder]]
 multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans
-      rc (PeriodicReportRow _ as rowtot rowavg) =
+      rc renderDateSpanCell (PeriodicReportRow _acct as rowtot rowavg) =
     case layout_ of
       LayoutWide width -> [fmap (cellFromMixedAmount bopts{displayMaxWidth=width}) clsamts]
       LayoutTall       -> paddedTranspose Ods.emptyCell
@@ -931,9 +961,11 @@ multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans
     clsamts = (if not summary_only_ then classified else []) ++
                 [(rowTotalClass rc, rowtot) | totalscolumn && not (null as)] ++
                 [(rowAverageClass rc, rowavg) | average_ && not (null as)]
-    addDateColumns spn@(DateSpan s e) = (wbCell (showDateSpan spn) :)
-                                       . (wbDate (maybe "" showEFDate s) :)
-                                       . (wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :)
+    addDateColumns spn@(DateSpan s e) remCols =
+        (wbFromText <$> renderDateSpanCell spn) :
+        wbDate (maybe "" showEFDate s) :
+        wbDate (maybe "" (showEFDate . modifyEFDay (addDays (-1))) e) :
+        remCols
 
     paddedTranspose :: a -> [[a]] -> [[a]]
     paddedTranspose _ [] = [[]]
@@ -953,12 +985,14 @@ multiBalanceRowAsCellBuilders bopts ReportOpts{..} colspans
 multiBalanceRowAsText :: ReportOpts -> PeriodicReportRow a MixedAmount -> [[WideBuilder]]
 multiBalanceRowAsText opts =
     rawTableContent .
-    multiBalanceRowAsCellBuilders oneLineNoCostFmt{displayColour=color_ opts} opts [] Value
+    multiBalanceRowAsCellBuilders oneLineNoCostFmt{displayColour=color_ opts} opts []
+        Value simpleDateSpanCell
 
 multiBalanceRowAsCsvText :: ReportOpts -> [DateSpan] -> PeriodicReportRow a MixedAmount -> [[T.Text]]
 multiBalanceRowAsCsvText opts colspans =
     map (map (wbToText . Ods.cellContent)) .
-    multiBalanceRowAsCellBuilders machineFmt opts colspans Value
+    multiBalanceRowAsCellBuilders machineFmt opts colspans
+        Value simpleDateSpanCell
 
 
 -- Budget reports

diff --git a/hledger/Hledger/Cli/CompoundBalanceCommand.hs b/hledger/Hledger/Cli/CompoundBalanceCommand.hs
@@ -364,7 +364,8 @@ compoundBalanceReportAsHtml ropts cbr =
     totalrows =
       if no_total_ ropts || length subreports == 1 then []
       else
-        multiBalanceRowAsCellBuilders machineFmt ropts colspans Total totalrow
+        multiBalanceRowAsCellBuilders machineFmt ropts colspans
+            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)