parent
5d49e4e201
commit
e61cab74ed
@ -0,0 +1,67 @@ |
||||
{-# LANGUAGE DeriveDataTypeable #-} |
||||
{-# LANGUAGE ExistentialQuantification #-} |
||||
{-# LANGUAGE FlexibleContexts #-} |
||||
{-# LANGUAGE MultiParamTypeClasses #-} |
||||
{-# LANGUAGE RankNTypes #-} |
||||
|
||||
module Network.IRC.Internal.Command.Types where |
||||
|
||||
import ClassyPrelude |
||||
import Data.Typeable (cast) |
||||
|
||||
import Network.IRC.Internal.Message.Types |
||||
|
||||
-- | The typeclass for IRC commands sent from the bot to the server. |
||||
class (Typeable cmd, Show cmd, Eq cmd, Ord cmd) => CommandC cmd where |
||||
toCommand :: cmd -> Command |
||||
toCommand = Command |
||||
|
||||
fromCommand :: Command -> Maybe cmd |
||||
fromCommand (Command cmd) = cast cmd |
||||
|
||||
-- | A wrapper over all types of IRC commands. |
||||
data Command = forall m . CommandC m => Command m deriving (Typeable) |
||||
|
||||
instance Show Command where |
||||
show (Command m) = show m |
||||
|
||||
instance Eq Command where |
||||
Command m1 == Command m2 = case cast m1 of |
||||
Just m1' -> m1' == m2 |
||||
_ -> False |
||||
|
||||
-- | A /PING/ command. A 'PongMsg' is expected as a response to this. |
||||
data PingCmd = PingCmd !Text deriving (Typeable, Show, Eq, Ord) |
||||
instance CommandC PingCmd |
||||
|
||||
-- | A /PONG/ command. Sent in response to a 'PingMsg'. |
||||
data PongCmd = PongCmd !Text deriving (Typeable, Show, Eq, Ord) |
||||
instance CommandC PongCmd |
||||
|
||||
-- | A /PRIVMSG/ message sent to the channel. |
||||
data ChannelMsgReply = ChannelMsgReply !Text deriving (Typeable, Show, Eq, Ord) |
||||
instance CommandC ChannelMsgReply |
||||
|
||||
-- | A /PRIVMSG/ message sent to a user. |
||||
data PrivMsgReply = PrivMsgReply !User !Text deriving (Typeable, Show, Eq, Ord) |
||||
instance CommandC PrivMsgReply |
||||
|
||||
-- | A /NICK/ command sent to set the bot's nick. |
||||
data NickCmd = NickCmd deriving (Typeable, Show, Eq, Ord) |
||||
instance CommandC NickCmd |
||||
|
||||
-- | A /USER/ command sent to identify the bot. |
||||
data UserCmd = UserCmd deriving (Typeable, Show, Eq, Ord) |
||||
instance CommandC UserCmd |
||||
|
||||
-- | A /JOIN/ command sent to join the channel. |
||||
data JoinCmd = JoinCmd deriving (Typeable, Show, Eq, Ord) |
||||
instance CommandC JoinCmd |
||||
|
||||
-- | A /QUIT/ command sent to quit the server. |
||||
data QuitCmd = QuitCmd deriving (Typeable, Show, Eq, Ord) |
||||
instance CommandC 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 CommandC NamesCmd |
@ -0,0 +1,57 @@ |
||||
{-# LANGUAGE DeriveDataTypeable #-} |
||||
{-# LANGUAGE ExistentialQuantification #-} |
||||
{-# LANGUAGE FlexibleContexts #-} |
||||
{-# LANGUAGE MultiParamTypeClasses #-} |
||||
{-# LANGUAGE RankNTypes #-} |
||||
|
||||
module Network.IRC.Internal.Event.Types where |
||||
|
||||
import ClassyPrelude |
||||
import Data.Typeable (cast) |
||||
|
||||
import Network.IRC.Internal.Message.Types |
||||
import Network.IRC.Internal.Command.Types |
||||
|
||||
-- ** Events |
||||
|
||||
-- | Events are used for communication between message handlers. To send events, write them to the |
||||
-- event channel provided to the 'MsgHandler' when it is created. To receive events, provide |
||||
-- an 'onEvent' function as a part of the message handler. |
||||
class (Typeable e, Show e, Eq e) => EventC e where |
||||
-- | Creates an event. |
||||
toEvent :: e -> IO Event |
||||
toEvent e = Event <$> pure e <*> getCurrentTime |
||||
|
||||
-- | Extracts a received event. |
||||
fromEvent :: Event -> Maybe (e, UTCTime) |
||||
fromEvent (Event e time) = do |
||||
ev <- cast e |
||||
return (ev, time) |
||||
|
||||
-- | A wrapper over all types of 'Event's to allow sending them over channel of same type. |
||||
data Event = forall e. (EventC e, Typeable e) => Event e UTCTime deriving (Typeable) |
||||
|
||||
instance Show Event where |
||||
show (Event e time) = formatTime defaultTimeLocale "[%F %T] " time ++ show e |
||||
|
||||
instance Eq Event where |
||||
Event e1 t1 == Event e2 t2 = |
||||
case cast e2 of |
||||
Just e2' -> e1 == e2' && t1 == t2 |
||||
Nothing -> False |
||||
|
||||
-- | Response to an event received by a message handler. |
||||
data EventResponse = |
||||
-- | No response |
||||
RespNothing |
||||
-- | Events as the response. They will be sent to all message handlers like usual events. |
||||
| RespEvent [Event] |
||||
-- | Messages as the response. They will be sent to all message handlers like usual messages. |
||||
| RespMessage [FullMessage] |
||||
-- | Commands as the response. They will be sent to the server like usual commands. |
||||
| RespCommand [Command] |
||||
deriving (Show, Eq) |
||||
|
||||
-- | An event signifying the bot quitting the server. |
||||
data QuitEvent = QuitEvent deriving (Show, Eq, Ord, Typeable) |
||||
instance EventC QuitEvent |
@ -0,0 +1,123 @@ |
||||
{-# LANGUAGE DeriveDataTypeable #-} |
||||
{-# LANGUAGE ExistentialQuantification #-} |
||||
{-# LANGUAGE FlexibleContexts #-} |
||||
{-# LANGUAGE MultiParamTypeClasses #-} |
||||
{-# LANGUAGE RankNTypes #-} |
||||
{-# LANGUAGE TemplateHaskell #-} |
||||
|
||||
module Network.IRC.Internal.Message.Types where |
||||
|
||||
import ClassyPrelude |
||||
import Data.Data (Data) |
||||
import Data.SafeCopy (base, deriveSafeCopy) |
||||
import Data.Typeable (cast) |
||||
|
||||
-- ** IRC Message |
||||
|
||||
-- | 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 IRC message sent from the server to the bot. |
||||
data FullMessage = FullMessage |
||||
{ msgTime :: !UTCTime -- ^ The time when the message was received. |
||||
, msgLine :: !Text -- ^ The raw message line. |
||||
, message :: Message -- ^ The details of the parsed message. |
||||
} deriving (Show, Eq) |
||||
|
||||
-- | The typeclass for different types of IRC messages. |
||||
class (Typeable msg, Show msg, Eq msg, Ord msg) => MessageC msg where |
||||
toMessage :: msg -> Message |
||||
toMessage = Message |
||||
|
||||
fromMessage :: Message -> Maybe msg |
||||
fromMessage (Message msg) = cast msg |
||||
|
||||
-- | A wrapper over all types of IRC messages. |
||||
data Message = forall m . MessageC m => Message m deriving (Typeable) |
||||
|
||||
instance Show Message where |
||||
show (Message m) = show m |
||||
|
||||
instance Eq Message where |
||||
Message m1 == Message m2 = case cast m1 of |
||||
Just m1' -> m1' == m2 |
||||
_ -> False |
||||
|
||||
-- | 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 |
||||
|
||||
-- | All other messages which are not parsed as any of the above types. |
||||
data OtherMsg = OtherMsg { msgSource :: !Text, msgCommand :: !Text, msgTarget :: !Text , msg :: !Text } |
||||
deriving (Typeable, Show, Eq, Ord) |
||||
instance MessageC OtherMsg |
Loading…
Reference in new issue