1 files changed, 104 insertions, 0 deletions
diff --git a/src/ZNC.hs b/src/ZNC.hs
new file mode 100644
index 0000000..35eafe0
--- /dev/null
+++ b/src/ZNC.hs
@@ -0,0 +1,104 @@
+{-# LANGUAGE OverloadedStrings #-}
+module ZNC (
+  -- Log(..),
+  Nick, Event(..),
+  parseLog, parseLogRange,
+) 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.Text (Text)
+import Data.Text.Encoding qualified as TE
+-- import Data.Vector qualified as V
+-- import Data.Vector (Vector)
+import Data.Word (Word8)
+
+import Util
+
+
+-- newtype Log = Log (Vector (TOD, Event))
+--   deriving (Show)
+
+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)
+
+-- these INLINE/NOINLINE pragmas are optimisation without testing or profiling, have fun
+{-# INLINE parseLog #-}
+parseLog :: ByteString -> [(HMS, Event)]
+parseLog = parseLogRange (0, Nothing)
+
+-- (start line, number of lines (default to rest of file))
+{-# INLINE parseLogRange #-}
+parseLogRange :: (Int, Maybe Int) -> ByteString -> [(HMS, Event)]
+parseLogRange (startln, mnumln) =
+  -- Log . V.fromList .
+  map go . maybe id take mnumln . drop startln . BS8.lines
+  where
+    {-# NOINLINE go #-}
+    go = 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 '-'    <*> nick <*> remaining -- FIXME: parse host
+  , 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"
+    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)