imp: web: page the journal and register views, and link to each year (#586)

Justfile

@@ -586,6 +586,9 @@ samplejournals:
     tools/generatejournal 10000 90000 10   > examples/10ktxns-90kaccts.journal
     tools/generatejournal 10000 100000 10  > examples/10ktxns-100kaccts.journal
     tools/generatejournal 10000 1000000 10 > examples/10ktxns-1maccts.journal
+    # for hledger-web's paging: a sparse century, ten transactions a year, and a dense year
+    tools/generatejournal 1000 20 3    --start=1926-01-01 --days=36500 > examples/century-sparse.journal
+    tools/generatejournal 6000 100 4   --start=2026-01-01 --days=365   > examples/dense-year.journal
 
 #    tools/generatejournal.hs 3 5 5 --chinese > examples/chinese.journal  # don't regenerate, keep the simple version
 # $ just --set BENCHEXES ledger,hledger  bench

hledger-lib/locale/de.po

@@ -877,3 +877,43 @@ msgstr "Bilanz und Einnahmenüberschussrechnung zeigen Verbindlichkeiten, Eigenk
 
 msgid "The sidebar's report links show the balance sheet, income statement, and cashflow statement, each linking to the other reports"
 msgstr "Die Berichtslinks der Seitenleiste zeigen Bilanz, Einnahmenüberschussrechnung und Kapitalflussrechnung, jeweils mit Links zu den anderen Berichten"
+
+#. hledger-web: paging of the journal and register views.
+#, python-brace-format
+msgid "Showing {first} to {last} of {total} transactions"
+msgstr "Buchungen {first} bis {last} von {total}"
+
+msgid "Show the newer transactions"
+msgstr "Die neueren Buchungen anzeigen"
+
+msgid "Newer"
+msgstr "Neuere"
+
+msgid "Show the older transactions"
+msgstr "Die älteren Buchungen anzeigen"
+
+msgid "Older"
+msgstr "Ältere"
+
+#, python-brace-format
+msgid "Show page {n}"
+msgstr "Seite {n} anzeigen"
+
+#, python-brace-format
+msgid "Page {n}"
+msgstr "Seite {n}"
+
+msgctxt "years row"
+msgid "Years:"
+msgstr "Jahre:"
+
+msgid "Show all years"
+msgstr "Alle Jahre anzeigen"
+
+msgctxt "years row"
+msgid "All"
+msgstr "Alle"
+
+#, python-brace-format
+msgid "Show only {year}"
+msgstr "Nur {year} anzeigen"

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

@@ -7,10 +7,12 @@
 
 module Hledger.Web.Handler.JournalR where
 
+import Data.Text qualified as T
 import Hledger.Utils.I18n (tr, trf)
 import Hledger
 import Hledger.Cli.CliOptions
 import Hledger.Web.Import
+import Hledger.Web.Paging
 import Hledger.Web.WebOptions
 import Hledger.Web.Widget.AddForm (addModal)
 import Hledger.Web.Widget.Common
@@ -23,16 +25,25 @@ getJournalR = do
   checkServerSideUiEnabled
   VD{perms, j, q, opts, qparam, qopts, today, trs} <- getViewData
   require ViewPermission
+  pagereq <- pageRequest
   let title = case inAccount qopts of
         Nothing         -> tr trs "General Journal"
         Just (a, True)  -> trf trs "Transactions in {account}" [("account", a)]
         Just (a, False) -> trf trs "Transactions in {account} (excluding subaccounts)" [("account", a)]
       title' = if q /= Any then trf trs "{title}, filtered" [("title", title)] else title
-      acctlink a = (RegisterR, [("q", replaceInacct qparam $ accountQuery a)])
-      rspec = (reportspec_ $ cliopts_ opts){_rsQuery = filterQuery (not . queryIsDepth) q}
-      items = reverse $
+      -- An account's register, opened on the page holding this transaction.
+      acctlink a t = (RegisterR, [("q", replaceInacct qparam $ accountQuery a), ("txn", T.pack $ show $ tindex t)])
+      q' = filterQuery (not . queryIsDepth) q
+      rspec = (reportspec_ $ cliopts_ opts){_rsQuery = q'}
+      -- The matching transactions, newest first; this page shows one page of them.
+      alltxns = reverse $
         styleAmounts (journalCommodityStylesWith HardRounding j) $
         entriesReport rspec j
+      (page, items) = pageOf pagereq tindex alltxns
+      -- The years the search matches in, ignoring any date term in it.
+      years = map tdate $
+        maybe alltxns (\dq -> entriesReport rspec{_rsQuery = filterQuery (not . queryIsDepth) dq} j) $
+        datelessQuery today j qparam
       transactionFrag = transactionFragment j
 
   defaultLayout $ do

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

@@ -19,6 +19,7 @@ import Hledger.Utils.I18n (tr, trc, trf)
 import Hledger
 import Hledger.Cli.CliOptions
 import Hledger.Web.Import
+import Hledger.Web.Paging
 import Hledger.Web.WebOptions
 import Hledger.Web.Widget.AddForm (addModal)
 import Hledger.Web.Widget.Common
@@ -36,6 +37,7 @@ getRegisterR = do
   -- the transactions shown; a report's ending balance links here that way,
   -- so that the balance ends on the figure clicked.
   historical <- (== Just "historical") <$> lookupGetParam "accum"
+  pagereq <- pageRequest
 
   let title = case inAccount qopts of
         Nothing         -> tr trs "all accounts"
@@ -50,7 +52,9 @@ getRegisterR = do
       accumParams = [("accum", "historical") | historical]
       qParams t = [("q", t) | not (T.null t)]
       acctQuery = fromMaybe Any (inAccountQuery qopts)
-      acctlink acc = (RegisterR, ("q", replaceInacct qparam $ accountQuery acc) : accumParams)
+      -- An account's register, keeping this register's mode, opened on the
+      -- page holding this transaction.
+      acctlink acc t = (RegisterR, ("q", replaceInacct qparam $ accountQuery acc) : ("txn", T.pack $ show $ tindex t) : accumParams)
       -- In an account's register a type: term selects the postings
       -- totaled, not the accounts named beside them: a liability's
       -- register names the accounts it was posted against, whatever their
@@ -65,9 +69,22 @@ getRegisterR = do
           zip (map (T.unpack . accountSummarisedName . paccount) xs) $
           tailSafe (", "<$xs) ++ [""]
       styles = journalCommodityStylesWith HardRounding j
-      (startbal, items) =
+      -- The matching transactions, newest first, and the balance brought
+      -- forward from before them; this page shows one page of them.
+      (startbal, allitems) =
         bimap (styleAmounts styles) (styleAmounts styles) $
         accountTransactionsReportWithStart rspec{_rsQuery=q} j acctQuery
+      (page, items) = pageOf pagereq (tindex . triOrigTransaction) allitems
+      -- The brought-forward row is older than every transaction, so it
+      -- ends the last page.
+      lastpage = pgNumber page >= pgCount page
+      -- The years the search matches in, ignoring any date term in it. A
+      -- year's count is by register date, while its page matches date:YYYY
+      -- against each posting's date, so a transaction with postings dated in
+      -- two years is counted once and shown in both.
+      years = map triDate $
+        maybe allitems (\dq -> accountTransactionsReport rspec{_rsQuery = dq} j acctQuery) $
+        datelessQuery today j qparam
       balancelabel
         | historical               = trc trs "column heading" "Historical Total"
         | isJust (inAccount qopts) = trc trs "column heading" "Period Total"

hledger-web/Hledger/Web/Paging.hs

@@ -0,0 +1,164 @@
+-- | Paging for the journal and register pages, which show the newest
+-- transactions first, a page at a time, however large the journal is;
+-- and the row of years a search matches, for moving through history.
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes       #-}
+{-# LANGUAGE RecordWildCards   #-}
+{-# LANGUAGE TemplateHaskell   #-}
+
+module Hledger.Web.Paging
+  ( pageSize
+  , Page(..)
+  , PageRequest(..)
+  , pageRequest
+  , pageOf
+  , pageNumbers
+  , pagingLinks
+  , datelessQuery
+  , yearsRow
+  ) where
+
+import Data.Function (on)
+import Data.List (findIndex, groupBy, intercalate)
+import Data.Set qualified as S
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Time (Day, toGregorian)
+import Text.Hamlet (hamletFile)
+import Text.Read (readMaybe)
+import Yesod (HtmlUrl, MonadHandler, lookupGetParam)
+
+import Hledger
+import Hledger.Query qualified as Query
+import Hledger.Utils.I18n (Translations, tr, trc, trf)
+import Hledger.Web.Widget.Common (removeDates)
+
+-- | How many transactions a journal or register page shows: the newest
+-- this many, with links to the older pages. It keeps a page to a megabyte
+-- or two and a few thousand table rows, which browsers render promptly,
+-- where a whole journal of tens of thousands of rows stalls some (#586).
+pageSize :: Int
+pageSize = 1000
+
+-- | Which page of a list is shown, and where it sits in the list.
+data Page = Page
+  { pgNumber :: Int  -- ^ this page's number, from 1
+  , pgCount  :: Int  -- ^ how many pages there are, at least 1
+  , pgFirst  :: Int  -- ^ the position of this page's first item, from 1; 0 when there are none
+  , pgLast   :: Int  -- ^ the position of this page's last item
+  , pgTotal  :: Int  -- ^ how many items there are in all
+  } deriving (Eq, Show)
+
+-- | Which page a request asks for: a page by number, or the page holding
+-- a transaction named by its index (a link from one view to a transaction
+-- in the other says which), or else the first.
+data PageRequest = PageNumber Int | PageOfTransaction Integer | FirstPage
+  deriving (Eq, Show)
+
+-- | The page the page and txn query parameters ask for. A page number
+-- that is not a positive integer is ignored; a number past the last page
+-- is brought back to it by 'pageOf'.
+pageRequest :: MonadHandler m => m PageRequest
+pageRequest = do
+  mpage <- (>>= readMaybe . T.unpack) <$> lookupGetParam "page"
+  mtxn  <- (>>= readMaybe . T.unpack) <$> lookupGetParam "txn"
+  return $ case (mpage, mtxn) of
+    (Just n, _)       -> PageNumber (clamp n)
+    (Nothing, Just i) -> PageOfTransaction i
+    _                 -> FirstPage
+  where
+    -- read as an Integer, so that a huge number stays past the end
+    -- rather than wrapping around
+    clamp :: Integer -> Int
+    clamp = fromInteger . max 1 . min (toInteger (maxBound :: Int))
+
+-- | The requested page of a list, and where it sits: the first page is the
+-- first 'pageSize' items, and a page number past the end gives the last
+-- page. The second argument gives an item's transaction index, for finding
+-- the page holding a transaction; an index not in the list gives the first
+-- page.
+pageOf :: PageRequest -> (a -> Integer) -> [a] -> (Page, [a])
+pageOf req indexOf xs = (Page{..}, items)
+  where
+    pgTotal  = length xs
+    pgCount  = max 1 $ (pgTotal + pageSize - 1) `div` pageSize
+    pgNumber = max 1 $ min pgCount $ case req of
+      PageNumber n        -> n
+      PageOfTransaction i -> maybe 1 (\k -> k `div` pageSize + 1) $ findIndex ((== i) . indexOf) xs
+      FirstPage           -> 1
+    items    = take pageSize $ drop ((pgNumber - 1) * pageSize) xs
+    pgFirst  = if pgTotal == 0 then 0 else (pgNumber - 1) * pageSize + 1
+    pgLast   = min pgTotal (pgNumber * pageSize)
+
+-- | The page numbers a pager shows: up to ten, in a window that slides
+-- along with the current page, as web pagers usually do.
+pageNumbers :: Int -> Int -> [Int]
+pageNumbers current count = [start .. min count (start + 9)]
+  where start = max 1 $ min (current - 4) (count - 9)
+
+-- | The line saying which of the matching transactions this page shows,
+-- and under it the row of pages: links to the newer and older pages and
+-- to the pages by number, the current one marked. Nothing when they all
+-- fit on one page. The links keep the search.
+pagingLinks :: Translations -> r -> Text -> Page -> HtmlUrl r
+pagingLinks trs here qparam Page{..} = $(hamletFile "templates/paging.hamlet")
+  where
+    showing = trf trs "Showing {first} to {last} of {total} transactions"
+      [("first", withCommas pgFirst), ("last", withCommas pgLast), ("total", withCommas pgTotal)]
+    pageTitle n = trf trs "Show page {n}" [("n", T.pack (show n))]
+    pageLabel n = trf trs "Page {n}" [("n", T.pack (show n))]
+    link n = (here, [("q", qparam) | not (T.null qparam)] ++ [("page", T.pack (show n)) | n > 1])
+    mnewer = if pgNumber > 1       then Just (pgNumber - 1) else Nothing
+    molder = if pgNumber < pgCount then Just (pgNumber + 1) else Nothing
+    numbers = pageNumbers pgNumber pgCount
+
+-- | The search without its date terms, parsed as the year links' searches
+-- will be; or Nothing when it has none, or when what is left does not
+-- parse. The years row counts what a search matches in any year by the
+-- same report the page shows, so a handler runs its report again on this,
+-- and the counts are what each year link's page shows.
+datelessQuery :: Day -> Journal -> Text -> Maybe Query
+datelessQuery today j qparam
+  | length rest == length terms = Nothing
+  | otherwise = case parseQuery today (T.unwords rest) of
+      Right (q, _) -> Just . simplifyQuery $ queryExpandCurAliases j q
+      Left _       -> Nothing
+  where
+    terms = filter (not . T.null) $ Query.words'' queryprefixes qparam
+    rest = removeDates qparam
+
+-- | The years in which a search matches transactions, each a link to the
+-- search narrowed to that year, after an All link that widens it again.
+-- Nothing when there is only one year, which has nowhere to go. More than
+-- twenty years are grouped by decade, a row each.
+yearsRow :: Translations -> r -> Text -> [Day] -> HtmlUrl r
+yearsRow trs here qparam days = $(hamletFile "templates/years.hamlet")
+  where
+    showOnly y = trf trs "Show only {year}" [("year", T.pack (show y))]
+    years :: [Integer]
+    years = S.toAscList $ S.fromList [y | d <- days, let (y, _, _) = toGregorian d]
+    manyYears = length years > 1
+    byDecade = if length years > 20 then map decadeRow $ groupBy ((==) `on` decade) years else []
+    decadeRow ys@(y:_) = (show (decade y * 10) ++ "s", ys)
+    decadeRow [] = ("", [])
+    decade y = y `div` 10
+    terms = filter (not . T.null) $ Query.words'' queryprefixes qparam
+    isDateTerm t = any (`T.isPrefixOf` t) ["date:", "date2:"]
+    -- the search without its date terms, which each year link replaces
+    rest = removeDates qparam
+    -- A year is current when the search names it as a whole, in the form
+    -- the year links use; a year written another way is not recognized.
+    isCurrent y = ("date:" <> T.pack (show y)) `elem` terms
+    allCurrent = not $ any isDateTerm terms
+    yearlink y = (here, [("q", T.unwords $ ("date:" <> T.pack (show y)) : rest)])
+    alllink = (here, [("q", T.unwords rest) | not (null rest)])
+
+-- | A count with thousands separators, as English prose has it: 1,234.
+withCommas :: Int -> Text
+withCommas n
+  | n < 0 = "-" <> withCommas (negate n)
+  | otherwise = T.pack . reverse . intercalate "," . chunks . reverse $ show n
+  where
+    chunks [] = []
+    chunks s = let (a, b) = splitAt 3 s in a : chunks b