{-# 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.
{-# INLINE realiseEvents #-}
realiseEvents :: RawEvents -> [(HMS, Event)]
realiseEvents raw@(RawEvents _ nev _) = realiseEventsRange raw (0, nev)

-- | This is a good list producer. Range is (inclusive, exclusive).
{-# INLINE realiseEventsRange #-}
realiseEventsRange :: RawEvents -> (Int, Int) -> [(HMS, Event)]
realiseEventsRange (RawEvents bs _ ba#) (startidx, endidx) =
    [(deserialiseHMS i, deserialiseEvent i) | i <- [startidx .. endidx - 1]]
  where
    -- These INLINE and NOINLINE are to ensure the produced list, as well as
    -- the contained tuples, can get fused into the consumer, without bloating
    -- up the consumer code.
    {-# NOINLINE deserialiseHMS #-}
    deserialiseHMS :: Int -> HMS
    deserialiseHMS i = HMS (byte 0) (byte 1) (byte 2)
      where
        byte :: Int -> Word8
        byte off = readWord8 (i * evRepSz + off)

    {-# NOINLINE deserialiseEvent #-}
    deserialiseEvent :: Int -> Event
    deserialiseEvent i =
      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# #)