Web headinglink: use date queries instead of period parameter

hledger-web/Hledger/Web/Handler/BalanceR.hs

@@ -17,7 +17,7 @@ import Hledger.Utils.I18n (tr, trf)
 import Hledger.Web.Import
 import Hledger.Web.ReportPage
 import Hledger.Web.WebOptions
-import Hledger.Web.Widget.Common (accumulationLinks, intervalLinks, removeDates, removeInacct, reportLinks)
+import Hledger.Web.Widget.Common (accumulationLinks, intervalLinks, removeInacct, reportLinks)
 
 
 -- | The balance or multi-period balance view, with sidebar.
@@ -26,18 +26,18 @@ getBalanceR = do
   checkServerSideUiEnabled
   VD{j, q, qopts, qparam, opts, today, trs} <- getViewData
   require ViewPermission
-  mperiod <- lookupGetParam "period"
-  maccum <- lookupGetParam "accum"
+  params <- reqGetParams <$> getRequest
   hideEmpty <- hideEmptyAccounts
   urlrender <- getUrlRenderParams
-  let withFilter t = if q /= Any then trf trs "{title}, filtered" [("title", t)] else t
+  let dateless = filterQuery (not . queryIsDateOrDate2)
+      withFilter t = if dateless q /= Any then trf trs "{title}, filtered" [("title", t)] else t
       rspecOrig = reportspec_ $ cliopts_ opts
       roptsOrig = _rsReportOpts rspecOrig
 
   defaultLayout $ do
     -- TRANSLATORS: the browser tab title of this page.
     setTitleI (HMsg "balance - hledger-web")
-    case reportParams today rspecOrig qparam q qopts hideEmpty mperiod maccum of
+    case reportParams today rspecOrig qparam q qopts hideEmpty params of
       Left err -> Yesod.toWidget $ do
         H.h2 $ H.toHtml $ withFilter $ reportTitle roptsOrig $ tr trs "Balance report"
         paramError trs err
@@ -57,13 +57,7 @@ getBalanceR = do
             -- links to the other reports keep the search, minus any account
             -- term, which the reports ignore, and the period as given
             menuParams = periodParams ++ [("q", qt) | let qt = T.unwords $ removeInacct qparam, not (T.null qt)]
-            -- A column heading opens this report for that column's period,
-            -- in place of any date terms in the search, which the column
-            -- narrows anyway.
-            headinglink spn = urlrender BalanceR $
-              ("period", showDateSpanForQuery spn) :
-              [("q", qt) | let qt = T.unwords $ removeDates qparam, not (T.null qt)] ++
-              accumParams
+            headinglink = urlrender BalanceR . headingParams qparam params
             -- The heading, and the report's rows in three parts, for the
             -- table's thead, tbody, and tfoot.
             (title, header, body, totals) = case rpInterval of
@@ -74,7 +68,7 @@ getBalanceR = do
                     -- The plain page has its own name; one narrowed to a
                     -- period, or showing ending balances, says so like the
                     -- multi-period page does.
-                    dflt | rpSpan == nulldatespan && accum == PerPeriod = tr trs "Balance report"
+                    dflt | queryDateSpan (date2_ ropts) (_rsQuery rspec) == nulldatespan && accum == PerPeriod = tr trs "Balance report"
                          | otherwise = trimColon $ Balance.multiBalanceReportTitle ropts mbr
                 in (reportTitle ropts dflt, [toList h], map toList b, map toList t)
               _ ->

hledger-web/Hledger/Web/Handler/StatementsR.hs

@@ -31,7 +31,7 @@ import Hledger.Write.Spreadsheet qualified as Spr
 import Hledger.Web.Import
 import Hledger.Web.ReportPage
 import Hledger.Web.WebOptions
-import Hledger.Web.Widget.Common (helplink, intervalLinks, removeDates, removeInacct, reportLinks)
+import Hledger.Web.Widget.Common (helplink, intervalLinks, removeInacct, reportLinks)
 
 getBalancesheetR, getBalancesheetequityR, getIncomestatementR, getCashflowR :: Handler Html
 -- TRANSLATORS: the browser tab titles of the statement pages.
@@ -50,18 +50,18 @@ statementPage here tabtitle spec = do
   checkServerSideUiEnabled
   VD{j, q, qopts, qparam, opts, today, trs} <- getViewData
   require ViewPermission
-  mperiod <- lookupGetParam "period"
-  maccum <- lookupGetParam "accum"
+  params <- reqGetParams <$> getRequest
   hideEmpty <- hideEmptyAccounts
   urlrender <- getUrlRenderParams
-  let withFilter t = if q /= Any then trf trs "{title}, filtered" [("title", t)] else t
+  let dateless = filterQuery (not . queryIsDateOrDate2)
+      withFilter t = if dateless q /= Any then trf trs "{title}, filtered" [("title", t)] else t
       rspecOrig = reportspec_ $ cliopts_ opts
       roptsOrig = _rsReportOpts rspecOrig
       menu = reportLinkItems reportMenu
 
   defaultLayout $ do
     setTitleI (HMsg tabtitle)
-    case reportParams today rspecOrig qparam q qopts hideEmpty mperiod maccum of
+    case reportParams today rspecOrig qparam q qopts hideEmpty params of
       Left err -> Yesod.toWidget $ do
         H.h2 $ H.toHtml $ withFilter $ effectiveTitle roptsOrig $ tr trs $ cbctitle spec NoInterval
         paramError trs err
@@ -84,13 +84,7 @@ statementPage here tabtitle spec = do
             -- Links to the other reports keep the search, minus any account
             -- term, which the reports ignore, and the period as given.
             menuParams = periodParams ++ [("q", qt) | let qt = T.unwords $ removeInacct qparam, not (T.null qt)]
-            -- A column heading opens this report for that column's period,
-            -- in place of any date terms in the search, which the column
-            -- narrows anyway.
-            headinglink spn = urlrender here $
-              ("period", showDateSpanForQuery spn) :
-              [("q", qt) | let qt = T.unwords $ removeDates qparam, not (T.null qt)] ++
-              accumParams
+            headinglink = urlrender here . headingParams qparam params
             CompoundBalanceReportParts{cbrpLeadingHeaders, cbrpDataHeaders, cbrpSections, cbrpNetRows} =
               compoundBalanceReportAsSpreadsheetParts oneLineNoCostFmt "account" ropts (cbcqueries spec) cbr
             -- The heading row with the classes the stylesheet aligns the

hledger-web/Hledger/Web/ReportPage.hs

@@ -15,6 +15,7 @@ module Hledger.Web.ReportPage (
   reportParams,
   paramError,
   columnHeading,
+  headingParams,
   relinkDateHeaders,
   reportTable,
 ) where
@@ -25,6 +26,7 @@ import Data.Maybe (fromMaybe, listToMaybe)
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Time.Calendar (Day)
+import Data.Set qualified as Set
 import Text.Blaze.Html5 ((!))
 import Text.Blaze.Html5 qualified as H
 import Text.Blaze.Html5.Attributes qualified as A
@@ -33,6 +35,7 @@ import Text.Megaparsec.Error (errorBundlePretty)
 import Hledger.Utils.I18n (Translations, tr)
 import Hledger
 import Hledger.Cli.Anchor (dateTerm, renderPeriodHeading)
+import Hledger.Web.Widget.Common (removeDates)
 import Hledger.Query qualified as Query
 import Hledger.Write.Html (Html, formatCell, nl)
 import Hledger.Write.Spreadsheet (Cell(..), NumLines)
@@ -72,15 +75,15 @@ data ReportParamError = BadPeriod String | BadAccum Text
 -- the report like a date: search term would, and the report's links
 -- carry it, so that a row's register is restricted the same way.
 reportParams ::
-  Day -> ReportSpec -> Text -> Query -> [QueryOpt] -> Bool -> Maybe Text -> Maybe Text ->
+  Day -> ReportSpec -> Text -> Query -> [QueryOpt] -> Bool -> [(Text, Text)] ->
   Either ReportParamError ReportParams
-reportParams today rspecOrig qparam q qopts hideEmpty mperiod maccum = do
+reportParams today rspecOrig qparam q qopts hideEmpty params = do
   let roptsOrig = _rsReportOpts rspecOrig
-      rpPeriod = mfilter (not . T.null) mperiod
+      rpPeriod = mfilter (not . T.null) $ lookup "period" params
   (ivl, rpSpan) <- case rpPeriod of
     Nothing -> Right (interval_ roptsOrig, nulldatespan)
     Just p  -> either (Left . BadPeriod . errorBundlePretty) Right $ parsePeriodExpr today p
-  rpAccum <- parseAccum maccum
+  rpAccum <- parseAccum $ lookup "accum" params
   let rpInterval = fromMaybe ivl $ intervalFromQueryOpts qopts
       rpRopts =
         roptsOrig {
@@ -136,6 +139,20 @@ columnHeading ropts colspans spn =
     Historical -> reportPeriodName ropts{balanceaccum_ = Historical} colspans spn
     _          -> renderPeriodHeading (period_titles_ ropts) spn
 
+-- A column heading opens this report for that column's period,
+-- in place of any date terms in the search, which the column narrows anyway.
+headingParams :: Text -> [(Text, Text)] -> DateSpan -> [(Text, Text)]
+headingParams qparam params spn =
+  [("q", T.unwords qt) |
+      let qt = dateTerm False spn ++ removeDates qparam,
+      not (null qt)] ++
+  removeAttributes ["q", "period"] params
+
+removeAttributes :: [Text] -> [(Text, Text)] -> [(Text, Text)]
+removeAttributes attrs =
+  let attrSet = Set.fromList attrs
+  in filter (flip Set.notMember attrSet . fst)
+
 -- | Give a report's heading row this page's column headings and links:
 -- the cells that link (the columns' periods) get the given heading text
 -- and link for their span.

hledger-web/Hledger/Web/Test.hs

@@ -655,7 +655,7 @@ hledgerWebTest = do
       statusIs 200
       bodyContains ">2025-01-31<"
       bodyContains ">2025-02-28<"
-      bodyContains ("href=\"" ++ defbaseurl defhost defport ++ "/balance?period=2025-01&amp;accum=historical\" title=\"Show this report for this period\"")
+      bodyContains ("href=\"" ++ defbaseurl defhost defport ++ "/balance?q=date%3A2025-01&amp;accum=historical\" title=\"Show this report for this period\"")
 
     yit "links a balance change column's heading to this report for the period" $ do
       request $ do
@@ -666,7 +666,7 @@ hledgerWebTest = do
       statusIs 200
       bodyContains ">2025-01<"
       -- the column's period replaces the search's date term
-      bodyContains ("href=\"" ++ defbaseurl defhost defport ++ "/balance?period=2025-01\" title=\"Show this report for this period\"")
+      bodyContains ("href=\"" ++ defbaseurl defhost defport ++ "/balance?q=date%3A2025-01\" title=\"Show this report for this period\"")
 
     yit "reports an accumulation mode it does not know" $ do
       request $ do
@@ -870,7 +870,7 @@ hledgerWebTest = do
       bodyContains "<h2>Monthly Balance Sheet 2025-01-31..2025-02-28</h2>"
       bodyContains ">2025-01-31<"
       bodyContains ">2025-02-28<"
-      bodyContains ("href=\"" ++ defbaseurl defhost defport ++ "/balancesheet?period=2025-01\" title=\"Show this report for this period\"")
+      bodyContains ("href=\"" ++ defbaseurl defhost defport ++ "/balancesheet?q=date%3A2025-01\" title=\"Show this report for this period\"")
       bodyContains "<input type=\"hidden\" name=\"period\" value=\"monthly\">"
 
     yit "shows balance changes instead when asked, and says so" $ do