Add hyperlinks to accounts and dates in HTML and FODS export

hledger-lib/Hledger/Reports/ReportOptions.hs

@@ -140,6 +140,7 @@ data ReportOpts = ReportOpts {
     ,no_elide_         :: Bool
     ,real_             :: Bool
     ,format_           :: StringFormat
+    ,balance_base_url_ :: Maybe T.Text
     ,pretty_           :: Bool
     ,querystring_      :: [T.Text]
     --
@@ -199,6 +200,7 @@ defreportopts = ReportOpts
     , no_elide_         = False
     , real_             = False
     , format_           = def
+    , balance_base_url_ = Nothing
     , pretty_           = False
     , querystring_      = []
     , average_          = False
@@ -255,6 +257,7 @@ rawOptsToReportOpts d rawopts =
           ,no_elide_         = boolopt "no-elide" rawopts
           ,real_             = boolopt "real" rawopts
           ,format_           = format
+          ,balance_base_url_ = T.pack <$> maybestringopt "base-url" rawopts
           ,querystring_      = querystring
           ,average_          = boolopt "average" rawopts
           ,related_          = boolopt "related" rawopts

hledger-lib/Hledger/Write/Html.hs

@@ -36,6 +36,10 @@ formatRow = Lucid.tr_ . traverse_ formatCell
 formatCell :: (Lines border) => Cell border (Lucid.Html ()) -> Lucid.Html ()
 formatCell cell =
     let str = cellContent cell in
+    let content =
+            if Text.null $ cellAnchor cell
+                then str
+                else Lucid.a_ [Lucid.href_ $ cellAnchor cell] str in
     let border field access =
             map (field<>) $ borderLines $ access $ cellBorder cell in
     let leftBorder   = border "border-left:"   Spr.borderLeft   in
@@ -50,7 +54,7 @@ formatCell cell =
             map Lucid.class_ $
             filter (not . Text.null) [Spr.textFromClass $ cellClass cell] in
     case cellStyle cell of
-        Head -> Lucid.th_ (style++class_) str
+        Head -> Lucid.th_ (style++class_) content
         Body emph ->
             let align =
                     case cellType cell of
@@ -61,7 +65,7 @@ formatCell cell =
                     case emph of
                         Item -> id
                         Total -> Lucid.b_
-            in  Lucid.td_ (style++align++class_) $ withEmph str
+            in  Lucid.td_ (style++align++class_) $ withEmph content
 
 
 class (Spr.Lines border) => Lines border where

hledger-lib/Hledger/Write/Ods.hs

@@ -314,9 +314,16 @@ formatCell cell =
                         (cellContent cell)
                 _ -> "office:value-type='string'"
 
+        anchor text =
+            if T.null $ Spr.cellAnchor cell
+                then text
+                else printf "<text:a xlink:href='%s'>%s</text:a>"
+                        (escape $ T.unpack $ Spr.cellAnchor cell) text
+
     in
     printf "<table:table-cell%s %s>" style valueType :
-    printf "<text:p>%s</text:p>" (escape $ T.unpack $ cellContent cell) :
+    printf "<text:p>%s</text:p>"
+        (anchor $ escape $ T.unpack $ cellContent cell) :
     "</table:table-cell>" :
     []
 

hledger-lib/Hledger/Write/Spreadsheet.hs

@@ -87,20 +87,22 @@ data Cell border text =
         cellType :: Type,
         cellBorder :: Border border,
         cellStyle :: Style,
+        cellAnchor :: Text,
         cellClass :: Class,
         cellContent :: text
     }
 
 instance Functor (Cell border) where
-    fmap f (Cell typ border style class_ content) =
-        Cell typ border style class_ $ f content
+    fmap f (Cell typ border style anchor class_ content) =
+        Cell typ border style anchor class_ $ f content
 
 defaultCell :: (Lines border) => text -> Cell border text
 defaultCell text =
     Cell {
         cellType = TypeString,
         cellBorder = noBorder,
         cellStyle = Body Item,
+        cellAnchor = mempty,
         cellClass = Class mempty,
         cellContent = text
     }

hledger/Hledger/Cli/Commands/Balance.hs

@@ -261,6 +261,7 @@ module Hledger.Cli.Commands.Balance (
  ,multiBalanceReportTableAsText
  ,multiBalanceReportAsSpreadsheet
  ,addTotalBorders
+ ,simpleDateSpanCell
  ,RowClass(..)
   -- ** HTML output helpers
  ,stylesheet_
@@ -282,6 +283,7 @@ module Hledger.Cli.Commands.Balance (
 ) where
 
 import Control.Arrow (second, (***))
+import Control.Monad (guard)
 import Data.Decimal (roundTo)
 import Data.Default (def)
 import Data.Function (on)
@@ -353,6 +355,7 @@ balancemode = hledgerCommandMode
     ,flagNone ["no-total","N"] (setboolopt "no-total") "omit the final total row"
     ,flagNone ["no-elide"] (setboolopt "no-elide") "don't squash boring parent accounts (in tree mode)"
     ,flagReq  ["format"] (\s opts -> Right $ setopt "format" s opts) "FORMATSTR" "use this custom line format (in simple reports)"
+    ,flagReq  ["base-url"] (\s opts -> Right $ setopt "base-url" s opts) "URLPREFIX" "add anchors to table cells with resepct to this base URL"
     ,flagNone ["sort-amount","S"] (setboolopt "sort-amount") "sort by amount instead of account code/name (in flat mode). With multiple columns, sorts by the row total, or by row average if that is displayed."
     ,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total"
     ,flagNone ["invert"] (setboolopt "invert") "display all amounts with reversed sign"
@@ -597,6 +600,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
@@ -609,6 +636,15 @@ addTotalBorders =
 rawTableContent :: [[Ods.Cell border text]] -> [[text]]
 rawTableContent = map (map Ods.cellContent)
 
+setAccountAnchor ::
+    Maybe Text -> Text -> Ods.Cell border text -> Ods.Cell border text
+setAccountAnchor base acct cell =
+    cell
+    {Ods.cellAnchor =
+        maybe mempty
+            (\url -> url <> "register?q=inacct:" <> quoteIfSpaced acct)
+            base}
+
 
 -- | Render a single-column balance report as FODS.
 balanceReportAsSpreadsheet ::
@@ -629,16 +665,20 @@ balanceReportAsSpreadsheet opts (items, total) =
     rows ::
         RowClass -> AccountName ->
         MixedAmount -> [[Ods.Cell Ods.NumLines Text]]
-    rows rc name ma = case layout_ opts of
+    rows rc name ma =
+      let accountCell =
+              setAccountAnchor
+                  (guard (rc==Value) >> balance_base_url_ opts) name $
+              cell $ accountNameDrop (drop_ opts) name in
+      case layout_ opts of
       LayoutBare ->
           map (\a ->
-                [showName name,
+                [accountCell,
                  cell $ acommodity a,
                  renderAmount rc $ mixedAmount a])
           . amounts $ mixedAmountStripCosts ma
-      _ -> [[showName name, renderAmount rc ma]]
+      _ -> [[accountCell, renderAmount rc ma]]
 
-    showName = cell . accountNameDrop (drop_ opts)
     renderAmount rc mixedAmt =
         wbToText <$> cellFromMixedAmount bopts (amountClass rc, mixedAmt)
       where
@@ -719,19 +759,26 @@ multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport
       LayoutBare -> headerCell "commodity" : dateHeaders
       _          -> dateHeaders
     dateHeaders =
-      map (headerCell . showDateSpan) colspans ++
+      map (headerDateSpanCell balance_base_url_) colspans ++
       [hCell "rowtotal" "total" | row_total_] ++
       [hCell "rowaverage" "average" | average_]
     fullRowAsTexts row =
-        map (accountCell (showName row) :) $ rowAsText Value row
-      where showName = accountNameDrop drop_ . prrFullName
+        map (anchorCell:) $
+        rowAsText Value (dateSpanCell balance_base_url_ acctName) row
+      where acctName = prrFullName row
+            anchorCell =
+              setAccountAnchor balance_base_url_ 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.
 
@@ -884,10 +931,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
@@ -914,9 +962,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 _ [] = [[]]
@@ -936,12 +986,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
@@ -1241,7 +1293,7 @@ budgetReportAsSpreadsheet
                -> PeriodicReportRow a BudgetCell
                -> [[Ods.Cell Ods.NumLines Text]]
     rowAsTexts rc render row@(PeriodicReportRow _ as (rowtot,budgettot) (rowavg, budgetavg))
-      | layout_ /= LayoutBare = [cell (render row) : map showNorm vals]
+      | layout_ /= LayoutBare = [accountCell : map showNorm vals]
       | otherwise =
             joinNames . zipWith (:) (map cell cs)  -- add symbols and names
           . transpose                   -- each row becomes a list of Text quantities
@@ -1258,7 +1310,11 @@ budgetReportAsSpreadsheet
                         (budgetAverageClass rc, budgetavg)]
                             | average_]
 
-        joinNames = map (cell (render row) :)
+        joinNames = map (accountCell :)
+        accountCell =
+            let name = render row in
+            setAccountAnchor (guard (rc==Value) >> balance_base_url_) name $
+                cell name
 
 
 -- tests

hledger/Hledger/Cli/Commands/Balance.md

@@ -385,6 +385,19 @@ $ hledger bal -% cur:\\$
 $ hledger bal -% cur:€
 ```
 
+### Hyperlinks
+
+The HTML and FODS output formats support hyperlinks to `hledger-web`'s
+Register pages for every account and period.
+E.g. if your `hledger-web` server is reachable
+under the URL `http://localhost:5000/`
+then you might run the `balance` command
+with the extra option `--base-url=http://localhost:5000/`.
+The export function will not add any slash
+in order to support relative hyperreferences.
+Thus it is important that you add the trailing slash to the URL yourselves,
+where needed.
+
 ### Multi-period balance report
 
 With a [report interval](#report-intervals) (set by the `-D/--daily`,

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)