From d80bba094842fc3bd3246308be0629a8de7c7785 Mon Sep 17 00:00:00 2001 From: Abhinav Sarkar Date: Sun, 11 May 2014 22:34:35 +0530 Subject: [PATCH] Added action message support. Minor fixes --- Network/IRC/Client.hs | 26 ++++++++++++++------------ Network/IRC/Handlers/Core.hs | 6 +++++- Network/IRC/Protocol.hs | 31 +++++++++++++++++-------------- Network/IRC/Types.hs | 1 + 4 files changed, 37 insertions(+), 27 deletions(-) diff --git a/Network/IRC/Client.hs b/Network/IRC/Client.hs index 9b4291a..6ad7266 100644 --- a/Network/IRC/Client.hs +++ b/Network/IRC/Client.hs @@ -70,18 +70,20 @@ listenerLoop idleFor = do _ -> listenerLoop 0 where - dispatchHandlers bot@Bot { .. } message = forM_ (msgHandlers botConfig) $ \msgHandlerName -> fork $ do - let mMsgHandler = getMsgHandler msgHandlerName - case mMsgHandler of - Nothing -> debug $ "No msg handler found with name: " ++ msgHandlerName - Just msgHandler -> - let msgHandlerState = fromJust . lookup msgHandlerName $ msgHandlerStates - in modifyMVar_ msgHandlerState $ \hState -> do - !(mCmd, nhState) <- runMsgHandler msgHandler botConfig hState message - case mCmd of - Nothing -> return () - Just cmd -> sendCommand bot cmd - return nhState + dispatchHandlers bot@Bot { .. } message = + forM_ (msgHandlers botConfig) $ \msgHandlerName -> fork $ + handle (\(e :: SomeException) -> debug $ "Exception! " ++ pack (show e)) $ do + let mMsgHandler = getMsgHandler msgHandlerName + case mMsgHandler of + Nothing -> debug $ "No msg handler found with name: " ++ msgHandlerName + Just msgHandler -> + let msgHandlerState = fromJust . lookup msgHandlerName $ msgHandlerStates + in modifyMVar_ msgHandlerState $ \hState -> do + !(mCmd, nhState) <- runMsgHandler msgHandler botConfig hState message + case mCmd of + Nothing -> return () + Just cmd -> sendCommand bot cmd + return nhState loadMsgHandlers :: BotConfig -> IO MsgHandlerStates loadMsgHandlers botConfig@BotConfig { .. } = diff --git a/Network/IRC/Handlers/Core.hs b/Network/IRC/Handlers/Core.hs index 69bb8f4..0f6b437 100644 --- a/Network/IRC/Handlers/Core.hs +++ b/Network/IRC/Handlers/Core.hs @@ -46,7 +46,7 @@ initMessageLogger = do (logFileHandle, curDay) <- liftIO $ do logFilePath <- getLogFilePath botConfig logFileHandle <- openLogFile logFilePath - time <- getCurrentTime + time <- getModificationTime logFilePath return (logFileHandle, utctDay time) put $ toDyn (logFileHandle, curDay) @@ -88,6 +88,10 @@ messageLogger :: MonadMsgHandler m => Message -> m (Maybe Command) messageLogger ChannelMsg { .. } = withLogFile $ \logFile -> TF.hprint logFile "[{}] {}: {}\n" $ TF.buildParams (fmtTime msgTime, userNick user, msg) +messageLogger ActionMsg { .. } = withLogFile $ \logFile -> + TF.hprint logFile "[{}] {}: {} {}\n" $ + TF.buildParams (fmtTime msgTime, userNick user, userNick user, msg) + messageLogger KickMsg { .. } = withLogFile $ \logFile -> TF.hprint logFile "[{}] ** {} KICKED {} :{}\n" $ TF.buildParams (fmtTime msgTime, userNick user, kickedNick, msg) diff --git a/Network/IRC/Protocol.hs b/Network/IRC/Protocol.hs index d678fd1..75f78dc 100644 --- a/Network/IRC/Protocol.hs +++ b/Network/IRC/Protocol.hs @@ -13,7 +13,7 @@ msgFromLine (BotConfig { .. }) time line | "PING :" `isPrefixOf` line = Ping time (drop 6 line) line | otherwise = case command of "JOIN" -> JoinMsg time user line - "QUIT" -> QuitMsg time user message line + "QUIT" -> QuitMsg time user quitMessage line "PART" -> PartMsg time user message line "KICK" -> KickMsg time user kicked kickReason line "MODE" -> if source == botNick @@ -21,22 +21,25 @@ msgFromLine (BotConfig { .. }) time line else ModeMsg time user target mode modeArgs line "NICK" -> NickMsg time user (drop 1 target) line "PRIVMSG" -> if target == channel - then ChannelMsg time user message line + then if "\x01" `isPrefixOf` message && "ACTION" `isPrefixOf` drop 1 message + then ActionMsg time user (initDef . drop 8 $ message) line + else ChannelMsg time user message line else PrivMsg time user message line _ -> OtherMsg time source command target message line where - isSpc = (== ' ') - isNotSpc = not . isSpc - splits = split isSpc line - source = drop 1 . takeWhile isNotSpc $ line - target = splits !! 2 - command = splits !! 1 - message = drop 1 . unwords . drop 3 $ splits - user = let u = split (== '!') source in User (u !! 0) (u !! 1) - mode = splits !! 3 - modeArgs = drop 4 splits - kicked = splits !! 3 - kickReason = drop 1 . unwords . drop 4 $ splits + isSpc = (== ' ') + isNotSpc = not . isSpc + splits = split isSpc line + source = drop 1 . takeWhile isNotSpc $ line + target = splits !! 2 + command = splits !! 1 + message = drop 1 . unwords . drop 3 $ splits + quitMessage = drop 1 . unwords . drop 2 $ splits + user = let u = split (== '!') source in User (u !! 0) (u !! 1) + mode = splits !! 3 + modeArgs = drop 4 splits + kicked = splits !! 3 + kickReason = drop 1 . unwords . drop 4 $ splits lineFromCommand :: BotConfig -> Command -> Text lineFromCommand (BotConfig { .. }) reply = case reply of diff --git a/Network/IRC/Types.hs b/Network/IRC/Types.hs index d528415..a5a2de7 100644 --- a/Network/IRC/Types.hs +++ b/Network/IRC/Types.hs @@ -27,6 +27,7 @@ data Message = IdleMsg | ChannelMsg { msgTime :: !UTCTime, user :: !User, msg :: !Text, msgLine :: !Text } | PrivMsg { msgTime :: !UTCTime, user :: !User, msg :: !Text, msgLine :: !Text } + | ActionMsg { msgTime :: !UTCTime, user :: !User, msg :: !Text, msgLine :: !Text } | Ping { msgTime :: !UTCTime, msg :: !Text, msgLine :: !Text } | JoinMsg { msgTime :: !UTCTime, user :: !User, msgLine :: !Text } | QuitMsg { msgTime :: !UTCTime, user :: !User, msg :: !Text, msgLine :: !Text }