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
data Event
= Ping String (Maybe String)
| Kick String [String] (Maybe String)
| Join String String
| Part String String (Maybe String)
| Quit String (Maybe String)
| Mode
| ChannelMessage String String String Bool
| PrivateMessage String String Bool
| NickChange String String
| Topic String String String
| Invite String String
| Names ChannelPrivacy String [(Privilege, String)]
| 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
detectEvents :: Either SpecificReply SpecificMessage
-> Either String [Event]
detectEvents = either detectReplyEvents detectMessageEvents
hGetIrcEventsOnce :: Handle -> IO (Maybe [Event])
hGetIrcEventsOnce h =
hGetIrcOnce h >>= return . \ r ->
case r of
Nothing -> Nothing
Just spec -> either (const Nothing) Just $ detectEvents spec
hGetIrcEvents :: Handle -> IO [Event]
hGetIrcEvents h = hGetIrcEventsOnce h >>= maybe (hGetIrcEvents h) return