{- This file is part of irc-fun-bot. - - 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 - . -} 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) ------------------------------------------------------------------------------- -- Make Events ------------------------------------------------------------------------------- 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 ------------------------------------------------------------------------------- -- Match Events ------------------------------------------------------------------------------- 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 -- Run the command with the given prefix character, command name and list of -- parameters. If a command with the given prefix and name isn't found, the bot -- sends a default friendly response. runCommand :: Maybe Char -- Command prefix, 'Nothing' picks the default prefix -> String -- Command name -> [String] -- List of parameters -> String -- Channel in which the command was triggered -> String -- Nickname of user who triggered the command -> 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 -- React to a bot event. 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 () -- Using nick tracking and logging state, determine from a general log event a -- set of channel loggers and channel-specific log events to write into them. 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 -- Possibly write a log event into the right file(s), according to logging -- settings. handleLogEvent :: L.LogEvent -> Session e s () handleLogEvent e = do l <- detectLogEvents e liftIO $ mapM_ (\ (logger, event) -> logEvent logger event) l -- | Handle a bot event, or log a log event into a file. handleEvent :: Either L.LogEvent Event -> Session e s () handleEvent = either handleLogEvent handleBotEvent