Added seen command

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
 

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 <user nick>"
+    helpMsgs = mapFromList [
+      ("!nick", "Shows the user's other nicks. !nick <user nick>"),
+      ("!seen", "Lets you know when a user was last seen online and last spoke in the channel. !seen <user nick>") ]
 mkMsgHandler _ _ _                     = return Nothing

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,

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)

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"