blob: 7a13f52c30dc45d2e7a76597ffae3846c7736fbc (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
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# #)
|
