summaryrefslogtreecommitdiff
path: root/src/Index.hs
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2026-04-08 10:04:31 +0200
committerTom Smeding <tom@tomsmeding.com>2026-04-08 10:06:47 +0200
commit7105c50f858684b894b1c010a405dd7531dccb6c (patch)
tree08673f8973c5078c4cc95eaff5e748af990e975b /src/Index.hs
parent59b485a3c860c81546f3a2b5389b14e5001e053d (diff)
Timestamp links on calendar-day page
Diffstat (limited to 'src/Index.hs')
-rw-r--r--src/Index.hs29
1 files changed, 15 insertions, 14 deletions
diff --git a/src/Index.hs b/src/Index.hs
index 69be325..c0f98dd 100644
--- a/src/Index.hs
+++ b/src/Index.hs
@@ -292,10 +292,13 @@ binSearch vec needle
in if vec IGV.! mid <= needle
then go mid hi else go lo mid
--- | If ID is found, returns index in the linear list of events for this channel
-findEventIDLinear :: Index -> Channel -> EventID -> IO (Maybe Int)
+-- | If ID is found, returns:
+-- - Timestamp of the event
+-- - Index in the linear list of events for this channel
+-- - Index in the list of events in the channel on that day
+findEventIDLinear :: Index -> Channel -> EventID -> IO (Maybe (YMDHMS, Int, Int))
findEventIDLinear index@(Index _ mp _) chan eid = runMaybeT $ do
- (YMDHMS ymd hms, idoff) <- hoistMaybe (parseEventID eid)
+ (ymdhms@(YMDHMS ymd hms), idoff) <- hoistMaybe (parseEventID eid)
day <- hoistMaybe (uncurry3 fromGregorianValid (ymdToGregorian ymd))
ci <- lift $ readIORef (mp Map.! chan)
@@ -314,7 +317,7 @@ findEventIDLinear index@(Index _ mp _) chan eid = runMaybeT $ do
eventsBeforeDay | dayidx == 0 = 0
| otherwise = ciCountUntil ci IGV.! (dayidx - 1)
let dayoff = minimumBy (comparing (\off -> abs (off - idoff))) candidates
- return (eventsBeforeDay + dayoff)
+ return (ymdhms, eventsBeforeDay + dayoff, dayoff)
-- other methods
@@ -331,14 +334,18 @@ indexCalendar (Index _ mp _) chan = do
else scan IGV.! i - scan IGV.! (i - 1)
| i <- [0 .. IGV.length scan - 1]])
-indexGetEventsDay :: Index -> Channel -> Day -> IO [(HMS, Event)]
+indexGetEventsDay :: Index -> Channel -> Day -> IO [(HMS, EventID, Event)]
indexGetEventsDay index@(Index _ mp _) chan day = do
ci <- readIORef (mp Map.! chan)
+ let ymd = dayToYMD day
if day < ciStartDay ci || day > ciEndDay ci
then return []
- else loadDay index chan (dayToYMD day) >>= \case
- Just (bs, _lineStarts) -> return (parseLog bs)
- Nothing -> return [] -- if the file doesn't exist, there ain't no events
+ else loadDay index chan ymd <&> \case
+ Just (bs, _lineStarts) ->
+ let events = parseLog bs
+ in zipWith (\(hms, ev) off -> (hms, genEventID (YMDHMS ymd hms) off, ev))
+ events [0..]
+ Nothing -> [] -- if the file doesn't exist, there ain't no events
-- utilities
@@ -425,12 +432,6 @@ parseFileName name
Just r -> r
Nothing -> error $ "No read: " ++ show s
-ymdToGregorian :: YMD -> (Year, MonthOfYear, DayOfMonth)
-ymdToGregorian (YMD y m d) = (fromIntegral y, fromIntegral m, fromIntegral d)
-
-ymdFromGregorian :: (Year, MonthOfYear, DayOfMonth) -> YMD
-ymdFromGregorian (y, m, d) = YMD (fromIntegral y) (fromIntegral m) (fromIntegral d)
-
toFileName :: YMD -> String
toFileName ymd = ymdToString ymd ++ ".log"