hask-irc/Network/IRC/Protocol.hs

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

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

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

import Network.IRC.Types

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