diff options
Diffstat (limited to 'src/ZNC/Parser.hs')
| -rw-r--r-- | src/ZNC/Parser.hs | 139 |
1 files changed, 139 insertions, 0 deletions
diff --git a/src/ZNC/Parser.hs b/src/ZNC/Parser.hs new file mode 100644 index 0000000..1a31840 --- /dev/null +++ b/src/ZNC/Parser.hs @@ -0,0 +1,139 @@ +{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +{-# LANGUAGE UnliftedFFITypes #-} +module ZNC.Parser ( + Nick, Event(..), + parseLog, + RawEvents, rawNumEvents, realiseEvents, realiseEventsRange, parseLogRaw, +) where + +import Data.Array.Byte +import Data.ByteString (ByteString) +import Data.ByteString qualified as BS +import Data.ByteString.Unsafe qualified as BSU +import Data.Text (Text) +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 + + +foreign import ccall unsafe "tirclogv_count_lines" + -- file buf length num events + c_count_lines :: Ptr CChar -> CSize -> IO CSize + +foreign import ccall unsafe "tirclogv_parse_znc" + -- events buffer evbufsz file buf length actual num events + c_parse_znc :: MutableByteArray# RealWorld -> CSize -> Ptr CChar -> CSize -> IO CSize + + +type Nick = Text + +-- Adapted from clogparse by Keegan McAllister (BSD3) (https://hackage.haskell.org/package/clogparse). +data Event + = Join Nick Text -- ^ User joined. + | Part Nick Text Text -- ^ User left the channel. (address, reason) + | Quit Nick Text Text -- ^ User quit the server. (address, reason) + | ReNick Nick Nick -- ^ User changed from one to another nick. + | Talk Nick Text -- ^ User spoke (@PRIVMSG@). + | Notice Nick Text -- ^ User spoke (@NOTICE@). + | Act Nick Text -- ^ User acted (@CTCP ACTION@). + | Kick Nick Nick Text -- ^ User was kicked by user. (kicked, kicker, reason) + | Mode Nick Text -- ^ User set mode on the channel. + | Topic Nick Text -- ^ Topic change. + | ParseError + | Compressed Text -- ^ Fake event generated when compressing multiple meta events in "Index" + deriving (Show) + + +-- For each event: (`struct event` on the C sode; 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 +evRepSz :: Int +evRepSz = 22 + +-- | Retains the original ByteString. +data RawEvents = RawEvents + ByteString -- original data parsed + Int -- actual number of events (may be smaller than allocated capacity in ByteArray#) + ByteArray# -- parsed array of `struct event`; pinned + +parseLog :: ByteString -> [(HMS, Event)] +parseLog = realiseEvents . parseLogRaw + +rawNumEvents :: RawEvents -> Int +rawNumEvents (RawEvents _ nev _) = nev + +-- | This is a good list producer. +realiseEvents :: RawEvents -> [(HMS, Event)] +realiseEvents raw@(RawEvents _ nev _) = realiseEventsRange raw (0, nev) + +-- | This is a good list producer. Range is (inclusive, exclusive). +realiseEventsRange :: RawEvents -> (Int, Int) -> [(HMS, Event)] +realiseEventsRange (RawEvents bs _ ba#) (startidx, endidx) = + [deserialise 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 + ) + where + byte :: Int -> Word8 + byte off = readWord8 (i * evRepSz + off) + + textfield :: Int -> Text + textfield n = + let offset = fromIntegral @Word32 @Int (readWord32 (i * evRepSz + 4 + 4 * n)) + len = fromIntegral @Word16 @Int (readWord16 (i * evRepSz + 16 + 2 * n)) + in TE.decodeUtf8Lenient (BS.take len (BS.drop offset bs)) + + readWord32 :: Int -> Word32 + readWord32 (I# i#) = W32# (indexWord8ArrayAsWord32# ba# i#) + + readWord16 :: Int -> Word16 + readWord16 (I# i#) = W16# (indexWord8ArrayAsWord16# ba# i#) + + readWord8 :: Int -> Word8 + readWord8 (I# i#) = W8# (indexWord8Array# ba# i#) + +-- | The 'ByteString' is retained inside the 'RawEvents'. +{-# NOINLINE parseLogRaw #-} +parseLogRaw :: ByteString -> RawEvents +parseLogRaw bs = unsafePerformIO $ + BSU.unsafeUseAsCStringLen bs $ \(bsptr, bslen) -> do + let bslenCS = fromIntegral @Int @CSize bslen + numev <- c_count_lines bsptr bslenCS + let !(I# numbytes#) = fromIntegral @CSize @Int numev * evRepSz + + MutableByteArray dst# <- + IO $ \s -> case newPinnedByteArray# numbytes# s of + (# s', mba# #) -> (# s', MutableByteArray mba# #) + realnumev <- c_parse_znc dst# numev bsptr bslenCS + IO $ \s -> case unsafeFreezeByteArray# dst# s of + (# s', ba# #) -> (# s', RawEvents bs (fromIntegral @CSize @Int realnumev) ba# #) |