{-# LANGUAGE OverloadedStrings #-}
module ZNC (
  -- Log(..),
  Nick, Event(..),
  preparseLog,
  parseLog, parseLogRange,
  parseLogTimesOnly,
) where

import Control.Applicative
import Data.Attoparsec.ByteString.Char8 qualified as P
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Char8 qualified as BS8
import Data.Char (ord)
import Data.Either (fromRight)
import Data.Maybe (fromMaybe)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.Encoding qualified as TE
import Data.Vector.Storable qualified as VS
import Data.Word (Word8, Word32)

import Util


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
  deriving (Show)

-- | Returned vector has one entry for each line in the file, excepting the
-- empty "line" after the final newline, if any.
preparseLog :: ByteString -> VS.Vector Word32
preparseLog = VS.fromList . findLineStarts 0
  where
    findLineStarts :: Int -> ByteString -> [Word32]
    findLineStarts off bs =
      case BS.findIndex (== 10) (BS.drop off bs) of
        Nothing | BS.length bs == off -> []
                | otherwise -> [fromIntegral off]
        Just i -> fromIntegral off : findLineStarts (off + i + 1) bs

-- these INLINE/NOINLINE pragmas are optimisation without testing or profiling, have fun
{-# INLINE parseLog #-}
parseLog :: ByteString -> [(HMS, Event)]
parseLog = map parseLogLine . BS8.lines

{-# INLINE parseLogTimesOnly #-}
parseLogTimesOnly :: VS.Vector Word32 -> ByteString -> [HMS]
parseLogTimesOnly linestarts bs =
  map (fromRight (HMS 0 0 0) . P.parseOnly parseTOD) $
    splitWithLineStarts 0 linestarts bs

-- (start line, number of lines (default to rest of file))
{-# INLINE parseLogRange #-}
parseLogRange :: (Int, Maybe Int) -> VS.Vector Word32 -> ByteString -> [(HMS, Event)]
parseLogRange (startln, mnumln) linestarts topbs =
  let numln = fromMaybe (VS.length linestarts - startln) mnumln
      splitted = splitWithLineStarts 0 (VS.slice startln numln linestarts) topbs
  in -- traceShow ("pLR"::String, splitted) $
     map parseLogLine splitted

{-# INLINE splitWithLineStarts #-}
splitWithLineStarts :: Int -> VS.Vector Word32 -> ByteString -> [ByteString]
splitWithLineStarts idx starts bs
  | idx >= VS.length starts = []
  | idx == VS.length starts - 1 =
      [BS.takeWhile (\b -> b /= 13 && b /= 10) (BS.drop (at idx) bs)]
  | otherwise =
      trimCR (BS.drop (at idx) (BS.take (at (idx + 1) - 1) bs))
      : splitWithLineStarts (idx + 1) starts bs
  where
    at i = fromIntegral @Word32 @Int (starts VS.! i)

    trimCR :: ByteString -> ByteString
    trimCR b = case BS.unsnoc b of
                 Just (b', c) | c == 13 -> b'
                 _ -> b

{-# NOINLINE parseLogLine #-}
parseLogLine :: ByteString -> (HMS, Event)
parseLogLine = fromRight (HMS 0 0 0, ParseError) . P.parseOnly parseLine

parseLine :: P.Parser (HMS, Event)
parseLine = (,) <$> parseTOD <*> parseEvent

parseTOD :: P.Parser HMS
parseTOD = do
  _ <- P.char '['
  tod <- HMS <$> pTwoDigs <*> (P.char ':' >> pTwoDigs) <*> (P.char ':' >> pTwoDigs)
  _ <- P.string "] "
  return tod

-- Adapted from clogparse by Keegan McAllister (BSD3) (https://hackage.haskell.org/package/clogparse).
parseEvent :: P.Parser Event
parseEvent = asum
  [ P.string "*** " *> asum
    [ userAct Join  "Joins: "
    , userAct' Part "Parts: "
    , userAct' Quit "Quits: "
    , ReNick <$> nick <*> (P.string " is now known as " *> nick)
    , Mode   <$> nick <*> (P.string " sets mode: " *> remaining)
    , Kick <$> (nick <* P.string " was kicked by ") <*> nick <* P.char ' ' <*> encloseTail '(' ')'
    , Topic <$> (nick <* P.string " changes topic to ") <*> encloseTail '\'' '\''
    ]
  , Talk   <$ P.char '<'    <*> nick <*  P.string "> " <*> remaining
  , Notice <$ P.char '-'    <*> (stripFinalDash =<< nick) <*> (P.char ' ' *> remaining)
  , Act    <$ P.string "* " <*> nick <*  P.char ' '  <*> remaining
  ] where
    nick = utf8 <$> P.takeWhile (not . P.inClass " \n\r\t\v<>")
    userAct f x = f <$ P.string x <*> nick <* P.char ' ' <*> parens
    userAct' f x = f <$ P.string x <*> nick <* P.char ' ' <*> parens <* P.char ' ' <*> encloseTail '(' ')'
    parens = P.char '(' >> (utf8 <$> P.takeWhile (/= ')')) <* P.char ')'
    encloseTail c1 c2 = do _ <- P.char c1
                           bs <- P.takeByteString
                           case BS.unsnoc bs of
                             Just (s, c) | c == fromIntegral (ord c2) -> return (utf8 s)
                             _ -> fail "Wrong end char"
    stripFinalDash n = case T.unsnoc n of
                         Just (n', '-') -> return n'
                         _ -> empty
    utf8 = TE.decodeUtf8Lenient
    remaining = utf8 <$> P.takeByteString

pTwoDigs :: P.Parser Word8
pTwoDigs = do
  let digit = do
        c <- P.satisfy (\c -> '0' <= c && c <= '9')
        return (fromIntegral (ord c - ord '0'))
  c1 <- digit
  c2 <- digit
  return (10 * c1 + c2)