diff options
Diffstat (limited to 'src/Index.hs')
| -rw-r--r-- | src/Index.hs | 65 |
1 files changed, 48 insertions, 17 deletions
diff --git a/src/Index.hs b/src/Index.hs index 5754e33..5486692 100644 --- a/src/Index.hs +++ b/src/Index.hs @@ -2,7 +2,9 @@ module Index ( Index, initIndex, indexGetEventsLinear, + indexGetEventsDay, indexNumEvents, + indexCalendar, ) where import Data.Time.Calendar @@ -16,6 +18,7 @@ import Data.Map.Strict qualified as Map import Data.Text qualified as T import Data.Vector.Storable qualified as VS import Data.Word (Word32) +import System.Clock qualified as Clock import System.Directory import System.FilePath import Text.Read (readMaybe) @@ -28,13 +31,15 @@ import ZNC data ChanIndex = ChanIndex - { ciStartDay :: Day - , ciEndDay :: Day - , ciCountUntil :: VS.Vector Int -- ^ number of events up to and /including/ this day - , ciTotal :: Int } + { ciStartDay :: !Day + , ciEndDay :: !Day -- ^ inclusive + , ciCountUntil :: !(VS.Vector Int) -- ^ number of events up to and /including/ this day + , ciTotal :: !Int } deriving (Show) -data Index = Index FilePath (Map Channel ChanIndex) (Cache (Channel, YMD) (ByteString, VS.Vector Word32)) +data Index = Index !FilePath + !(Map Channel ChanIndex) + !(Cache (Channel, YMD) (ByteString, VS.Vector Word32)) -- init @@ -42,6 +47,7 @@ initIndex :: FilePath -> [Channel] -> IO Index initIndex basedir toimport = do cache <- cacheNew 100 + c_start <- Clock.getTime Clock.Realtime items <- fmap concat . forM (map chanNetwork toimport) $ \nwT -> do let nw = T.unpack nwT @@ -56,7 +62,7 @@ initIndex basedir toimport = do let minday = minimum (map fst days) maxday = maximum (map fst days) ndays = fromIntegral @Integer @Int (diffDays maxday minday + 1) - -- traceM $ nw ++ "/" ++ ch ++ ": days = " ++ show [(toFileName (dayToDate d), i) | (d, i) <- days] + -- traceM $ nw ++ "/" ++ ch ++ ": days = " ++ show [(toFileName (dayToYMD d), i) | (d, i) <- days] let countScan = VS.fromListN ndays (drop 1 $ scanl' (+) 0 (makeCounts [minday..maxday] days)) let ntotal = sum (map snd days) return (Channel nwT chT @@ -65,6 +71,10 @@ initIndex basedir toimport = do , ciEndDay = maxday , ciCountUntil = countScan , ciTotal = ntotal}) + c_end <- Clock.getTime Clock.Realtime + let timetakenSecs = fromIntegral @_ @Double (Clock.toNanoSecs (Clock.diffTimeSpec c_start c_end)) / 1e9 + putStrLn $ "Parsing/indexing logs in " ++ show basedir ++ " took " ++ show timetakenSecs ++ " secs" + return (Index basedir (Map.fromList items) cache) makeCounts :: [Day] -> [(Day, Int)] -> [Int] @@ -81,7 +91,7 @@ makeCounts (_:ds) [] = 0 : makeCounts ds [] -- | Returns proper lazy list of events. Reading the files happens strictly, -- but parsing the events happens lazily. indexGetEventsLinear :: Index -> Channel -> Int -> Int -> IO [(YMDHMS, Event)] -indexGetEventsLinear (Index basedir mp cache) chan@(Channel network channel) from count +indexGetEventsLinear index@(Index _ mp _) chan from count | from + count < 0 = return [] | from >= ciTotal ci = return [] | otherwise = do @@ -132,13 +142,7 @@ indexGetEventsLinear (Index basedir mp cache) chan@(Channel network channel) fro ymd = YMD (fromIntegral y) (fromIntegral month) (fromIntegral d) fixDate = map $ \(tod, ev) -> (YMDHMS ymd tod, ev) in if neventsOnDay > 0 - then do (bs, lineStarts) <- cacheLookup cache (chan, ymd) >>= \case - Nothing -> do - bs <- mapFile (basedir </> T.unpack network </> T.unpack channel </> toFileName (toGregorian day)) - let lineStarts = preparseLog bs - cacheAdd cache (chan, ymd) (bs, lineStarts) - return (bs, lineStarts) - Just (bs, lineStarts) -> return (bs, lineStarts) + then do (bs, lineStarts) <- loadDay index chan ymd return (fixDate (parse lineStarts bs)) else return [] @@ -174,8 +178,36 @@ binSearch vec needle indexNumEvents :: Index -> Channel -> Int indexNumEvents (Index _ mp _) chan = ciTotal (mp Map.! chan) +indexCalendar :: Index -> Channel -> ((Day, Day), [Int]) +indexCalendar (Index _ mp _) chan = + let ci = mp Map.! chan + in ((ciStartDay ci, ciEndDay ci) + ,[if i == 0 + then ciCountUntil ci VS.! 0 + else ciCountUntil ci VS.! i - ciCountUntil ci VS.! (i - 1) + | i <- [0 .. VS.length (ciCountUntil ci) - 1]]) + +indexGetEventsDay :: Index -> Channel -> Day -> IO [(HMS, Event)] +indexGetEventsDay index@(Index _ mp _) chan day + | day < ciStartDay ci || day > ciEndDay ci = return [] + | otherwise = do + (bs, _lineStarts) <- loadDay index chan (dayToYMD day) + return (parseLog bs) + where + ci = mp Map.! chan + -- utilities +loadDay :: Index -> Channel -> YMD -> IO (ByteString, VS.Vector Word32) +loadDay (Index basedir _ cache) chan@(Channel network channel) ymd = do + cacheLookup cache (chan, ymd) >>= \case + Nothing -> do + bs <- mapFile (basedir </> T.unpack network </> T.unpack channel </> toFileName ymd) + let lineStarts = preparseLog bs + cacheAdd cache (chan, ymd) (bs, lineStarts) + return (bs, lineStarts) + Just (bs, lineStarts) -> return (bs, lineStarts) + parseFileName :: String -> (Year, MonthOfYear, DayOfMonth) parseFileName name | (y, '-' : s1) <- splitAt 4 name @@ -194,9 +226,8 @@ parseFileName name Just r -> r Nothing -> error $ "No read: " ++ show s -toFileName :: (Year, MonthOfYear, DayOfMonth) -> String -toFileName (y, m, d) = - pad '0' 4 y ++ '-' : pad '0' 2 m ++ '-' : pad '0' 2 d ++ ".log" +toFileName :: YMD -> String +toFileName ymd = ymdToString ymd ++ ".log" addDays' :: Int -> Day -> Day addDays' = addDays . fromIntegral |