A simple IRC bot written in Haskell
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

Types.hs 7.1KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190
  1. {-# LANGUAGE DeriveDataTypeable #-}
  2. {-# LANGUAGE ExistentialQuantification #-}
  3. {-# LANGUAGE FlexibleContexts #-}
  4. {-# LANGUAGE MultiParamTypeClasses #-}
  5. {-# LANGUAGE RankNTypes #-}
  6. {-# LANGUAGE TemplateHaskell #-}
  7. {-# OPTIONS_HADDOCK hide #-}
  8. module Network.IRC.Message.Types where
  9. import ClassyPrelude
  10. import Data.Data (Data)
  11. import Data.SafeCopy (base, deriveSafeCopy)
  12. import Data.Typeable (cast)
  13. -- | An IRC nick.
  14. newtype Nick = Nick { nickToText :: Text }
  15. deriving (Eq, Ord, Data, Typeable, Hashable)
  16. instance Show Nick where
  17. show = unpack . nickToText
  18. $(deriveSafeCopy 0 'base ''Nick)
  19. -- | An IRC user.
  20. data User
  21. -- | The user for the bot itself.
  22. = Self
  23. -- | An user other than the bot.
  24. | User
  25. { userNick :: !Nick -- ^ The user's nick.
  26. , userServer :: !Text -- ^ The user's server.
  27. } deriving (Show, Eq, Ord)
  28. -- | An message sent from the server to the bot or from the bot to the server
  29. -- or from a handler to another handler.
  30. data Message = Message
  31. { msgTime :: !UTCTime -- ^ The time when the message was received/sent.
  32. , msgLine :: !Text -- ^ The raw message.
  33. , message :: !MessageW -- ^ The details of the parsed message.
  34. } deriving (Show, Eq)
  35. -- | The typeclass for different types of messages.
  36. class (Typeable msg, Show msg, Eq msg, Ord msg) => MessageC msg where
  37. toMessage :: msg -> MessageW
  38. toMessage !msg = MessageW msg
  39. fromMessage :: MessageW -> Maybe msg
  40. fromMessage (MessageW msg) = cast msg
  41. -- | A wrapper over all types of messages.
  42. data MessageW = forall m . MessageC m => MessageW m deriving (Typeable)
  43. instance Show MessageW where
  44. show (MessageW m) = show m
  45. instance Eq MessageW where
  46. MessageW m1 == MessageW m2 = case cast m1 of
  47. Just m1' -> m1' == m2
  48. _ -> False
  49. -- | Creates a new message with the current time and the given message details.
  50. newMessage :: (MessageC msg, MonadIO m)
  51. => msg -- ^ Message details
  52. -> m Message
  53. newMessage msg = do
  54. t <- liftIO getCurrentTime
  55. return $ Message t "" (toMessage msg)
  56. -- | The internal (non-IRC) message received when the bot is idle.
  57. data IdleMsg = IdleMsg deriving (Typeable, Show, Eq, Ord)
  58. instance MessageC IdleMsg
  59. -- | The message received when the bot's current nick is already in use.
  60. data NickInUseMsg = NickInUseMsg deriving (Typeable, Show, Eq, Ord)
  61. instance MessageC NickInUseMsg
  62. -- | A /PING/ message. Must be replied with a 'PongCmd'.
  63. data PingMsg = PingMsg !Text deriving (Typeable, Show, Eq, Ord)
  64. instance MessageC PingMsg
  65. -- | A /PONG/ message. Received in response to a 'PingCmd'.
  66. data PongMsg = PongMsg !Text deriving (Typeable, Show, Eq, Ord)
  67. instance MessageC PongMsg
  68. -- | A /NAMES/ message which contains a list of nicks of all users in the channel.
  69. data NamesMsg = NamesMsg ![Nick] deriving (Typeable, Show, Eq, Ord)
  70. instance MessageC NamesMsg
  71. -- | A /PRIVMSG/ message sent to the channel from a user.
  72. data ChannelMsg = ChannelMsg !User !Text deriving (Typeable, Show, Eq, Ord)
  73. instance MessageC ChannelMsg
  74. -- | A /PRIVMSG/ private message sent to the bot from a user.
  75. data PrivMsg = PrivMsg !User !Text deriving (Typeable, Show, Eq, Ord)
  76. instance MessageC PrivMsg
  77. -- | An /PRIVMSG/ action message sent to the channel from a user.
  78. data ActionMsg = ActionMsg !User !Text deriving (Typeable, Show, Eq, Ord)
  79. instance MessageC ActionMsg
  80. -- | A /JOIN/ message received when a user joins the channel.
  81. data JoinMsg = JoinMsg !User deriving (Typeable, Show, Eq, Ord)
  82. instance MessageC JoinMsg
  83. -- | A /QUIT/ message received when a user quits the server.
  84. data QuitMsg = QuitMsg !User !Text deriving (Typeable, Show, Eq, Ord)
  85. instance MessageC QuitMsg
  86. -- | A /PART/ message received when a user leaves the channel.
  87. data PartMsg = PartMsg !User !Text deriving (Typeable, Show, Eq, Ord)
  88. instance MessageC PartMsg
  89. -- | A /NICK/ message received when a user changes their nick.
  90. data NickMsg = NickMsg !User !Nick deriving (Typeable, Show, Eq, Ord)
  91. instance MessageC NickMsg
  92. -- | A /KICK/ message received when a user kicks another user from the channel.
  93. data KickMsg = KickMsg { kickUser :: !User, kickedNick :: !Nick, kickMsg :: !Text }
  94. deriving (Typeable, Show, Eq, Ord)
  95. instance MessageC KickMsg
  96. -- | A /MODE/ message received when a user's mode changes.
  97. data ModeMsg = ModeMsg { modeUser :: !User
  98. , modeTarget :: !Text
  99. , mode :: !Text
  100. , modeArgs :: ![Text]
  101. } deriving (Typeable, Show, Eq, Ord)
  102. instance MessageC ModeMsg
  103. -- | A message received as a response to a 'WhoisCmd'.
  104. data WhoisReplyMsg = WhoisNoSuchNickMsg { whoisNick :: !Nick }
  105. | WhoisNickInfoMsg { whoisNick :: !Nick
  106. , whoisUser :: !Text
  107. , whoisHost :: !Text
  108. , whoisRealName :: !Text
  109. , whoisChannels :: ![Text]
  110. , whoisServer :: !Text
  111. , whoisServerInfo :: !Text
  112. } deriving (Typeable, Show, Eq, Ord)
  113. instance MessageC WhoisReplyMsg
  114. -- | All other messages which are not parsed as any of the above message types.
  115. data OtherMsg = OtherMsg { msgSource :: !Text
  116. , msgCommand :: !Text
  117. , msgTarget :: !Text
  118. , msg :: !Text
  119. } deriving (Typeable, Show, Eq, Ord)
  120. instance MessageC OtherMsg
  121. -- | A /PING/ command. A 'PongMsg' is expected as a response to this.
  122. data PingCmd = PingCmd !Text deriving (Typeable, Show, Eq, Ord)
  123. instance MessageC PingCmd
  124. -- | A /PONG/ command. Sent in response to a 'PingMsg'.
  125. data PongCmd = PongCmd !Text deriving (Typeable, Show, Eq, Ord)
  126. instance MessageC PongCmd
  127. -- | A /PRIVMSG/ message sent to the channel.
  128. data ChannelMsgReply = ChannelMsgReply !Text deriving (Typeable, Show, Eq, Ord)
  129. instance MessageC ChannelMsgReply
  130. -- | A /PRIVMSG/ message sent to a user.
  131. data PrivMsgReply = PrivMsgReply !User !Text deriving (Typeable, Show, Eq, Ord)
  132. instance MessageC PrivMsgReply
  133. -- | A /NICK/ command sent to set the bot's nick.
  134. data NickCmd = NickCmd deriving (Typeable, Show, Eq, Ord)
  135. instance MessageC NickCmd
  136. -- | A /USER/ command sent to identify the bot.
  137. data UserCmd = UserCmd deriving (Typeable, Show, Eq, Ord)
  138. instance MessageC UserCmd
  139. -- | A /JOIN/ command sent to join the channel.
  140. data JoinCmd = JoinCmd deriving (Typeable, Show, Eq, Ord)
  141. instance MessageC JoinCmd
  142. -- | A /QUIT/ command sent to quit the server.
  143. data QuitCmd = QuitCmd deriving (Typeable, Show, Eq, Ord)
  144. instance MessageC QuitCmd
  145. -- | A /NAMES/ command sent to ask for the nicks of the users in the channel.
  146. data NamesCmd = NamesCmd deriving (Typeable, Show, Eq, Ord)
  147. instance MessageC NamesCmd
  148. -- | A /WHOIS/ command sent to ask for the status of a user nick.
  149. data WhoisCmd = WhoisCmd !Text deriving (Typeable, Show, Eq, Ord)
  150. instance MessageC WhoisCmd