C parsing work

1 files changed, 63 insertions, 21 deletions

diff --git a/src/ZNC2.hs b/src/ZNC2.hs
index 7a13f52..bcd4fb3 100644
--- a/src/ZNC2.hs
+++ b/src/ZNC2.hs
@@ -6,12 +6,10 @@ 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 Data.Text.Internal qualified as TI
+import Data.Text.Internal.Validate (isValidUtf8ByteArray)
 import Foreign.C.Types
 import Foreign.Ptr
 import GHC.Exts
@@ -24,27 +22,37 @@ import ZNC (Event(..))
 
 
 foreign import ccall unsafe "tirclogv_parse_znc_numevents"
+  --                       file buf     length      num events
   c_parse_znc_numevents :: Ptr CChar -> CSize -> IO CSize
 
 foreign import ccall unsafe "tirclogv_parse_znc"
+  --             events buffer                  file buf     length
   c_parse_znc :: MutableByteArray# RealWorld -> Ptr CChar -> CSize -> IO ()
 
+foreign import ccall unsafe "tirclogv_fix_utf8_length"
+  --                   byte buf      offset   length      length of fixed
+  c_fix_utf8_length :: ByteArray# -> CSize -> CSize -> IO CSize
 
--- For each event: (total 28 bytes)
+foreign import ccall unsafe "tirclogv_fix_utf8"
+  --            output buffer                  byte buf      offset   length
+  c_fix_utf8 :: MutableByteArray# RealWorld -> ByteArray# -> CSize -> CSize -> IO ()
+
+
+-- For each event: (total 22 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#
+-- * 2 bytes text length 1
+-- * 2 bytes text length 2
+-- * 2 bytes text length 3
+data Events = Events ByteArray#  -- pinned
 
 evRepSz :: Int
-evRepSz = 28
+evRepSz = 20
 
 parseLog :: ByteString -> [(HMS, Event)]
 parseLog bs =
@@ -53,23 +61,41 @@ parseLog bs =
   in [deserialise ba# i | i <- [0 .. nev-1]]
   where
     deserialise :: ByteArray# -> Int -> (HMS, Event)
-    deserialise ba# (I# i#) =
+    deserialise ba# i =
       (HMS (byte 0) (byte 1) (byte 2)
       ,case byte 3 of
-         0 -> Join (textfield 0) (textfield 1))
+         0 -> Join   (textfield 0) (textfield 1)
+         1 -> Part   (textfield 0) (textfield 1) (textfield 2)
+         2 -> Quit   (textfield 0) (textfield 1) (textfield 2)
+         3 -> ReNick (textfield 0) (textfield 1)
+         4 -> Talk   (textfield 0) (textfield 1)
+         5 -> Notice (textfield 0) (textfield 1)
+         6 -> Act    (textfield 0) (textfield 1)
+         7 -> Kick   (textfield 0) (textfield 1) (textfield 2)
+         8 -> Mode   (textfield 0) (textfield 1)
+         9 -> Topic  (textfield 0) (textfield 1)
+         _ {- includes 10 -} -> ParseError
+      )
       where
         byte :: Int -> Word8
-        byte (I# off#) = W8# (indexWord8Array# ba# (i# +# off#))
+        byte off = indexWord8Array ba# (i * evRepSz + 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 _
+        textfield n =
+          let offset = fromIntegral @Word32 @Int (indexWord8ArrayAsWord32 ba# (i * evRepSz + 4 + 4 * n))
+              len    = fromIntegral @Word16 @Int (indexWord8ArrayAsWord16 ba# (i * evRepSz + 16 + 2 * n))
+          in if isValidUtf8ByteArray (ByteArray ba#) offset len
+               then TI.Text (ByteArray ba#) offset len
+               else fixUtf8ByteArray ba# offset len
+
+    indexWord8ArrayAsWord32 :: ByteArray# -> Int -> Word32
+    indexWord8ArrayAsWord32 ba# (I# i#) = W32# (indexWord8ArrayAsWord32# ba# i#)
+
+    indexWord8ArrayAsWord16 :: ByteArray# -> Int -> Word16
+    indexWord8ArrayAsWord16 ba# (I# i#) = W16# (indexWord8ArrayAsWord16# ba# i#)
+
+    indexWord8Array :: ByteArray# -> Int -> Word8
+    indexWord8Array ba# (I# i#) = W8# (indexWord8Array# ba# i#)
 
 {-# NOINLINE parseLogToEvents #-}
 parseLogToEvents :: ByteString -> Events
@@ -85,3 +111,19 @@ parseLogToEvents bs = unsafePerformIO $
     c_parse_znc dst# bsptr bslenCS
     IO $ \s -> case unsafeFreezeByteArray# dst# s of
                  (# s', ba# #) -> (# s', Events ba# #)
+
+-- | Returns an unpinned byte array
+{-# NOINLINE fixUtf8ByteArray #-}
+fixUtf8ByteArray :: ByteArray# -> Int -> Int -> Text
+fixUtf8ByteArray input# offset len = unsafePerformIO $ do
+  let offCS = fromIntegral @Int @CSize offset
+      lenCS = fromIntegral @Int @CSize len
+  outlenCS <- c_fix_utf8_length input# offCS lenCS
+
+  let !outlen@(I# outlen#) = fromIntegral @CSize @Int outlenCS
+  MutableByteArray dst# <-
+    IO $ \s -> case newByteArray# outlen# s of
+                 (# s', mba# #) -> (# s', MutableByteArray mba# #)
+  c_fix_utf8 dst# input# offCS lenCS
+  IO $ \s -> case unsafeFreezeByteArray# dst# s of
+               (# s', ba# #) -> (# s', TI.Text (ByteArray ba#) 0 outlen #)