module Network.IRC.Fun.Bot.Internal.Event
( matchPrefixedCommandC
, matchPrefixedCommandP
, matchPrefixedCommand
, matchRefCommandC
, matchRefCommandP
, matchRefCommand
, matchRefCommandFromSetC
, matchRefCommandFromSetP
, matchRefCommandFromSet
, matchRefCommandFromNamesC
, matchRefCommandFromNamesP
, matchRefCommandFromNames
, matchPlainPrivateCommand
, matchNoticeC
, matchNoticeP
, matchNotice
, matchRefC
, matchRefP
, matchRef
, defaultMatch
, matchEvent
, handleEvent
)
where
import Control.Monad (when)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.RWS
import Data.Char (isSpace)
import qualified Data.HashMap.Lazy as M
import Data.Maybe (catMaybes, fromMaybe, maybeToList)
import Data.List (stripPrefix)
import Network.IRC.Fun.Bot.Internal.Chat (pong)
import Network.IRC.Fun.Bot.Internal.Failure (defaultRespondToChan)
import Network.IRC.Fun.Bot.Internal.Nicks
import Network.IRC.Fun.Bot.Internal.State (askBehavior, askBehaviorS)
import Network.IRC.Fun.Bot.Internal.Types hiding (Logger)
import Network.IRC.Fun.Bot.Behavior (findCmd, findCmdInSet)
import Network.IRC.Fun.Client.ChannelLogger hiding (LogEvent (..))
import qualified Network.IRC.Fun.Client.ChannelLogger as L
import qualified Network.IRC.Fun.Client.Events as C (Event (..))
import Network.IRC.Fun.Client.IO (nick)
import Network.IRC.Fun.Client.Util (mentions)
detectRef :: Config -> String -> Maybe String
detectRef conf msg =
let bnick = nick (connection conf)
dw = Just . dropWhile isSpace
in case stripPrefix bnick msg of
Nothing -> Nothing
Just (',' : s) -> dw s
Just (':' : s) -> dw s
Just (';' : s) -> dw s
Just (c : s) -> if isSpace c then dw s else Nothing
Just s -> dw s
mkCmd :: String -> (String, [String])
mkCmd message =
let w = words message
name = if null w then "" else head w
args = if null w then [] else tail w
in (name, args)
makePrefixedCommand :: [CommandSet e s]
-> MessageSource
-> Char
-> String
-> Maybe Event
makePrefixedCommand csets src pref msg =
if pref `elem` map prefix csets
then
let (name, args) = mkCmd msg
in Just $ BotCommand src (Just pref) name args
else Nothing
makeRefCommand :: Config
-> MessageSource
-> String
-> Maybe Event
makeRefCommand conf src msg =
case detectRef conf msg of
Just s ->
let (name, args) = mkCmd s
in Just $ BotCommand src Nothing name args
Nothing -> Nothing
makeRefCommandFromSet :: Config
-> CommandSet e s
-> MessageSource
-> String
-> Maybe Event
makeRefCommandFromSet conf cset =
makeRefCommandFromNames conf (concatMap names $ commands cset)
makeRefCommandFromNames :: Config
-> [String]
-> MessageSource
-> String
-> Maybe Event
makeRefCommandFromNames conf names src msg =
case detectRef conf msg of
Just s ->
let (name, args) = mkCmd s
in if name `elem` names
then Just $ BotCommand src Nothing name args
else Nothing
Nothing -> Nothing
makePlainCommand :: MessageSource
-> String
-> Maybe Event
makePlainCommand src msg =
let (name, args) = mkCmd msg
in Just $ BotCommand src Nothing name args
makeRefC :: Config -> String -> String -> String -> Maybe Event
makeRefC conf chan nick msg =
case detectRef conf msg of
Just s -> Just $ BotMessage chan nick s
Nothing -> Nothing
makeRefP :: Config -> String -> String -> Maybe Event
makeRefP conf nick msg =
case detectRef conf msg of
Just s -> Just $ PersonalMessage nick s
Nothing -> Nothing
matchPrefixedCommandC :: EventMatcher e s
matchPrefixedCommandC event _conf csets =
case event of
C.ChannelMessage chan nick (c:cs) False ->
makePrefixedCommand csets (Channel chan nick) c cs
_ -> Nothing
matchPrefixedCommandP :: EventMatcher e s
matchPrefixedCommandP event _conf csets =
case event of
C.PrivateMessage nick (c:cs) False ->
makePrefixedCommand csets (User nick) c cs
_ -> Nothing
matchPrefixedCommand :: EventMatcher e s
matchPrefixedCommand event _conf csets =
case event of
C.ChannelMessage chan nick (c:cs) False ->
makePrefixedCommand csets (Channel chan nick) c cs
C.PrivateMessage nick (c:cs) False ->
makePrefixedCommand csets (User nick) c cs
_ -> Nothing
matchRefCommandC :: EventMatcher e s
matchRefCommandC event conf _csets =
case event of
C.ChannelMessage chan nick msg False ->
makeRefCommand conf (Channel chan nick) msg
_ -> Nothing
matchRefCommandP :: EventMatcher e s
matchRefCommandP event conf _csets =
case event of
C.PrivateMessage nick msg False ->
makeRefCommand conf (User nick) msg
_ -> Nothing
matchRefCommand :: EventMatcher e s
matchRefCommand event conf _csets =
case event of
C.ChannelMessage chan nick msg False ->
makeRefCommand conf (Channel chan nick) msg
C.PrivateMessage nick msg False ->
makeRefCommand conf (User nick) msg
_ -> Nothing
matchRefCommandFromSetC :: EventMatcher e s
matchRefCommandFromSetC _ _ [] = Nothing
matchRefCommandFromSetC event conf (cset:_) =
case event of
C.ChannelMessage chan nick msg False ->
makeRefCommandFromSet conf cset (Channel chan nick) msg
_ -> Nothing
matchRefCommandFromSetP :: EventMatcher e s
matchRefCommandFromSetP _ _ [] = Nothing
matchRefCommandFromSetP event conf (cset:_) =
case event of
C.PrivateMessage nick msg False ->
makeRefCommandFromSet conf cset (User nick) msg
_ -> Nothing
matchRefCommandFromSet :: EventMatcher e s
matchRefCommandFromSet _ _ [] = Nothing
matchRefCommandFromSet event conf (cset:_) =
case event of
C.ChannelMessage chan nick msg False ->
makeRefCommandFromSet conf cset (Channel chan nick) msg
C.PrivateMessage nick msg False ->
makeRefCommandFromSet conf cset (User nick) msg
_ -> Nothing
matchRefCommandFromNamesC :: [String] -> EventMatcher e s
matchRefCommandFromNamesC names event conf _csets =
case event of
C.ChannelMessage chan nick msg False ->
makeRefCommandFromNames conf names (Channel chan nick) msg
_ -> Nothing
matchRefCommandFromNamesP :: [String] -> EventMatcher e s
matchRefCommandFromNamesP names event conf _csets =
case event of
C.PrivateMessage nick msg False ->
makeRefCommandFromNames conf names (User nick) msg
_ -> Nothing
matchRefCommandFromNames :: [String] -> EventMatcher e s
matchRefCommandFromNames names event conf _csets =
case event of
C.ChannelMessage chan nick msg False ->
makeRefCommandFromNames conf names (Channel chan nick) msg
C.PrivateMessage nick msg False ->
makeRefCommandFromNames conf names (User nick) msg
_ -> Nothing
matchPlainPrivateCommand :: EventMatcher e s
matchPlainPrivateCommand event _conf _csets =
case event of
C.PrivateMessage nick msg False ->
makePlainCommand (User nick) msg
_ -> Nothing
matchNoticeC :: EventMatcher e s
matchNoticeC event _conf _csets =
case event of
C.ChannelMessage chan nick msg True ->
Just $ Notice (Just chan) nick msg
_ -> Nothing
matchNoticeP :: EventMatcher e s
matchNoticeP event _conf _csets =
case event of
C.PrivateMessage nick msg True ->
Just $ Notice Nothing nick msg
_ -> Nothing
matchNotice :: EventMatcher e s
matchNotice event _conf _csets =
case event of
C.ChannelMessage chan nick msg True ->
Just $ Notice (Just chan) nick msg
C.PrivateMessage nick msg True ->
Just $ Notice Nothing nick msg
_ -> Nothing
matchRefC :: EventMatcher e s
matchRefC event conf _csets =
case event of
C.ChannelMessage chan nick msg False -> makeRefC conf chan nick msg
_ -> Nothing
matchRefP :: EventMatcher e s
matchRefP event conf _csets =
case event of
C.PrivateMessage nick msg False -> makeRefP conf nick msg
_ -> Nothing
matchRef :: EventMatcher e s
matchRef event conf _csets =
case event of
C.ChannelMessage chan nick msg False -> makeRefC conf chan nick msg
C.PrivateMessage nick msg False -> makeRefP conf nick msg
_ -> Nothing
defaultMatch :: EventMatcher e s
defaultMatch event conf csets =
case event of
C.Ping server1 server2 -> Just $ Ping server1 server2
C.Kick channel nicks reason -> Just $ Kick channel nicks reason
C.Join channel nick -> Just $ Join channel nick
C.Part channel nick reason -> Just $ Part channel nick reason
C.Quit nick reason -> Just $ Quit nick reason
C.ChannelMessage channel nick msg False ->
Just $ Message channel nick msg $ msg `mentions` bnick
C.PrivateMessage nick msg False -> Just $ PersonalMessage nick msg
C.Topic channel nick topic -> Just $ TopicChange channel nick topic
C.Names priv chan pnicks -> Just $ Names chan priv pnicks
_ -> Nothing
where
bnick = nick (connection conf)
combineMatchers :: [EventMatcher e s] -> EventMatcher e s
combineMatchers [] _event _conf _csets = Nothing
combineMatchers (m:ms) event conf csets =
case m event conf csets of
ev@(Just _) -> ev
Nothing -> combineMatchers ms event conf csets
applyMatchers :: [EventMatcher e s]
-> C.Event
-> Config
-> [CommandSet e s]
-> Event
applyMatchers ms event conf csets =
fromMaybe (OtherEvent $ show event) $ combineMatchers ms event conf csets
matchEvent :: [EventMatcher e s]
-> C.Event
-> Config
-> [CommandSet e s]
-> Event
matchEvent = applyMatchers
findCommand :: Maybe Char
-> String
-> [CommandSet e s]
-> Maybe (Either (CommandSet e s) (Command e s))
findCommand (Just cpref) cname csets = findCmd cpref cname csets
findCommand Nothing _ [] = Nothing
findCommand Nothing cname (cset:_) =
Just $ maybe (Left cset) Right $ findCmdInSet cname cset
runCommand :: Maybe Char
-> String
-> [String]
-> String
-> String
-> Session e s ()
runCommand cpref cname cparams channel sender = do
csets <- askBehaviorS commandSets
case findCommand cpref cname csets of
Nothing ->
defaultRespondToChan channel cpref cname Nothing
Just (Left cset) ->
defaultRespondToChan channel (Just $ prefix cset) cname (Just cset)
Just (Right cmd) ->
respond cmd channel sender cparams
handleBotEvent :: Event -> Session e s ()
handleBotEvent event = do
b <- askBehavior
case event of
Ping s1 s2 -> pong s1 s2
Kick chan users why -> return ()
Join chan nick -> do
tracked <- channelIsTracked chan
when tracked $ addMember chan nick
handleJoin b chan nick
Part chan nick why -> do
tracked <- channelIsTracked chan
when tracked $ removeMemberOnce chan nick
handlePart b chan nick why
Quit nick why -> do
removeMember nick
handleQuit b nick why
Message chan sender msg mentioned ->
handleMsg b chan sender msg mentioned
Notice mchan sender msg -> return ()
BotMessage chan sender msg -> handleBotMsg b chan sender msg
BotCommand (Channel chan sender) cpref cname cargs ->
runCommand cpref cname cargs chan sender
BotCommand _ _ _ _ -> return ()
PersonalMessage sender msg -> handlePersonalMsg b sender msg
TopicChange chan nick topic -> handleTopicChange b chan nick topic
Names chan priv pnicks -> do
tracked <- channelIsTracked chan
let nicks = map snd pnicks
when tracked $ addChannel chan nicks
handleNames b chan priv pnicks
OtherEvent s -> return ()
detectLogEvents :: L.LogEvent -> Session e s [(Logger, ChanLogEvent)]
detectLogEvents e =
let detect event cstate = fmap (\ cl -> (cl, event)) $ chanLogger cstate
detectOne chan event = do
cstates <- gets chanstate
return $ maybeToList $ M.lookup chan cstates >>= detect event
detectMany nick event = do
chans <- presence nick
cstates <- gets chanstate
let cstatesP =
cstates `M.difference` M.fromList (zip chans (repeat ()))
return $ catMaybes $ map (detect event) $ M.elems cstatesP
in case e of
L.Enter nick chan -> detectOne chan $ EnterChan nick
L.Leave nick chan -> detectOne chan $ LeaveChan nick
L.LeaveAll nick -> detectMany nick $ LeaveChan nick
L.Message nick chan msg -> detectOne chan $ MessageChan nick msg
L.Rename oldN newN -> detectMany oldN $ RenameInChan oldN newN
handleLogEvent :: L.LogEvent -> Session e s ()
handleLogEvent e = do
l <- detectLogEvents e
liftIO $ mapM_ (\ (logger, event) -> logEvent logger event) l
handleEvent :: Either L.LogEvent Event -> Session e s ()
handleEvent = either handleLogEvent handleBotEvent