From 4394a4bc88732d12f1d327a29a6825da190bda6f Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Sat, 3 Oct 2026 20:35:37 +0200 Subject: [PATCH 1/2] web: ref: reportParams: replace parameters mperiod and maccum by params This avoids duplicate code between BalanceR und StatementR and scales better for more parameters to come. --- hledger-web/Hledger/Web/Handler/BalanceR.hs | 5 ++--- hledger-web/Hledger/Web/Handler/StatementsR.hs | 5 ++--- hledger-web/Hledger/Web/ReportPage.hs | 8 ++++---- 3 files changed, 8 insertions(+), 10 deletions(-) diff --git a/hledger-web/Hledger/Web/Handler/BalanceR.hs b/hledger-web/Hledger/Web/Handler/BalanceR.hs index d018fcb1047..00eb09219a9 100644 --- a/hledger-web/Hledger/Web/Handler/BalanceR.hs +++ b/hledger-web/Hledger/Web/Handler/BalanceR.hs @@ -26,8 +26,7 @@ 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 @@ -37,7 +36,7 @@ getBalanceR = do 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 diff --git a/hledger-web/Hledger/Web/Handler/StatementsR.hs b/hledger-web/Hledger/Web/Handler/StatementsR.hs index 72a51ac9d6b..1b7364ae22b 100644 --- a/hledger-web/Hledger/Web/Handler/StatementsR.hs +++ b/hledger-web/Hledger/Web/Handler/StatementsR.hs @@ -50,8 +50,7 @@ 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 @@ -61,7 +60,7 @@ statementPage here tabtitle spec = do 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 diff --git a/hledger-web/Hledger/Web/ReportPage.hs b/hledger-web/Hledger/Web/ReportPage.hs index bbd52c3221c..54343fd452d 100644 --- a/hledger-web/Hledger/Web/ReportPage.hs +++ b/hledger-web/Hledger/Web/ReportPage.hs @@ -72,15 +72,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 { From e5b24d68c5b0cdd3d2e677462b5b06a5c7b1bbe4 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Mon, 5 Oct 2026 16:45:33 +0200 Subject: [PATCH 2/2] web: imp: Web report multi-period column headings use date query for selecting date span This makes the date span visible and editable in the search field and leaves the period parameter for further subdivision into smaller intervals. ReportPage.headingParams: avoid duplicate definition of headinglink in BalanceR and StatementR --- hledger-web/Hledger/Web/Handler/BalanceR.hs | 15 +++++---------- hledger-web/Hledger/Web/Handler/StatementsR.hs | 13 ++++--------- hledger-web/Hledger/Web/ReportPage.hs | 17 +++++++++++++++++ hledger-web/Hledger/Web/Test.hs | 6 +++--- 4 files changed, 29 insertions(+), 22 deletions(-) diff --git a/hledger-web/Hledger/Web/Handler/BalanceR.hs b/hledger-web/Hledger/Web/Handler/BalanceR.hs index 00eb09219a9..6d767d18658 100644 --- a/hledger-web/Hledger/Web/Handler/BalanceR.hs +++ b/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. @@ -29,7 +29,8 @@ getBalanceR = do 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 @@ -56,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 @@ -73,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) _ -> diff --git a/hledger-web/Hledger/Web/Handler/StatementsR.hs b/hledger-web/Hledger/Web/Handler/StatementsR.hs index 1b7364ae22b..07fd89af406 100644 --- a/hledger-web/Hledger/Web/Handler/StatementsR.hs +++ b/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. @@ -53,7 +53,8 @@ statementPage here tabtitle spec = do 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 @@ -83,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 diff --git a/hledger-web/Hledger/Web/ReportPage.hs b/hledger-web/Hledger/Web/ReportPage.hs index 54343fd452d..81fd228354c 100644 --- a/hledger-web/Hledger/Web/ReportPage.hs +++ b/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) @@ -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. diff --git a/hledger-web/Hledger/Web/Test.hs b/hledger-web/Hledger/Web/Test.hs index 9ffcf2c2bc0..22c0f3c03f1 100644 --- a/hledger-web/Hledger/Web/Test.hs +++ b/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&accum=historical\" title=\"Show this report for this period\"") + bodyContains ("href=\"" ++ defbaseurl defhost defport ++ "/balance?q=date%3A2025-01&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 "

Monthly Balance Sheet 2025-01-31..2025-02-28

" 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 "" yit "shows balance changes instead when asked, and says so" $ do