diff --git a/hledger-web/Hledger/Web/Handler/BalanceR.hs b/hledger-web/Hledger/Web/Handler/BalanceR.hs index d018fcb1047..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. @@ -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) _ -> diff --git a/hledger-web/Hledger/Web/Handler/StatementsR.hs b/hledger-web/Hledger/Web/Handler/StatementsR.hs index 72a51ac9d6b..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. @@ -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 diff --git a/hledger-web/Hledger/Web/ReportPage.hs b/hledger-web/Hledger/Web/ReportPage.hs index bbd52c3221c..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) @@ -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. 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