hask-irc/Network/IRC/Protocol.hs

module Network.IRC.Protocol (MessageParser, msgFromLine, lineFromCommand) where

import ClassyPrelude
import Data.List ((!!))
import Data.Text (split, strip)

import Network.IRC.Types

type MessageParser = BotConfig -> UTCTime -> Text -> Message

msgFromLine :: MessageParser
msgFromLine (BotConfig { .. }) time line
  | "PING :" `isPrefixOf` line = Message time line $ PingMsg (drop 6 line)
  | otherwise = case command of
      "PONG"    -> Message time line $ PongMsg message
      "JOIN"    -> Message time line $ JoinMsg user
      "QUIT"    -> Message time line $ QuitMsg user quitMessage
      "PART"    -> Message time line $ PartMsg user message
      "KICK"    -> Message time line $ KickMsg user kicked kickReason
      "MODE"    -> if source == botNick
                     then Message time line $ ModeMsg Self target message []
                     else Message time line $ ModeMsg user target mode modeArgs
      "NICK"    -> Message time line $ NickMsg user (drop 1 target)
      "353"     -> Message time line $ NamesMsg namesNicks
      "433"     -> Message time line NickInUseMsg
      "PRIVMSG" | target /= channel -> Message time line $ PrivMsg user message
                | isActionMsg       -> Message time line $ ActionMsg user (initDef . drop 8 $ message)
                | otherwise         -> Message time line $ ChannelMsg user message
      _         -> Message time line $ OtherMsg source command target message
  where
    isSpc           = (== ' ')
    isNotSpc        = not . isSpc
    splits          = split isSpc line
    source          = drop 1 . takeWhile isNotSpc $ line
    target          = splits !! 2
    command         = splits !! 1
    message         = strip . drop 1 . unwords . drop 3 $ splits
    quitMessage     = strip . drop 1 . unwords . drop 2 $ splits
    user            = uncurry User . break (== '!') $ source
    mode            = splits !! 3
    modeArgs        = drop 4 splits
    kicked          = splits !! 3
    kickReason      = drop 1 . unwords . drop 4 $ splits

    nickPrefixes    = "~&@%+" :: String
    namesNicks      = map stripNickPrefix . words . drop 1 . unwords . drop 5 $ splits
    stripNickPrefix = pack . dropWhile (`elem` nickPrefixes) . unpack

    isActionMsg     = "\SOH" `isPrefixOf` message && "ACTION" `isPrefixOf` drop 1 message

lineFromCommand :: BotConfig -> Command -> Maybe Text
lineFromCommand BotConfig { .. } command = case command of
  PongCmd { .. }                  -> Just $ "PONG :" ++ rmsg
  PingCmd { .. }                  -> Just $ "PING :" ++ rmsg
  NickCmd                         -> Just $ "NICK " ++ botNick
  UserCmd                         -> Just $ "USER " ++ botNick ++ " 0 * :" ++ botNick
  JoinCmd                         -> Just $ "JOIN " ++ channel
  QuitCmd                         -> Just "QUIT"
  ChannelMsgReply { .. }          -> Just $ "PRIVMSG " ++ channel ++ " :" ++ rmsg
  PrivMsgReply (User { .. }) rmsg -> Just $ "PRIVMSG " ++ userNick ++ " :" ++ rmsg
  NamesCmd                        -> Just $ "NAMES " ++ channel
  _                               -> Nothing