diff --git a/Network/IRC/Handlers.hs b/Network/IRC/Handlers.hs index 9552e99..b533523 100644 --- a/Network/IRC/Handlers.hs +++ b/Network/IRC/Handlers.hs @@ -62,7 +62,7 @@ pingPong _ _ = return Nothing greeter :: MonadMsgHandler m => Message -> m (Maybe Command) greeter ChannelMsg { .. } = - return . map (ChannelMsgReply . (++ " ") . (++ userNick user)) . find (== clean msg) $ greetings + return . map (ChannelMsgReply . (++ userNick user) . (++ " ")) . find (== clean msg) $ greetings where greetings = [ "hi", "hello", "hey", "sup", "bye" , "good morning", "good evening", "good night" ] @@ -85,7 +85,7 @@ help ChannelMsg { .. } return . Just . ChannelMsgReply $ "I know these commands: " ++ unwords commands | "!help" `isPrefixOf` msg = do BotConfig { .. } <- ask - let command = clean . unwords . drop 1 . words $ msg + let command = cons '!'. dropWhile (== '!') . clean . unwords . drop 1 . words $ msg let mHelp = find ((== command) . fst) . concatMap mapToList . mapValues $ msgHandlerInfo return . Just . ChannelMsgReply $ maybe ("No such command found: " ++ command) snd mHelp diff --git a/Network/IRC/Handlers/NickTracker.hs b/Network/IRC/Handlers/NickTracker.hs index 4f0436d..c99ec42 100644 --- a/Network/IRC/Handlers/NickTracker.hs +++ b/Network/IRC/Handlers/NickTracker.hs @@ -48,28 +48,24 @@ $(makeAcidic ''NickTracking ['getByNick, 'getByCanonicalNick, 'saveNickTrack]) nickTrackerMsg :: MonadMsgHandler m => IORef (AcidState NickTracking) -> Message -> m (Maybe Command) nickTrackerMsg state = go where - go ChannelMsg { .. } = updateNickTrack user msg msgTime True >> handleCommands msg - go ActionMsg { .. } = updateNickTrack user msg msgTime True >> return Nothing - go JoinMsg { .. } = updateNickTrack user "" msgTime False >> return Nothing - go PartMsg { .. } = updateNickTrack user msg msgTime False >> return Nothing - go QuitMsg { .. } = updateNickTrack user msg msgTime False >> return Nothing + go ChannelMsg { .. } = updateNickTrack user msg msgTime >> handleCommands msg + go ActionMsg { .. } = updateNickTrack user msg msgTime >> return Nothing + go JoinMsg { .. } = updateNickTrack user "" msgTime >> return Nothing + go PartMsg { .. } = updateNickTrack user msg msgTime >> return Nothing + go QuitMsg { .. } = updateNickTrack user msg msgTime >> return Nothing go NickMsg { .. } = handleNickChange user newNick msgTime >> return Nothing go _ = return Nothing - updateNickTrack user message msgTime isChat = liftIO $ do + updateNickTrack user message msgTime = liftIO $ do acid <- readIORef state let nck = userNick user mnt <- query acid . GetByNick $ Nick nck - (message', cn) <- case (message, mnt) of - ("", Just (NickTrack { .. })) -> return (lastMessage, canonicalNick) - (_, Just (NickTrack { .. })) -> return (message, canonicalNick) + (message', lastMessageOn', cn) <- case (message, mnt) of + ("", Just (NickTrack { .. })) -> return (lastMessage, lastMessageOn, canonicalNick) + (_, Just (NickTrack { .. })) -> return (message, msgTime, canonicalNick) _ -> do cn <- map (CanonicalNick . pack . U.toString) U.nextRandom - return (message, cn) - let lastMessageOn' = case (isChat, mnt) of - (True, _) -> msgTime - (False, Just (NickTrack { .. })) -> lastMessageOn - (False, Nothing) -> msgTime + return (message, msgTime, cn) update acid . SaveNickTrack $ NickTrack (Nick nck) cn (LastSeenOn msgTime) lastMessageOn' message' @@ -89,25 +85,49 @@ nickTrackerMsg state = go update acid . SaveNickTrack $ NickTrack (Nick newNick) cn (LastSeenOn msgTime) lastMessageOn' message - handleCommands message = - if "!nick" `isPrefixOf` message - then handleNickCommand state message - else return Nothing + commands = [ ("!nick", handleNickCommand) + , ("!seen", handleSeenCommand) ] + handleCommands message = case find ((`isPrefixOf` message) . fst) commands of + Nothing -> return Nothing + Just (_, handler) -> handler state message -handleNickCommand :: MonadMsgHandler m => IORef(AcidState NickTracking) -> Text -> m (Maybe Command) -handleNickCommand state msg = liftIO $ do +withCanonicalNick :: MonadMsgHandler m => IORef (AcidState NickTracking) + -> Text + -> (AcidState NickTracking -> Text -> CanonicalNick -> IO Text) + -> m (Maybe Command) +withCanonicalNick state msg f = liftIO $ do acid <- readIORef state let nck = clean . unwords . drop 1 . words $ msg mcn <- liftM (map canonicalNick) . query acid . GetByNick $ Nick nck resp <- case mcn of Nothing -> return $ "Unknown nick: " ++ nck - Just cn -> liftIO $ do - nicks <- liftM (map ((\(Nick n) -> n) . nick)) . query acid . GetByCanonicalNick $ cn - if length nicks == 1 - then return $ nck ++ " has only one nick" - else return $ nck ++ "'s other nicks are: " ++ intercalate ", " (filter (/= nck) nicks) + Just cn -> liftIO $ f acid nck cn return . Just . ChannelMsgReply $ resp +handleNickCommand :: MonadMsgHandler m => IORef(AcidState NickTracking) -> Text -> m (Maybe Command) +handleNickCommand state msg = withCanonicalNick state msg $ \acid nck canonicalNick -> do + nicks <- liftM (map ((\(Nick n) -> n) . nick)) . query acid . GetByCanonicalNick $ canonicalNick + if length nicks == 1 + then return $ nck ++ " has only one nick" + else return $ nck ++ "'s other nicks are: " ++ intercalate ", " (filter (/= nck) nicks) + +handleSeenCommand :: MonadMsgHandler m => IORef(AcidState NickTracking) -> Text -> m (Maybe Command) +handleSeenCommand state msg = withCanonicalNick state msg $ \acid nick canonicalNick -> do + nts <- query acid . GetByCanonicalNick $ canonicalNick + let NickTrack { lastSeenOn = LastSeenOn lastSeenOn' + , nick = Nick lastSeenAs } = maximumByEx (comparing lastSeenOn) nts + let NickTrack { lastMessageOn = lastMessageOn' + , lastMessage = lastMessage' + , nick = Nick lastMessageAs } = maximumByEx (comparing lastMessageOn) nts + + return $ nick ++ " was last seen on " ++ fmtTime lastSeenOn' ++ + (if nick /= lastSeenAs then " as " ++ lastSeenAs else "") ++ + " and at " ++ fmtTime lastMessageOn' ++ " " ++ nick ++ + (if nick /= lastMessageAs then " as " ++ lastMessageAs else "") ++ + " said: " ++ lastMessage' + where + fmtTime = pack . formatTime defaultTimeLocale "%F %T" + stopNickTracker :: MonadMsgHandler m => IORef (AcidState NickTracking) -> m () stopNickTracker state = liftIO $ do acid <- readIORef state @@ -119,7 +139,9 @@ mkMsgHandler BotConfig { .. } _ "nicktracker" = do state <- liftIO (openLocalState emptyNickTracking >>= newIORef) return . Just $ newMsgHandler { onMessage = nickTrackerMsg state , onStop = stopNickTracker state - , onHelp = return $ singletonMap "!nick" helpMsg } + , onHelp = return $ mapFromList helpMsgs} where - helpMsg = "Shows the user's other nicks. !nick " + helpMsgs = mapFromList [ + ("!nick", "Shows the user's other nicks. !nick "), + ("!seen", "Lets you know when a user was last seen online and last spoke in the channel. !seen ") ] mkMsgHandler _ _ _ = return Nothing diff --git a/Network/IRC/Handlers/NickTracker/Types.hs b/Network/IRC/Handlers/NickTracker/Types.hs index d3d800e..e9f4685 100644 --- a/Network/IRC/Handlers/NickTracker/Types.hs +++ b/Network/IRC/Handlers/NickTracker/Types.hs @@ -14,7 +14,7 @@ newtype CanonicalNick = CanonicalNick Text deriving (Eq, Ord, Show, Data, Typeab newtype LastSeenOn = LastSeenOn UTCTime deriving (Eq, Ord, Show, Data, Typeable) data NickTrack = NickTrack { - nick :: Nick, + nick :: Nick, canonicalNick :: CanonicalNick, lastSeenOn :: LastSeenOn, lastMessageOn :: UTCTime, diff --git a/Network/IRC/Util.hs b/Network/IRC/Util.hs index c3b78ca..a9fd3fc 100644 --- a/Network/IRC/Util.hs +++ b/Network/IRC/Util.hs @@ -4,9 +4,6 @@ module Network.IRC.Util where ---import qualified Data.Text.Format as TF ---import qualified Data.Text.Format.Params as TF - import ClassyPrelude import Control.Concurrent.Lifted (Chan) import Data.Text (strip) diff --git a/config.cfg.template b/config.cfg.template index 4c55da9..b690c27 100644 --- a/config.cfg.template +++ b/config.cfg.template @@ -2,7 +2,7 @@ server = "irc.freenode.net" port = 6667 channel = "#testtesttest" nick = "haskman" -msghandlers = ["greeter", "welcomer", "songsearch", "auth"] +msghandlers = ["greeter", "welcomer", "songsearch", "auth", "nicktracker"] songsearch { tinysong_apikey = "xxxyyyzzz"