summaryrefslogtreecommitdiff
path: root/src/ZNC2.hs
diff options
context:
space:
mode:
authorTom Smeding <tom@tomsmeding.com>2026-07-26 21:47:21 +0200
committerTom Smeding <tom@tomsmeding.com>2026-07-26 21:47:21 +0200
commit9082745e03a06b5471aa23b7a84bb2c4d8b4f304 (patch)
tree0a7e8c1c585b9bf8e349c83b869cbbf5b210317f /src/ZNC2.hs
parent839fd82f9fada8d6a981917c12430427c15edce5 (diff)
Debug and optimise C znc parser
Diffstat (limited to 'src/ZNC2.hs')
-rw-r--r--src/ZNC2.hs129
1 files changed, 0 insertions, 129 deletions
diff --git a/src/ZNC2.hs b/src/ZNC2.hs
deleted file mode 100644
index bcd4fb3..0000000
--- a/src/ZNC2.hs
+++ /dev/null
@@ -1,129 +0,0 @@
-{-# LANGUAGE BangPatterns #-}
-{-# LANGUAGE MagicHash #-}
-{-# LANGUAGE UnboxedTuples #-}
-{-# LANGUAGE UnliftedFFITypes #-}
-module ZNC2 where
-
-import Data.Array.Byte
-import Data.ByteString (ByteString)
-import Data.ByteString.Unsafe qualified as BS
-import Data.Text (Text)
-import Data.Text.Internal qualified as TI
-import Data.Text.Internal.Validate (isValidUtf8ByteArray)
-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"
- -- 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
-
-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 pointer 2
--- * 4 bytes text pointer 3
--- * 2 bytes text length 1
--- * 2 bytes text length 2
--- * 2 bytes text length 3
-data Events = Events ByteArray# -- pinned
-
-evRepSz :: Int
-evRepSz = 20
-
-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 =
- (HMS (byte 0) (byte 1) (byte 2)
- ,case byte 3 of
- 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 off = indexWord8Array ba# (i * evRepSz + off)
-
- textfield :: Int -> Text
- 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
-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# #)
-
--- | 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 #)