Added action message support. Minor fixes
parent
3ef1e2e46e
commit
d80bba0948
|
@ -70,18 +70,20 @@ listenerLoop idleFor = do
|
||||||
_ -> listenerLoop 0
|
_ -> listenerLoop 0
|
||||||
|
|
||||||
where
|
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 -> IO MsgHandlerStates
|
||||||
loadMsgHandlers botConfig@BotConfig { .. } =
|
loadMsgHandlers botConfig@BotConfig { .. } =
|
||||||
|
|
|
@ -46,7 +46,7 @@ initMessageLogger = do
|
||||||
(logFileHandle, curDay) <- liftIO $ do
|
(logFileHandle, curDay) <- liftIO $ do
|
||||||
logFilePath <- getLogFilePath botConfig
|
logFilePath <- getLogFilePath botConfig
|
||||||
logFileHandle <- openLogFile logFilePath
|
logFileHandle <- openLogFile logFilePath
|
||||||
time <- getCurrentTime
|
time <- getModificationTime logFilePath
|
||||||
return (logFileHandle, utctDay time)
|
return (logFileHandle, utctDay time)
|
||||||
put $ toDyn (logFileHandle, curDay)
|
put $ toDyn (logFileHandle, curDay)
|
||||||
|
|
||||||
|
@ -88,6 +88,10 @@ messageLogger :: MonadMsgHandler m => Message -> m (Maybe Command)
|
||||||
messageLogger ChannelMsg { .. } = withLogFile $ \logFile ->
|
messageLogger ChannelMsg { .. } = withLogFile $ \logFile ->
|
||||||
TF.hprint logFile "[{}] {}: {}\n" $ TF.buildParams (fmtTime msgTime, userNick user, msg)
|
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 ->
|
messageLogger KickMsg { .. } = withLogFile $ \logFile ->
|
||||||
TF.hprint logFile "[{}] ** {} KICKED {} :{}\n" $
|
TF.hprint logFile "[{}] ** {} KICKED {} :{}\n" $
|
||||||
TF.buildParams (fmtTime msgTime, userNick user, kickedNick, msg)
|
TF.buildParams (fmtTime msgTime, userNick user, kickedNick, msg)
|
||||||
|
|
|
@ -13,7 +13,7 @@ msgFromLine (BotConfig { .. }) time line
|
||||||
| "PING :" `isPrefixOf` line = Ping time (drop 6 line) line
|
| "PING :" `isPrefixOf` line = Ping time (drop 6 line) line
|
||||||
| otherwise = case command of
|
| otherwise = case command of
|
||||||
"JOIN" -> JoinMsg time user line
|
"JOIN" -> JoinMsg time user line
|
||||||
"QUIT" -> QuitMsg time user message line
|
"QUIT" -> QuitMsg time user quitMessage line
|
||||||
"PART" -> PartMsg time user message line
|
"PART" -> PartMsg time user message line
|
||||||
"KICK" -> KickMsg time user kicked kickReason line
|
"KICK" -> KickMsg time user kicked kickReason line
|
||||||
"MODE" -> if source == botNick
|
"MODE" -> if source == botNick
|
||||||
|
@ -21,22 +21,25 @@ msgFromLine (BotConfig { .. }) time line
|
||||||
else ModeMsg time user target mode modeArgs line
|
else ModeMsg time user target mode modeArgs line
|
||||||
"NICK" -> NickMsg time user (drop 1 target) line
|
"NICK" -> NickMsg time user (drop 1 target) line
|
||||||
"PRIVMSG" -> if target == channel
|
"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
|
else PrivMsg time user message line
|
||||||
_ -> OtherMsg time source command target message line
|
_ -> OtherMsg time source command target message line
|
||||||
where
|
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 -> Command -> Text
|
||||||
lineFromCommand (BotConfig { .. }) reply = case reply of
|
lineFromCommand (BotConfig { .. }) reply = case reply of
|
||||||
|
|
|
@ -27,6 +27,7 @@ data Message =
|
||||||
IdleMsg
|
IdleMsg
|
||||||
| ChannelMsg { msgTime :: !UTCTime, user :: !User, msg :: !Text, msgLine :: !Text }
|
| ChannelMsg { msgTime :: !UTCTime, user :: !User, msg :: !Text, msgLine :: !Text }
|
||||||
| PrivMsg { 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 }
|
| Ping { msgTime :: !UTCTime, msg :: !Text, msgLine :: !Text }
|
||||||
| JoinMsg { msgTime :: !UTCTime, user :: !User, msgLine :: !Text }
|
| JoinMsg { msgTime :: !UTCTime, user :: !User, msgLine :: !Text }
|
||||||
| QuitMsg { msgTime :: !UTCTime, user :: !User, msg :: !Text, msgLine :: !Text }
|
| QuitMsg { msgTime :: !UTCTime, user :: !User, msg :: !Text, msgLine :: !Text }
|
||||||
|
|
Loading…
Reference in New Issue