From eea899462d042d52b4827a314ce690d1651a79fa Mon Sep 17 00:00:00 2001
From: Tom Smeding <tom@tomsmeding.com>
Date: Tue, 7 Apr 2026 20:08:09 +0200
Subject: Event hotlinking

---
 src/Main.hs | 85 ++++++++++++++++++++++++++++++++++++-------------------------
 1 file changed, 51 insertions(+), 34 deletions(-)

(limited to 'src/Main.hs')

diff --git a/src/Main.hs b/src/Main.hs
index c516c5f..380c6be 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,5 +1,6 @@
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ViewPatterns #-}
 module Main (main) where
 
@@ -77,39 +78,51 @@ pageLog conf pages index req alias =
     Just chan -> do
       numEvents <- indexNumEvents index chan
       let npages = (numEvents + numPerPage - 1) `div` numPerPage
-          curpage | Just (readMaybe . BS8.unpack -> Just pg) <- query "page" = min npages (max 1 pg)
-                  | otherwise = npages
-          ntoleft = min 5 (curpage - 1)
-          ntoright = min 5 (npages - curpage)
-      -- traceShowM (indexNumEvents index chan, npages, curpage, ntoleft, ntoright)
-      events <- indexGetEventsLinear index chan ((curpage - 1) * numPerPage) numPerPage
-      return $ sendPage200 pages "log" $ M.object
-        ["network" ~> chanNetwork chan
-        ,"channel" ~> chanChannel chan
-        ,"alias" ~> alias
-        ,"totalevents" ~> renderLargeNumber numEvents
-        ,"picker" ~> M.object
-          ["prevpage" ~> if curpage > 1 then Just (curpage - 1) else Nothing
-          ,"nextpage" ~> if curpage < npages then Just (curpage + 1) else Nothing
-          ,"firstpage" ~> (curpage > 6)
-          ,"leftdots" ~> (curpage > 7)
-          ,"rightdots" ~> (curpage < npages - 6)
-          ,"lastpage" ~> (curpage < npages - 5)
-          ,"leftnums" ~> [curpage - ntoleft .. curpage - 1]
-          ,"curnum" ~> curpage
-          ,"rightnums" ~> [curpage + 1 .. curpage + ntoright]
-          ,"npages" ~> npages]
-        ,"events" ~> [M.object
-                       ["classlist" ~> classlist
-                       ,"datetime" ~> let YMDHMS (YMD y mo d) (HMS h mi s) = time
-                                      in pad '0' 4 y ++ '-' : pad '0' 2 mo ++ '-' : pad '0' 2 d ++ ' ' :
-                                         pad '0' 2 h ++ ':' : pad '0' 2 mi ++ ':' : pad '0' 2 s
-                       ,"nickwrap1" ~> nickw1
-                       ,"nick" ~> nick
-                       ,"nickwrap2" ~> nickw2
-                       ,"message" ~> msg]
-                     | (time, ev) <- events
-                     , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]]
+      (mcurpage, mpagehighlight) <-
+        if | Just (readMaybe . BS8.unpack -> Just pg) <- query "page" -> return (Just (min npages (max 1 pg)), Nothing)
+           | Just (TE.decodeASCII' -> Just eventID) <- query "eid" -> do
+               mevidx <- findEventIDLinear index chan eventID
+               case mevidx of
+                 Just evidx -> return (Just (evidx `div` numPerPage + 1), Just (evidx `mod` numPerPage))
+                 Nothing -> return (Nothing, Nothing)
+           | otherwise -> return (Just npages, Nothing)
+      case mcurpage of
+        Nothing -> page404 "Event ID not found"
+        Just curpage -> do
+          let ntoleft = min 5 (curpage - 1)
+              ntoright = min 5 (npages - curpage)
+          -- traceShowM (indexNumEvents index chan, npages, curpage, ntoleft, ntoright)
+          events <- indexGetEventsLinear index chan ((curpage - 1) * numPerPage) numPerPage
+          return $ sendPage200 pages "log" $ M.object
+            ["network" ~> chanNetwork chan
+            ,"channel" ~> chanChannel chan
+            ,"alias" ~> alias
+            ,"totalevents" ~> renderLargeNumber numEvents
+            ,"picker" ~> M.object
+              ["prevpage" ~> if curpage > 1 then Just (curpage - 1) else Nothing
+              ,"nextpage" ~> if curpage < npages then Just (curpage + 1) else Nothing
+              ,"firstpage" ~> (curpage > 6)
+              ,"leftdots" ~> (curpage > 7)
+              ,"rightdots" ~> (curpage < npages - 6)
+              ,"lastpage" ~> (curpage < npages - 5)
+              ,"leftnums" ~> [curpage - ntoleft .. curpage - 1]
+              ,"curnum" ~> curpage
+              ,"rightnums" ~> [curpage + 1 .. curpage + ntoright]
+              ,"npages" ~> npages]
+            ,"events" ~> [M.object
+                           ["classlist" ~> if mpagehighlight == Just dayidx
+                                             then Just (classlist `classListAdd` "highlight")
+                                             else classlist
+                           ,"datetime" ~> let YMDHMS (YMD y mo d) (HMS h mi s) = time
+                                          in pad '0' 4 y ++ '-' : pad '0' 2 mo ++ '-' : pad '0' 2 d ++ ' ' :
+                                             pad '0' 2 h ++ ':' : pad '0' 2 mi ++ ':' : pad '0' 2 s
+                           ,"linkid" ~> eid
+                           ,"nickwrap1" ~> nickw1
+                           ,"nick" ~> nick
+                           ,"nickwrap2" ~> nickw2
+                           ,"message" ~> msg]
+                         | ((time, eid, ev), dayidx) <- zip events [0..]
+                         , let (classlist, (nickw1, nick, nickw2), msg) = renderEvent ev]]
   where
     numPerPage = 100
 
@@ -125,6 +138,10 @@ pageLog conf pages index req alias =
       | n < 1000 = T.show n
       | otherwise = renderLargeNumber (n `div` 1000) <> "," <> T.pack (pad '0' 3 (n `mod` 1000))
 
+    classListAdd :: Maybe Text -> Text -> Text
+    classListAdd Nothing t = t
+    classListAdd (Just l) t = l <> " " <> t
+
 pageCalendarDay :: Config -> Pages -> Index -> Text -> Text -> IO Response
 pageCalendarDay conf pages index alias datestr =
   case (econfAlias2Chan conf Map.!? alias, parseDatestr datestr) of
-- 
cgit v1.3