From e116b6af4120988fd59409baec7d2b29ed5ee7e7 Mon Sep 17 00:00:00 2001
From: Henning Thielemann <git@henning-thielemann.de>
Date: Sun, 29 Sep 2024 11:07:37 +0200
Subject: [PATCH] cli: Commands.Balance.composeAnchor: construct an anchor from
 Maybe base-url and query

Optionally add a missing trailing slash to the base URL.
---
 hledger/Hledger/Cli/Commands/Balance.hs | 30 ++++++++++++++++++-------
 hledger/Hledger/Cli/Commands/Balance.md |  7 +++---
 2 files changed, 25 insertions(+), 12 deletions(-)

diff --git a/hledger/Hledger/Cli/Commands/Balance.hs b/hledger/Hledger/Cli/Commands/Balance.hs
index cf2eeb7ff..eff482365 100644
--- a/hledger/Hledger/Cli/Commands/Balance.hs
+++ b/hledger/Hledger/Cli/Commands/Balance.hs
@@ -598,6 +598,25 @@ registerQueryUrl query =
              map quoteIfSpaced $ filter (not . T.null) query]
     }
 
+{- |
+>>> composeAnchor Nothing ["date:2024"]
+""
+>>> composeAnchor (Just "") ["date:2024"]
+"register?q=date:2024"
+>>> composeAnchor (Just "/") ["date:2024"]
+"/register?q=date:2024"
+>>> composeAnchor (Just "foo") ["date:2024"]
+"foo/register?q=date:2024"
+>>> composeAnchor (Just "foo/") ["date:2024"]
+"foo/register?q=date:2024"
+-}
+composeAnchor :: Maybe Text -> [Text] -> Text
+composeAnchor Nothing _ = mempty
+composeAnchor (Just baseUrl) query =
+    baseUrl <>
+    (if all (('/'==) . snd) $ T.unsnoc baseUrl then "" else "/") <>
+    registerQueryUrl query
+
 -- cf. Web.Widget.Common
 removeDates :: [Text] -> [Text]
 removeDates =
@@ -612,8 +631,7 @@ headerDateSpanCell ::
 headerDateSpanCell base query spn =
     let prd = showDateSpan spn in
     (headerCell prd) {
-        Ods.cellAnchor =
-            foldMap (<> registerQueryUrl (replaceDate prd query)) base
+        Ods.cellAnchor = composeAnchor base $ replaceDate prd query
     }
 
 simpleDateSpanCell :: DateSpan -> Ods.Cell Ods.NumLines Text
@@ -626,9 +644,7 @@ dateSpanCell base query acct spn =
     let prd = showDateSpan spn in
     (Ods.defaultCell prd) {
         Ods.cellAnchor =
-            foldMap
-                (<> registerQueryUrl ("inacct:"<>acct : replaceDate prd query))
-                base
+            composeAnchor base $ "inacct:"<>acct : replaceDate prd query
     }
 
 addTotalBorders :: [[Ods.Cell border text]] -> [[Ods.Cell Ods.NumLines text]]
@@ -646,9 +662,7 @@ rawTableContent = map (map Ods.cellContent)
 setAccountAnchor ::
     Maybe Text -> [Text] -> Text -> Ods.Cell border text -> Ods.Cell border text
 setAccountAnchor base query acct cell =
-    cell
-    {Ods.cellAnchor =
-        foldMap (<> registerQueryUrl ("inacct:"<>acct : query)) base}
+    cell {Ods.cellAnchor = composeAnchor base $ "inacct:"<>acct : query}
 
 
 -- | Render a single-column balance report as FODS.
diff --git a/hledger/Hledger/Cli/Commands/Balance.md b/hledger/Hledger/Cli/Commands/Balance.md
index 509e825db..1823a249a 100644
--- a/hledger/Hledger/Cli/Commands/Balance.md
+++ b/hledger/Hledger/Cli/Commands/Balance.md
@@ -393,10 +393,9 @@ 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.
+The export function will add a missing trailing slash
+if the base URL is non-empty.
+However, `--base-url=""` can be used to produce relative URLs.
 
 ### Multi-period balance report