Events.hs

{- This file is part of irc-fun-client.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ 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
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

-- | 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