hask-irc/hask-irc-core/Network/IRC/Message/Types.hs

{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE ExistentialQuantification #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_HADDOCK hide #-}

module Network.IRC.Message.Types where

import ClassyPrelude
import Data.Data     (Data)
import Data.SafeCopy (base, deriveSafeCopy)
import Data.Typeable (cast)

-- | An IRC nick.
newtype Nick = Nick { nickToText :: Text }
               deriving (Eq, Ord, Data, Typeable, Hashable)

instance Show Nick where
  show = unpack . nickToText

$(deriveSafeCopy 0 'base ''Nick)

-- | An IRC user.
data User
  -- | The user for the bot itself.
  = Self
  -- | An user other than the bot.
  | User
  { userNick   :: !Nick       -- ^ The user's nick.
  , userServer :: !Text       -- ^ The user's server.
  } deriving (Show, Eq, Ord)

-- | An message sent from the server to the bot or from the bot to the server
-- or from a handler to another handler.
data Message = Message
  { msgTime :: !UTCTime   -- ^ The time when the message was received/sent.
  , msgLine :: !Text      -- ^ The raw message.
  , message :: !MessageW  -- ^ The details of the parsed message.
  } deriving (Show, Eq)

-- | The typeclass for different types of messages.
class (Typeable msg, Show msg, Eq msg, Ord msg) => MessageC msg where
  toMessage :: msg -> MessageW
  toMessage !msg = MessageW msg

  fromMessage :: MessageW -> Maybe msg
  fromMessage (MessageW msg) = cast msg

-- | A wrapper over all types of messages.
data MessageW = forall m . MessageC m => MessageW m deriving (Typeable)

instance Show MessageW where
  show (MessageW m) = show m

instance Eq MessageW where
  MessageW m1 == MessageW m2 = case cast m1 of
    Just m1' -> m1' == m2
    _        -> False

-- | Creates a new message with the current time and the given message details.
newMessage :: (MessageC msg, MonadIO m)
           => msg        -- ^ Message details
           -> m Message
newMessage msg = do
  t <- liftIO getCurrentTime
  return $ Message t "" (toMessage msg)

-- | The internal (non-IRC) message received when the bot is idle.
data IdleMsg       = IdleMsg deriving (Typeable, Show, Eq, Ord)
instance MessageC IdleMsg

-- | The message received when the bot's current nick is already in use.
data NickInUseMsg  = NickInUseMsg deriving (Typeable, Show, Eq, Ord)
instance MessageC NickInUseMsg

-- | A /PING/ message. Must be replied with a 'PongCmd'.
data PingMsg       = PingMsg !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PingMsg

-- | A /PONG/ message. Received in response to a 'PingCmd'.
data PongMsg       = PongMsg !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PongMsg

-- | A /NAMES/ message which contains a list of nicks of all users in the channel.
data NamesMsg      = NamesMsg ![Nick] deriving (Typeable, Show, Eq, Ord)
instance MessageC NamesMsg

-- | A /PRIVMSG/ message sent to the channel from a user.
data ChannelMsg    = ChannelMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ChannelMsg

-- | A /PRIVMSG/ private message sent to the bot from a user.
data PrivMsg       = PrivMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PrivMsg

-- | An /PRIVMSG/ action message sent to the channel from a user.
data ActionMsg     = ActionMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ActionMsg

-- | A /JOIN/ message received when a user joins the channel.
data JoinMsg       = JoinMsg !User deriving (Typeable, Show, Eq, Ord)
instance MessageC JoinMsg

-- | A /QUIT/ message received when a user quits the server.
data QuitMsg       = QuitMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC QuitMsg

-- | A /PART/ message received when a user leaves the channel.
data PartMsg       = PartMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PartMsg

-- | A /NICK/ message received when a user changes their nick.
data NickMsg       = NickMsg !User !Nick deriving (Typeable, Show, Eq, Ord)
instance MessageC NickMsg

-- | A /KICK/ message received when a user kicks another user from the channel.
data KickMsg       = KickMsg { kickUser :: !User, kickedNick :: !Nick, kickMsg :: !Text }
                    deriving (Typeable, Show, Eq, Ord)
instance MessageC KickMsg

-- | A /MODE/ message received when a user's mode changes.
data ModeMsg       = ModeMsg { modeUser   :: !User
                             , modeTarget :: !Text
                             , mode       :: !Text
                             , modeArgs   :: ![Text]
                             } deriving (Typeable, Show, Eq, Ord)
instance MessageC ModeMsg

-- | A message received as a response to a 'WhoisCmd'.
data WhoisReplyMsg = WhoisNoSuchNickMsg { whoisNick :: !Nick }
                   | WhoisNickInfoMsg { whoisNick        :: !Nick
                                      , whoisUser        :: !Text
                                      , whoisHost        :: !Text
                                      , whoisRealName    :: !Text
                                      , whoisChannels    :: ![Text]
                                      , whoisServer      :: !Text
                                      , whoisServerInfo  :: !Text
                                      } deriving (Typeable, Show, Eq, Ord)
instance MessageC WhoisReplyMsg

-- | All other messages which are not parsed as any of the above message types.
data OtherMsg      = OtherMsg { msgSource  :: !Text
                              , msgCommand :: !Text
                              , msgTarget  :: !Text
                              , msg        :: !Text
                              } deriving (Typeable, Show, Eq, Ord)
instance MessageC OtherMsg


-- | A /PING/ command. A 'PongMsg' is expected as a response to this.
data PingCmd         = PingCmd !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PingCmd

-- | A /PONG/ command. Sent in response to a 'PingMsg'.
data PongCmd         = PongCmd !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PongCmd

-- | A /PRIVMSG/ message sent to the channel.
data ChannelMsgReply = ChannelMsgReply !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ChannelMsgReply

-- | A /PRIVMSG/ message sent to a user.
data PrivMsgReply    = PrivMsgReply !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PrivMsgReply

-- | A /NICK/ command sent to set the bot's nick.
data NickCmd         = NickCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC NickCmd

-- | A /USER/ command sent to identify the bot.
data UserCmd         = UserCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC UserCmd

-- | A /JOIN/ command sent to join the channel.
data JoinCmd         = JoinCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC JoinCmd

-- | A /QUIT/ command sent to quit the server.
data QuitCmd         = QuitCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC QuitCmd

-- | A /NAMES/ command sent to ask for the nicks of the users in the channel.
data NamesCmd        = NamesCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC NamesCmd

-- | A /WHOIS/ command sent to ask for the status of a user nick.
data WhoisCmd        = WhoisCmd !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC WhoisCmd