diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/ZNC2.hs | 84 |
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 #) |