module Network.IRC.Message.Types where
import ClassyPrelude
import Data.Data (Data)
import Data.SafeCopy (base, deriveSafeCopy)
import Data.Typeable (cast)
newtype Nick = Nick { nickToText :: Text }
deriving (Eq, Ord, Data, Typeable, Hashable)
instance Show Nick where
show = unpack . nickToText
$(deriveSafeCopy 0 'base ''Nick)
data User
= Self
| User
{ userNick :: !Nick
, userServer :: !Text
} deriving (Show, Eq, Ord)
data Message = Message
{ msgTime :: !UTCTime
, msgLine :: !Text
, message :: !MessageW
} deriving (Show, Eq)
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
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
newMessage :: (MessageC msg, MonadIO m)
=> msg
-> m Message
newMessage msg = do
t <- liftIO getCurrentTime
return $ Message t "" (toMessage msg)
data IdleMsg = IdleMsg deriving (Typeable, Show, Eq, Ord)
instance MessageC IdleMsg
data NickInUseMsg = NickInUseMsg deriving (Typeable, Show, Eq, Ord)
instance MessageC NickInUseMsg
data PingMsg = PingMsg !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PingMsg
data PongMsg = PongMsg !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PongMsg
data NamesMsg = NamesMsg ![Nick] deriving (Typeable, Show, Eq, Ord)
instance MessageC NamesMsg
data ChannelMsg = ChannelMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ChannelMsg
data PrivMsg = PrivMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PrivMsg
data ActionMsg = ActionMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ActionMsg
data JoinMsg = JoinMsg !User deriving (Typeable, Show, Eq, Ord)
instance MessageC JoinMsg
data QuitMsg = QuitMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC QuitMsg
data PartMsg = PartMsg !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PartMsg
data NickMsg = NickMsg !User !Nick deriving (Typeable, Show, Eq, Ord)
instance MessageC NickMsg
data KickMsg = KickMsg { kickUser :: !User, kickedNick :: !Nick, kickMsg :: !Text }
deriving (Typeable, Show, Eq, Ord)
instance MessageC KickMsg
data ModeMsg = ModeMsg { modeUser :: !User
, modeTarget :: !Text
, mode :: !Text
, modeArgs :: ![Text]
} deriving (Typeable, Show, Eq, Ord)
instance MessageC ModeMsg
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
data OtherMsg = OtherMsg { msgSource :: !Text
, msgCommand :: !Text
, msgTarget :: !Text
, msg :: !Text
} deriving (Typeable, Show, Eq, Ord)
instance MessageC OtherMsg
data PingCmd = PingCmd !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PingCmd
data PongCmd = PongCmd !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PongCmd
data ChannelMsgReply = ChannelMsgReply !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC ChannelMsgReply
data PrivMsgReply = PrivMsgReply !User !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC PrivMsgReply
data NickCmd = NickCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC NickCmd
data UserCmd = UserCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC UserCmd
data JoinCmd = JoinCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC JoinCmd
data QuitCmd = QuitCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC QuitCmd
data NamesCmd = NamesCmd deriving (Typeable, Show, Eq, Ord)
instance MessageC NamesCmd
data WhoisCmd = WhoisCmd !Text deriving (Typeable, Show, Eq, Ord)
instance MessageC WhoisCmd