diff options
Diffstat (limited to 'src/Main.hs')
| -rw-r--r-- | src/Main.hs | 85 |
1 files changed, 51 insertions, 34 deletions
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 |