Some optimisation of indexing

2 files changed, 31 insertions, 20 deletions

diff --git a/src/Index.hs b/src/Index.hs
index b82d095..81eb5f2 100644
--- a/src/Index.hs
+++ b/src/Index.hs
@@ -158,9 +158,9 @@ initIndex basedir toimport = do
                      Just ymd -> ymdToGregorian ymd
                      Nothing -> error $ "Log file with unexpected file name: " ++ path
         -- atomicPrintS $ "Parsing " ++ path ++ " (" ++ show date ++ " -> " ++ show (dateToDay date) ++ ")"
-        events <- parseLog <$> BS.readFile path
-        let !nevents = length events
-            !ccpr = countCompressed (map snd events)
+        rawEvents <- parseLogRaw <$> BS.readFile path
+        let !nevents = rawNumEvents rawEvents
+            !ccpr = countCompressed (map snd (realiseEvents rawEvents))
         return (uncurry3 fromGregorian date, nevents, ccpr)
       let minday = minimum [day | (day, _, _) <- days]
           maxday = maximum [day | (day, _, _) <- days]
diff --git a/src/ZNC/Parser.hs b/src/ZNC/Parser.hs
index 1a31840..edea7c8 100644
--- a/src/ZNC/Parser.hs
+++ b/src/ZNC/Parser.hs
@@ -79,30 +79,41 @@ rawNumEvents :: RawEvents -> Int
 rawNumEvents (RawEvents _ nev _) = nev
 
 -- | This is a good list producer.
+{-# INLINE realiseEvents #-}
 realiseEvents :: RawEvents -> [(HMS, Event)]
 realiseEvents raw@(RawEvents _ nev _) = realiseEventsRange raw (0, nev)
 
 -- | This is a good list producer. Range is (inclusive, exclusive).
+{-# INLINE realiseEventsRange #-}
 realiseEventsRange :: RawEvents -> (Int, Int) -> [(HMS, Event)]
 realiseEventsRange (RawEvents bs _ ba#) (startidx, endidx) =
-    [deserialise i | i <- [startidx .. endidx - 1]]
+    [(deserialiseHMS i, deserialiseEvent i) | i <- [startidx .. endidx - 1]]
   where
-    deserialise :: Int -> (HMS, Event)
-    deserialise i =
-      (HMS (byte 0) (byte 1) (byte 2)
-      ,case byte 3 of
-         1 -> Join   (textfield 0) (textfield 1)
-         2 -> Part   (textfield 0) (textfield 1) (textfield 2)
-         3 -> Quit   (textfield 0) (textfield 1) (textfield 2)
-         4 -> ReNick (textfield 0) (textfield 1)
-         5 -> Talk   (textfield 0) (textfield 1)
-         6 -> Notice (textfield 0) (textfield 1)
-         7 -> Act    (textfield 0) (textfield 1)
-         8 -> Kick   (textfield 0) (textfield 1) (textfield 2)
-         9 -> Mode   (textfield 0) (textfield 1)
-         10 -> Topic  (textfield 0) (textfield 1)
-         _ {- includes 0 -} -> ParseError
-      )
+    -- These INLINE and NOINLINE are to ensure the produced list, as well as
+    -- the contained tuples, can get fused into the consumer, without bloating
+    -- up the consumer code.
+    {-# NOINLINE deserialiseHMS #-}
+    deserialiseHMS :: Int -> HMS
+    deserialiseHMS i = HMS (byte 0) (byte 1) (byte 2)
+      where
+        byte :: Int -> Word8
+        byte off = readWord8 (i * evRepSz + off)
+
+    {-# NOINLINE deserialiseEvent #-}
+    deserialiseEvent :: Int -> Event
+    deserialiseEvent i =
+      case byte 3 of
+        1 -> Join   (textfield 0) (textfield 1)
+        2 -> Part   (textfield 0) (textfield 1) (textfield 2)
+        3 -> Quit   (textfield 0) (textfield 1) (textfield 2)
+        4 -> ReNick (textfield 0) (textfield 1)
+        5 -> Talk   (textfield 0) (textfield 1)
+        6 -> Notice (textfield 0) (textfield 1)
+        7 -> Act    (textfield 0) (textfield 1)
+        8 -> Kick   (textfield 0) (textfield 1) (textfield 2)
+        9 -> Mode   (textfield 0) (textfield 1)
+        10 -> Topic (textfield 0) (textfield 1)
+        _ {- includes 0 -} -> ParseError
       where
         byte :: Int -> Word8
         byte off = readWord8 (i * evRepSz + off)