lib: Write.Spreadsheet: support for anchors in HTML and FODS export

cli: Commands.Balance: new option --base-url
It adds hledger-web-compatible hyperlinks to account names.

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

@@ -37,6 +37,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
@@ -51,7 +55,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
@@ -62,7 +66,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,13 +87,14 @@ 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) =
+    fmap f (Cell typ border style anchor class_ content) =
-        Cell typ border style class_ $ f content
+        Cell typ border style anchor class_ $ f content
 
 defaultCell :: (Lines border) => text -> Cell border text
 defaultCell text =
@@ -101,6 +102,7 @@ defaultCell text =
         cellType = TypeString,
         cellBorder = noBorder,
         cellStyle = Body Item,
+        cellAnchor = mempty,
         cellClass = Class mempty,
         cellContent = text
     }

hledger/Hledger/Cli/Commands/Balance.hs

@@ -265,6 +265,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)
@@ -337,6 +338,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"
@@ -593,6 +595,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 =
+        foldMap
+            (\url -> url <> "register?q=inacct:" <> quoteIfSpaced acct)
+            base}
+
 
 -- | Render a single-column balance report as FODS.
 balanceReportAsSpreadsheet ::
@@ -613,16 +624,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
@@ -706,9 +721,11 @@ multiBalanceReportAsSpreadsheetHelper ishtml opts@ReportOpts{..} (PeriodicReport
       map (headerCell . showDateSpan) colspans ++
       [hCell "rowtotal" "total" | row_total_] ++
       [hCell "rowaverage" "average" | average_]
-    fullRowAsTexts row =
+    fullRowAsTexts row = map (anchorCell:) $ rowAsText Value row
-        map (accountCell (showName row) :) $ rowAsText Value row
+      where anchorCell =
-      where showName = accountNameDrop drop_ . prrFullName
+              let name = prrFullName row in
+              setAccountAnchor balance_base_url_ name $
+              accountCell $ accountNameDrop drop_ name
     totalrows
       | no_total_ = []
       | ishtml    = zipWith (:) (accountCell totalRowHeadingHtml : repeat Ods.emptyCell) $ rowAsText Total tr
@@ -1207,7 +1224,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
@@ -1224,7 +1241,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/CompoundBalanceCommand.hs

@@ -91,6 +91,7 @@ compoundBalanceCommandMode CompoundBalanceCommandSpec{..} =
     ,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"
     ,flagNone ["percent", "%"] (setboolopt "percent") "express values in percentage of each column's total"
     ,flagReq  ["layout"] (\s opts -> Right $ setopt "layout" s opts) "ARG"