1 files changed, 87 insertions, 0 deletions
diff --git a/src/ZNC2.hs b/src/ZNC2.hs
new file mode 100644
index 0000000..7a13f52
--- /dev/null
+++ b/src/ZNC2.hs
@@ -0,0 +1,87 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+{-# LANGUAGE UnliftedFFITypes #-}
+module ZNC2 where
+
+import Data.Array.Byte
+import Data.ByteString (ByteString)
+import Data.ByteString qualified as BS
+import Data.ByteString.Short qualified as BSS
+import Data.ByteString.Unsafe qualified as BS
+import Data.Text (Text)
+import Data.Text qualified as T
+import Data.Text.Encoding qualified as TE
+import Foreign.C.Types
+import Foreign.Ptr
+import GHC.Exts
+import GHC.IO (IO(IO))
+import GHC.Word
+import System.IO.Unsafe (unsafePerformIO)
+
+import Util
+import ZNC (Event(..))
+
+
+foreign import ccall unsafe "tirclogv_parse_znc_numevents"
+  c_parse_znc_numevents :: Ptr CChar -> CSize -> IO CSize
+
+foreign import ccall unsafe "tirclogv_parse_znc"
+  c_parse_znc :: MutableByteArray# RealWorld -> Ptr CChar -> CSize -> IO ()
+
+
+-- For each event: (total 28 bytes)
+-- * 1 byte hour
+-- * 1 byte minute
+-- * 1 byte second
+-- * 1 byte event kind
+-- * 4 bytes text pointer 1
+-- * 4 bytes text length 1
+-- * 4 bytes text pointer 2
+-- * 4 bytes text length 2
+-- * 4 bytes text pointer 3
+-- * 4 bytes text length 3
+data Events = Events ByteArray#
+
+evRepSz :: Int
+evRepSz = 28
+
+parseLog :: ByteString -> [(HMS, Event)]
+parseLog bs =
+  let !(Events ba#) = parseLogToEvents bs
+      nev = I# (sizeofByteArray# ba#) `quot` evRepSz
+  in [deserialise ba# i | i <- [0 .. nev-1]]
+  where
+    deserialise :: ByteArray# -> Int -> (HMS, Event)
+    deserialise ba# (I# i#) =
+      (HMS (byte 0) (byte 1) (byte 2)
+      ,case byte 3 of
+         0 -> Join (textfield 0) (textfield 1))
+      where
+        byte :: Int -> Word8
+        byte (I# off#) = W8# (indexWord8Array# ba# (i# +# off#))
+
+        textfield :: Int -> Text
+        textfield (I# n#) =
+          let offset = W32# (indexWord32Array# ba# (i# +# 1# +# (2# *# n#)))
+              len    = W32# (indexWord32Array# ba# (i# +# 2# +# (2# *# n#)))
+              -- slice = BS.unsafePackCStringLen  -- safe because it's pinned
+              --           (Ptr (byteArrayContents# ba#) `plusPtr` fromIntegral @Word32 @Int offset
+              --           ,fromIntegral @Word32 @Int len)
+          in if BSS.isValidUtf8 (BSS.ShortByteString (ByteArray ba#))
+                 then _ else _
+
+{-# NOINLINE parseLogToEvents #-}
+parseLogToEvents :: ByteString -> Events
+parseLogToEvents bs = unsafePerformIO $
+  BS.unsafeUseAsCStringLen bs $ \(bsptr, bslen) -> do
+    let bslenCS = fromIntegral @Int @CSize bslen
+    numev <- c_parse_znc_numevents bsptr bslenCS
+    let !(I# numbytes#) = fromIntegral @CSize @Int numev * evRepSz
+
+    MutableByteArray dst# <-
+      IO $ \s -> case newPinnedByteArray# numbytes# s of
+                   (# s', mba# #) -> (# s', MutableByteArray mba# #)
+    c_parse_znc dst# bsptr bslenCS
+    IO $ \s -> case unsafeFreezeByteArray# dst# s of
+                 (# s', ba# #) -> (# s', Events ba# #)