abhin4v
/
hask-irc
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Added action message support. Minor fixes

This commit is contained in:
Abhinav Sarkar 2014-05-11 22:34:35 +05:30
parent 3ef1e2e46e
commit d80bba0948
4 changed files with 37 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
Network/IRC/Client.hs
View File

@ -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 { .. } =

6
Network/IRC/Handlers/Core.hs
View File

@ -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)

31
Network/IRC/Protocol.hs
View File

@ -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

1
Network/IRC/Types.hs
View File

@ -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 }