module Network.IRC.Fun.Client.Events
( Event (..)
, ChannelPrivacy (..)
, Privilege (..)
, detectEvents
, hGetIrcEventsOnce
, hGetIrcEventsOnce'
, hGetIrcEvents
, hGetIrcEvents'
)
where
import Control.Monad (unless)
import Data.Maybe (fromMaybe, isNothing)
import Network.IRC.Fun.Client.IO (Handle, hGetIrcOnce, hGetIrcOnce')
import Network.IRC.Fun.Messages
import Network.IRC.Fun.Messages.Types
data Event
= Ping String (Maybe String)
| Pong 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
| ChannelAction String String String
| PrivateMessage String String Bool
| PrivateAction String String
| 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
PongMessage s ms -> one $ Pong 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
PrivActionMessage (ChannelTarget chan) text ->
if null sender
then other
else one $ ChannelAction chan sender text
PrivActionMessage (UserTarget _ _ _) text ->
if null sender
then err
else one $ PrivateAction sender text
PrivActionMessage (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
hGetIrcEventsOnce' :: Handle -> IO (Either String [Event])
hGetIrcEventsOnce' h = do
res <- hGetIrcOnce' h
return $ case res of
Left s -> Left s
Right spec -> detectEvents spec
hGetIrcEvents :: Handle -> IO [Event]
hGetIrcEvents h = hGetIrcEventsOnce h >>= maybe (hGetIrcEvents h) return
hGetIrcEvents' :: Handle -> IO ([String], [Event])
hGetIrcEvents' h = do
(l, m) <- f []
return (reverse l, m)
where
f errs = do
res <- hGetIrcEventsOnce' h
case res of
Left s -> f $ s : errs
Right es -> return (errs, es)