2014-06-08 07:12:33 +05:30
|
|
|
{-# LANGUAGE DeriveDataTypeable #-}
|
|
|
|
{-# LANGUAGE ExistentialQuantification #-}
|
|
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
|
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
|
|
|
{-# LANGUAGE RankNTypes #-}
|
|
|
|
{-# LANGUAGE TemplateHaskell #-}
|
2014-10-04 21:22:24 +05:30
|
|
|
{-# OPTIONS_HADDOCK hide #-}
|
2014-06-08 07:12:33 +05:30
|
|
|
|
2014-10-04 21:22:24 +05:30
|
|
|
module Network.IRC.Message.Types where
|
2014-06-08 07:12:33 +05:30
|
|
|
|
|
|
|
import ClassyPrelude
|
2014-10-04 21:22:24 +05:30
|
|
|
import Data.Data (Data)
|
|
|
|
import Data.SafeCopy (base, deriveSafeCopy)
|
|
|
|
import Data.Typeable (cast)
|
2014-06-08 07:12:33 +05:30
|
|
|
|
|
|
|
-- | 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
|
2014-10-05 14:48:47 +05:30
|
|
|
{ userNick :: !Nick -- ^ The user's nick.
|
2014-06-08 07:12:33 +05:30
|
|
|
, userServer :: !Text -- ^ The user's server.
|
|
|
|
} deriving (Show, Eq, Ord)
|
|
|
|
|
2014-10-13 11:21:08 +05:30
|
|
|
-- | An message sent from the server to the bot or from the bot to the server
|
|
|
|
-- or from a handler to another handler.
|
2014-10-04 21:22:24 +05:30
|
|
|
data Message = Message
|
2015-06-21 19:44:39 +05:30
|
|
|
{ msgTime :: !UTCTime -- ^ The time when the message was received/sent.
|
|
|
|
, msgLine :: !Text -- ^ The raw message.
|
2015-06-21 18:18:59 +05:30
|
|
|
, message :: !MessageW -- ^ The details of the parsed message.
|
2014-06-08 07:12:33 +05:30
|
|
|
} deriving (Show, Eq)
|
|
|
|
|
2014-10-13 11:21:08 +05:30
|
|
|
-- | The typeclass for different types of messages.
|
2014-06-08 07:12:33 +05:30
|
|
|
class (Typeable msg, Show msg, Eq msg, Ord msg) => MessageC msg where
|
2014-10-04 21:22:24 +05:30
|
|
|
toMessage :: msg -> MessageW
|
2015-06-22 15:21:18 +05:30
|
|
|
toMessage !msg = MessageW msg
|
2014-06-08 07:12:33 +05:30
|
|
|
|
2014-10-04 21:22:24 +05:30
|
|
|
fromMessage :: MessageW -> Maybe msg
|
|
|
|
fromMessage (MessageW msg) = cast msg
|
2014-06-08 07:12:33 +05:30
|
|
|
|
2014-10-13 11:21:08 +05:30
|
|
|
-- | A wrapper over all types of messages.
|
2015-06-22 15:21:18 +05:30
|
|
|
data MessageW = forall m . MessageC m => MessageW m deriving (Typeable)
|
2014-06-08 07:12:33 +05:30
|
|
|
|
2014-10-04 21:22:24 +05:30
|
|
|
instance Show MessageW where
|
|
|
|
show (MessageW m) = show m
|
2014-06-08 07:12:33 +05:30
|
|
|
|
2014-10-04 21:22:24 +05:30
|
|
|
instance Eq MessageW where
|
|
|
|
MessageW m1 == MessageW m2 = case cast m1 of
|
2014-06-08 07:12:33 +05:30
|
|
|
Just m1' -> m1' == m2
|
|
|
|
_ -> False
|
|
|
|
|
2015-06-21 19:44:39 +05:30
|
|
|
-- | Creates a new message with the current time and the given message details.
|
2014-10-13 11:21:08 +05:30
|
|
|
newMessage :: (MessageC msg, MonadIO m)
|
|
|
|
=> msg -- ^ Message details
|
|
|
|
-> m Message
|
2014-10-04 21:22:24 +05:30
|
|
|
newMessage msg = do
|
|
|
|
t <- liftIO getCurrentTime
|
|
|
|
return $ Message t "" (toMessage msg)
|
|
|
|
|
2014-06-08 07:12:33 +05:30
|
|
|
-- | The internal (non-IRC) message received when the bot is idle.
|
2015-06-21 15:14:32 +05:30
|
|
|
data IdleMsg = IdleMsg deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC IdleMsg
|
|
|
|
|
|
|
|
-- | The message received when the bot's current nick is already in use.
|
2015-06-21 15:14:32 +05:30
|
|
|
data NickInUseMsg = NickInUseMsg deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC NickInUseMsg
|
|
|
|
|
|
|
|
-- | A /PING/ message. Must be replied with a 'PongCmd'.
|
2015-06-21 15:14:32 +05:30
|
|
|
data PingMsg = PingMsg !Text deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC PingMsg
|
|
|
|
|
|
|
|
-- | A /PONG/ message. Received in response to a 'PingCmd'.
|
2015-06-21 15:14:32 +05:30
|
|
|
data PongMsg = PongMsg !Text deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC PongMsg
|
|
|
|
|
|
|
|
-- | A /NAMES/ message which contains a list of nicks of all users in the channel.
|
2015-06-21 15:14:32 +05:30
|
|
|
data NamesMsg = NamesMsg ![Nick] deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC NamesMsg
|
|
|
|
|
|
|
|
-- | A /PRIVMSG/ message sent to the channel from a user.
|
2015-06-21 15:14:32 +05:30
|
|
|
data ChannelMsg = ChannelMsg !User !Text deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC ChannelMsg
|
|
|
|
|
|
|
|
-- | A /PRIVMSG/ private message sent to the bot from a user.
|
2015-06-21 15:14:32 +05:30
|
|
|
data PrivMsg = PrivMsg !User !Text deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC PrivMsg
|
|
|
|
|
|
|
|
-- | An /PRIVMSG/ action message sent to the channel from a user.
|
2015-06-21 15:14:32 +05:30
|
|
|
data ActionMsg = ActionMsg !User !Text deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC ActionMsg
|
|
|
|
|
|
|
|
-- | A /JOIN/ message received when a user joins the channel.
|
2015-06-21 15:14:32 +05:30
|
|
|
data JoinMsg = JoinMsg !User deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC JoinMsg
|
|
|
|
|
|
|
|
-- | A /QUIT/ message received when a user quits the server.
|
2015-06-21 15:14:32 +05:30
|
|
|
data QuitMsg = QuitMsg !User !Text deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC QuitMsg
|
|
|
|
|
|
|
|
-- | A /PART/ message received when a user leaves the channel.
|
2015-06-21 15:14:32 +05:30
|
|
|
data PartMsg = PartMsg !User !Text deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC PartMsg
|
|
|
|
|
|
|
|
-- | A /NICK/ message received when a user changes their nick.
|
2015-06-21 15:14:32 +05:30
|
|
|
data NickMsg = NickMsg !User !Nick deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC NickMsg
|
|
|
|
|
|
|
|
-- | A /KICK/ message received when a user kicks another user from the channel.
|
2015-06-21 15:14:32 +05:30
|
|
|
data KickMsg = KickMsg { kickUser :: !User, kickedNick :: !Nick, kickMsg :: !Text }
|
2014-06-08 07:12:33 +05:30
|
|
|
deriving (Typeable, Show, Eq, Ord)
|
|
|
|
instance MessageC KickMsg
|
|
|
|
|
|
|
|
-- | A /MODE/ message received when a user's mode changes.
|
2015-06-21 18:18:59 +05:30
|
|
|
data ModeMsg = ModeMsg { modeUser :: !User
|
|
|
|
, modeTarget :: !Text
|
|
|
|
, mode :: !Text
|
|
|
|
, modeArgs :: ![Text]
|
|
|
|
} deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC ModeMsg
|
|
|
|
|
2015-06-21 19:44:39 +05:30
|
|
|
-- | A message received as a response to a 'WhoisCmd'.
|
2015-06-21 15:14:32 +05:30
|
|
|
data WhoisReplyMsg = WhoisNoSuchNick { whoisNick :: !Nick }
|
|
|
|
| WhoisReplyMsg {
|
|
|
|
whoisNick :: !Nick
|
|
|
|
, whoisUser :: !Text
|
|
|
|
, whoisHost :: !Text
|
|
|
|
, whoisRealName :: !Text
|
|
|
|
, whoisChannels :: ![Text]
|
|
|
|
, whoisServer :: !Text
|
|
|
|
, whoisServerInfo :: !Text
|
|
|
|
} deriving (Typeable, Show, Eq, Ord)
|
|
|
|
instance MessageC WhoisReplyMsg
|
|
|
|
|
2015-06-21 19:44:39 +05:30
|
|
|
-- | All other messages which are not parsed as any of the above message types.
|
2015-06-21 18:18:59 +05:30
|
|
|
data OtherMsg = OtherMsg { msgSource :: !Text
|
|
|
|
, msgCommand :: !Text
|
|
|
|
, msgTarget :: !Text
|
|
|
|
, msg :: !Text
|
|
|
|
} deriving (Typeable, Show, Eq, Ord)
|
2014-06-08 07:12:33 +05:30
|
|
|
instance MessageC OtherMsg
|
2014-10-04 21:22:24 +05:30
|
|
|
|
|
|
|
|
|
|
|
-- | 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
|
2015-06-21 15:14:32 +05:30
|
|
|
|
2015-06-21 19:44:39 +05:30
|
|
|
-- | A /WHOIS/ command sent to ask for the status of a user nick.
|
|
|
|
data WhoisCmd = WhoisCmd !Text deriving (Typeable, Show, Eq, Ord)
|
2015-06-21 15:14:32 +05:30
|
|
|
instance MessageC WhoisCmd
|