{- This file is part of irc-fun-client. - - Written in 2015 by fr33domlover . - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - . -} -- | This module allows you to identify IRC events. Events are a wrapper around -- IRC messages, which provide a logical layer convenient to work with (while -- IRC messages have their lower level aspects, being plain protocol messages). module Network.IRC.Fun.Client.Events ( Event (..) , ChannelPrivacy (..) , Privilege (..) , detectEvents , hGetIrcEventsOnce , hGetIrcEvents ) where import Control.Monad (unless) import Data.Maybe (fromMaybe, isNothing) import Network.IRC.Fun.Client.IO (Handle, hGetIrcOnce) import Network.IRC.Fun.Messages import Network.IRC.Fun.Messages.Types -- | An event triggered by an IRC message sent from the server. data Event -- | A ping was sent to the bot. The parameters are the server name and -- optionally a server to forward the response to. They can be passed as-is -- directly to the PONG response. = Ping String (Maybe String) -- | One or more users have been kicked from a channel for an optionally -- given reason. Parameters: Channel, nicknames, reason. | Kick String [String] (Maybe String) -- | A user joined a channel. Parameters: Channel, nickname. | Join String String -- | A user left a channel, optionally with a given reason. Parameters: -- Channel, nickname, reason. | Part String String (Maybe String) -- | A user left the network, optonally for the given reason. Parameters: -- Nickname, reason. | Quit String (Maybe String) -- | TODO | Mode -- | Message sent in a channel by a user. The last parameter indicates -- whether the message is actually a notice. If yes, the client shouldn't -- automatically send a response. Parameters: Channel, nickname, message, -- whether notice. | ChannelMessage String String String Bool -- | A private message sent specifically to the client from a user. The -- last parameter indicates whether the message is actually a notice. If -- yes, the client shouldn't send any automatic response. Parameters: -- Nickname, message, whether notice. | PrivateMessage String String Bool -- | A user's nickname has changed. Parameters: Old nick, new nick. | NickChange String String -- | Channel topic change. Parameterss: Channel, nickname of user who -- changed the topic, new topic content. | Topic String String String -- | The client has been invited to a channel by another user. Parameters: -- Channel, nickname of inviting user. | Invite String String -- | The server sent a list of nicknames present in a channel. Parameters: -- Channel privacy mode, channel name, list of users. Each list item is a -- pair of a user privilege level in the channel, and the user's nickname. | Names ChannelPrivacy String [(Privilege, String)] -- Unrecognized or unimplemented event. The parameter contains (possibly -- empty) input. | OtherEvent String deriving Show detectMessageEvents :: SpecificMessage -> Either String [Event] detectMessageEvents sm@(SpecificMessage mpref msg) = case msg of NickMessage newnick -> if null sender then err else one $ NickChange sender newnick QuitMessage reason -> if null sender then err else one $ Quit sender reason JoinMessage (Just ([chan], [])) -> if null sender then err else one $ Join chan sender JoinMessage _ -> err PartMessage [chan] reason -> if null sender then err else one $ Part chan sender reason PartMessage _ _ -> err TopicMessage [] _ -> err TopicMessage chan topic -> if null sender then other else one $ Topic chan sender $ fromMaybe "" topic PingMessage s ms -> one $ Ping s ms KickMessage [] _ _ -> err KickMessage _ [] _ -> err KickMessage [chan] nicks comment -> one $ Kick chan nicks comment KickMessage chans nicks comment -> if length chans == length nicks then some $ map (\ (c, n) -> Kick c [n] comment) $ zip chans nicks else err PrivMsgMessage _ [] -> other PrivMsgMessage (ChannelTarget chan) text -> if null sender then other else one $ ChannelMessage chan sender text False PrivMsgMessage (UserTarget _ _ _) text -> if null sender then err else one $ PrivateMessage sender text False PrivMsgMessage (MaskTarget _) _ -> other _ -> other where other = Right [OtherEvent $ show sm] one e = Right [e] some = Right err = Left $ show sm sender = case mpref of Just (Nick n _ _) -> n Nothing -> "" detectReplyEvents :: SpecificReply -> Either String [Event] detectReplyEvents sr@(SpecificReply _sender _target rpl) = case rpl of NamesReply priv chan pnicks -> one $ Names priv chan pnicks _ -> other where other = Right [OtherEvent $ show sr] one e = Right [e] err = Left $ show sr -- | Try to generate events from an IRC message. If it fails, 'Left' an error -- message is returned. Otherwise, 'Right' a list of generated events is -- returned. detectEvents :: Either SpecificReply SpecificMessage -> Either String [Event] detectEvents = either detectReplyEvents detectMessageEvents -- | Receive IRC events. If parsing and detecting the events fails, 'Nothing' -- is returned. hGetIrcEventsOnce :: Handle -> IO (Maybe [Event]) hGetIrcEventsOnce h = hGetIrcOnce h >>= return . \ r -> case r of Nothing -> Nothing Just spec -> either (const Nothing) Just $ detectEvents spec -- | Receive the next valid (successfully parsed and detected) series of IRC -- events. hGetIrcEvents :: Handle -> IO [Event] hGetIrcEvents h = hGetIrcEventsOnce h >>= maybe (hGetIrcEvents h) return