Added action message support. Minor fixes

Network/IRC/Client.hs

@@ -70,18 +70,20 @@ listenerLoop idleFor = do
     _            -> listenerLoop 0
 
   where
-    dispatchHandlers bot@Bot { .. } message = forM_ (msgHandlers botConfig) $ \msgHandlerName -> fork $ do
+    dispatchHandlers bot@Bot { .. } message =
-      let mMsgHandler = getMsgHandler msgHandlerName
+      forM_ (msgHandlers botConfig) $ \msgHandlerName -> fork $
-      case mMsgHandler of
+        handle (\(e :: SomeException) -> debug $ "Exception! " ++ pack (show e)) $ do
-        Nothing         -> debug $ "No msg handler found with name: " ++ msgHandlerName
+          let mMsgHandler = getMsgHandler msgHandlerName
-        Just msgHandler ->
+          case mMsgHandler of
-          let msgHandlerState = fromJust . lookup msgHandlerName $ msgHandlerStates
+            Nothing         -> debug $ "No msg handler found with name: " ++ msgHandlerName
-          in modifyMVar_ msgHandlerState $ \hState -> do
+            Just msgHandler ->
-            !(mCmd, nhState) <- runMsgHandler msgHandler botConfig hState message
+              let msgHandlerState = fromJust . lookup msgHandlerName $ msgHandlerStates
-            case mCmd of
+              in modifyMVar_ msgHandlerState $ \hState -> do
-              Nothing  -> return ()
+                !(mCmd, nhState) <- runMsgHandler msgHandler botConfig hState message
-              Just cmd -> sendCommand bot cmd
+                case mCmd of
-            return nhState
+                  Nothing  -> return ()
+                  Just cmd -> sendCommand bot cmd
+                return nhState
 
 loadMsgHandlers :: BotConfig -> IO MsgHandlerStates
 loadMsgHandlers botConfig@BotConfig { .. } =

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)

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      = (== ' ')
+    isSpc          = (== ' ')
-    isNotSpc   = not . isSpc
+    isNotSpc       = not . isSpc
-    splits     = split isSpc line
+    splits         = split isSpc line
-    source     = drop 1 . takeWhile isNotSpc $ line
+    source         = drop 1 . takeWhile isNotSpc $ line
-    target     = splits !! 2
+    target         = splits !! 2
-    command    = splits !! 1
+    command        = splits !! 1
-    message    = drop 1 . unwords . drop 3 $ splits
+    message        = drop 1 . unwords . drop 3 $ splits
-    user       = let u = split (== '!') source in User (u !! 0) (u !! 1)
+    quitMessage    = drop 1 . unwords . drop 2 $ splits
-    mode       = splits !! 3
+    user           = let u = split (== '!') source in User (u !! 0) (u !! 1)
-    modeArgs   = drop 4 splits
+    mode           = splits !! 3
-    kicked     = splits !! 3
+    modeArgs       = drop 4 splits
-    kickReason = drop 1 . unwords . drop 4 $ splits
+    kicked         = splits !! 3
+    kickReason     = drop 1 . unwords . drop 4 $ splits
 
 lineFromCommand :: BotConfig -> Command -> Text
 lineFromCommand (BotConfig { .. }) reply = case reply of

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 }