-- -- Copyright (c) 2004 Thomas Jaeger -- Copyright (c) 2005-6 Don Stewart - http://www.cse.unsw.edu.au/~dons -- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html) -- -- | Keep track of IRC users. -- module Plugin.Seen (theModule) where import Plugin import Lib.AltTime import Lib.Binary import Lib.Error (tryError) import qualified Message (Message, names, channels, nick, body) import qualified Data.Map as M import qualified Data.ByteString.Char8 as P import System.Directory import System.Time (normalizeTimeDiff) -- or export from AltTime.hs? import Control.Monad (unless, zipWithM_) PLUGIN Seen -- Try using packed strings? -- | The type of channels type Channel = P.ByteString -- | The type of nicknames type Nick = P.ByteString -- | We last heard the user speak at ClockTime; since then we have missed -- TimeDiff of him because we were absent. type LastSpoke = Maybe (ClockTime, TimeDiff) -- | 'UserStatus' keeps track of the status of a given Nick name. data UserStatus = Present LastSpoke [Channel] -- ^ Records when the nick last spoke and that the nick is currently -- in [Channel]. | NotPresent ClockTime StopWatch [Channel] -- ^ The nick is not present and was last seen at ClockTime in Channel. -- The second argument records how much we've missed. | WasPresent ClockTime StopWatch LastSpoke [Channel] -- ^ The bot parted a channel where the user was. The Clocktime -- records the time and Channel the channel this happened in. -- We also save the reliablility of our information and the -- time we last heard the user speak. | NewNick Nick -- ^ The user changed nick to something new. deriving (Show, Read) data StopWatch = Stopped TimeDiff | Running ClockTime deriving (Show,Read) type SeenState = M.Map Nick UserStatus type Seen m a = ModuleT SeenState m a ------------------------------------------------------------------------ -- ok, since this module generates quite a lot of state, what we'll do -- is use Binary to pack this value, since Read is sooo slow and exe (as -- my gf says :) instance Binary (M.Map Nick UserStatus) where put_ bh m = put_ bh (M.toList m) get bh = do x <- get bh ; return (M.fromList x) instance Binary StopWatch where put_ bh (Stopped td) = do putByte bh 0 put_ bh td put_ bh (Running ct) = do putByte bh 1 put_ bh ct get bh = do h <- getWord8 bh case h of 0 -> do x <- get bh ; return (Stopped x) 1 -> do x <- get bh ; return (Running x) _ -> error "Seen.StopWatch.get" instance Binary UserStatus where put_ bh (Present spoke chans) = do putByte bh 0 put_ bh spoke put_ bh chans put_ bh (NotPresent ct sw chans) = do putByte bh 1 put_ bh ct put_ bh sw put_ bh chans put_ bh (WasPresent ct sw spoke chans) = do putByte bh 2 put_ bh ct put_ bh sw put_ bh spoke put_ bh chans put_ bh (NewNick n) = do putByte bh 3 put_ bh n get bh = do h <- getWord8 bh case h of 0 -> do x <- get bh y <- get bh return (Present x y) 1 -> do x <- get bh y <- get bh z <- get bh return (NotPresent x y z) 2 -> do x <- get bh y <- get bh z <- get bh a <- get bh return (WasPresent x y z a) 3 -> do x <- get bh return (NewNick x) _ -> error "Seen.UserStatus.get" ------------------------------------------------------------------------ -- -- something's broken. doesn't seem to correctly keep the seen data over -- reboots anymore :/ -- instance Module SeenModule SeenState where moduleHelp _ _ = "seen . Report if a user has been seen by the bot" moduleCmds _ = ["seen"] moduleDefState _ = return M.empty process _ msg _ _ rest = do seenFM <- readMS now <- io getClockTime return [unlines $ getAnswer msg rest seenFM now] moduleInit _ = do zipWithM_ ircSignalConnect ["JOIN", "PART", "QUIT", "NICK", "353", "PRIVMSG"] $ map withSeenFM [joinCB, partCB, quitCB, nickCB, joinChanCB, msgCB] -- This magically causes the 353 callback to be invoked :) tryError $ send_ . Message.names =<< ircGetChannels -- and suck in our state. We read directly from the handle, to avoid copying b <- io $ doesFileExist "State/seen" when b $ do s <- io $ do h <- openFile "State/seen" ReadMode bh <- openBinIO_ h st <- get bh hClose h return st writeMS s moduleExit _ = do chans <- ircGetChannels unless (null chans) $ do ct <- io getClockTime modifyMS $ botPart ct (map P.pack chans) -- and write out our state: withMS $ \s _ -> do io $ do h <- openFile "State/seen" WriteMode bh <- openBinIO_ h put_ bh s hClose h return () ------------------------------------------------------------------------ -- | The bot's name, lowercase myname :: String myname = lowerCaseString (name config) getAnswer :: Message.Message a => a -> String -> SeenState -> ClockTime -> [String] getAnswer msg rest seenFM now | null lcnick = let people = map fst $ filter isActive $ M.toList seenFM isActive (_nick,state) = case state of (Present (Just (ct,_td)) _cs) -> recent ct _ -> False recent t = normalizeTimeDiff (diffClockTimes now t) < gap_minutes gap_minutes = TimeDiff 0 0 0 0 15 0 0 in ["Lately, I have seen " ++ (if null people then "nobody" else listToStr "and" (map P.unpack people)) ++ "."] | lcnick == myname = case M.lookup (P.pack lcnick) seenFM of Just (Present _ cs) -> ["Yes, I'm here. I'm in " ++ listToStr "and" (map P.unpack cs)] _ -> error "I'm here, but not here. And very confused!" | length lcnick > 0 && head lcnick == '#' = let channel = lcnick people = map fst $ filter inChan $ M.toList seenFM inChan (_nick,state) = case state of (Present (Just _) cs) -> P.pack channel `elem` cs _ -> False in ["In "++channel++" I can see " ++ (if null people then "nobody" -- todo, how far back does this go? else listToStr "and" (map P.unpack people)) ++ "."] | otherwise = case M.lookup (P.pack lcnick) seenFM of Just (Present mct cs) -> nickPresent mct (map P.unpack cs) Just (NotPresent ct td chans) -> nickNotPresent ct td (map P.unpack chans) Just (WasPresent ct sw _ chans) -> nickWasPresent ct sw (map P.unpack chans) Just (NewNick newnick) -> nickIsNew (P.unpack newnick) _ -> ircMessage ["I haven't seen ", nick, "."] where -- I guess the only way out of this spagetty hell are printf-style responses. nickPresent mct cs = ircMessage [ if you then "You are" else nick ++ " is", " in ", listToStr "and" cs, ".", case mct of Nothing -> concat [" I don't know when ", nick, " last spoke."] Just (ct,missed) -> prettyMissed (Stopped missed) (concat [" I last heard ", nick, " speak ", lastSpoke {-, ", but "-}]) (" Last spoke " ++ lastSpoke) where lastSpoke = clockDifference ct ] nickNotPresent ct missed chans = ircMessage [ "I saw ", nick, " leaving ", listToStr "and" chans, " ", clockDifference ct, prettyMissed missed ", and " "" ] nickWasPresent ct sw chans = ircMessage [ "Last time I saw ", nick, " was when I left ", listToStr "and" chans , " ", clockDifference ct, prettyMissed sw ", and " ""] nickIsNew newnick = ircMessage [if you then "You have" else nick++" has", " changed nick to ", us, "."] ++ getAnswer msg us seenFM now where findFunc pstr = case M.lookup pstr seenFM of Just (NewNick pstr') -> findFunc pstr' Just _ -> pstr Nothing -> error "SeenModule.nickIsNew: Nothing" us = P.unpack $ findFunc (P.pack $ lowerCaseString newnick) ircMessage = return . concat nick' = firstWord rest you = nick' == Message.nick msg nick = if you then "you" else nick' lcnick = lowerCaseString nick' clockDifference past | all (==' ') diff = "just now" | otherwise = diff ++ " ago" where diff = timeDiffPretty . diffClockTimes now $ past prettyMissed (Stopped _) ifMissed _ = ifMissed ++ "." prettyMissed _ _ ifNotMissed = ifNotMissed ++ "." {- prettyMissed (Stopped missed) ifMissed _ | missedPretty <- timeDiffPretty missed, any (/=' ') missedPretty = concat [ifMissed, "I have missed ", missedPretty, " since then."] prettyMissed _ _ ifNotMissed = ifNotMissed ++ "." -} -- | Callback for when somebody joins. If it is not the bot that joins, record -- that we have a new user in our state tree and that we have never seen the -- user speaking. joinCB :: Message.Message a => a -> SeenState -> ClockTime -> Nick -> Either String SeenState joinCB msg fm _ct nick | nick == (P.pack myname) = Right fm | otherwise = Right $ insertUpd (updateJ Nothing (map P.pack $ Message.channels msg)) nick newInfo fm where newInfo = Present Nothing (map P.pack $ Message.channels msg) botPart :: ClockTime -> [Channel] -> SeenState -> SeenState botPart ct cs fm = fmap botPart' fm where botPart' (Present mct xs) = case xs \\ cs of [] -> WasPresent ct (startWatch ct zeroWatch) mct cs ys -> Present mct ys botPart' (NotPresent ct' missed c) | head c `elem` cs = NotPresent ct' (startWatch ct missed) c botPart' (WasPresent ct' missed mct c) | head c `elem` cs = WasPresent ct' (startWatch ct missed) mct c botPart' us = us -- | when somebody parts partCB :: Message.Message a => a -> SeenState -> ClockTime -> Nick -> Either String SeenState partCB msg fm ct nick | nick == (P.pack myname) = Right $ botPart ct (map P.pack $ Message.channels msg) fm | otherwise = case M.lookup nick fm of Just (Present mct xs) -> case xs \\ (map P.pack $ Message.channels msg) of [] -> Right $ M.insert nick (NotPresent ct zeroWatch xs) fm ys -> Right $ M.insert nick (Present mct ys) fm _ -> Left "someone who isn't known parted" -- | when somebody quits quitCB :: Message.Message a => a -> SeenState -> ClockTime -> Nick -> Either String SeenState quitCB _ fm ct nick = case M.lookup nick fm of Just (Present _ct xs) -> Right $ M.insert nick (NotPresent ct zeroWatch xs) fm _ -> Left "someone who isn't known has quit" -- | when somebody changes his\/her name nickCB :: Message.Message a => a -> SeenState -> ClockTime -> Nick -> Either String SeenState nickCB msg fm _ nick = case M.lookup nick fm of Just status -> let fm' = M.insert nick (NewNick $ P.pack newnick) fm in Right $ M.insert lcnewnick status fm' _ -> Left "someone who isn't here changed nick" where newnick = drop 1 $ head (Message.body msg) lcnewnick = P.pack $ lowerCaseString newnick -- use IRC.IRC.channels? -- | when the bot join a channel joinChanCB :: Message.Message a => a -> SeenState -> ClockTime -> Nick -> Either String SeenState joinChanCB msg fm now _nick = Right $ fmap (updateNP now chan) $ foldl insertNick fm chanUsers where l = Message.body msg chan = P.pack $ l !! 2 chanUsers = map P.pack $ words (drop 1 (l !! 3)) -- remove ':' insertNick fm' u = insertUpd (updateJ (Just now) [chan]) (P.pack . lowerCaseString . P.unpack . unUserMode $ u) (Present Nothing [chan]) fm' -- | when somebody speaks, update their clocktime msgCB :: Message.Message a => a -> SeenState -> ClockTime -> Nick -> Either String SeenState msgCB _ fm ct nick = case M.lookup nick fm of Just (Present _ xs) -> Right $ M.insert nick (Present (Just (ct, noTimeDiff)) xs) fm _ -> Left "someone who isn't here msg us" -- misc. functions unUserMode :: Nick -> Nick unUserMode nick = P.dropWhile (`elem` "@+") nick -- | Callbacks are only allowed to use a limited knowledge of the world. -- 'withSeenFM' is (up to trivial isomorphism) a monad morphism from the -- restricted -- 'ReaderT (IRC.Message, ClockTime, Nick) (StateT SeenState (Error String))' -- to the -- 'ReaderT IRC.Message (Seen IRC)' -- monad. withSeenFM :: Message.Message a => ( a -> SeenState -> ClockTime -> Nick -> Either String SeenState) -> a -> Seen LB () withSeenFM f msg = do let nick = P.pack . lowerCaseString . P.unpack . unUserMode . P.pack . Message.nick $ msg withMS $ \state writer -> do ct <- io getClockTime case f msg state ct nick of Right newstate -> writer newstate Left _ -> return () -- debugStrLn $ "SeenModule> " ++ err -- | Update the user status. updateJ :: Maybe ClockTime -- ^ If the bot joined the channel, the time that -- happened, i.e. now. -> [Channel] -- ^ The channels the user joined. -> UserStatus -- ^ The old status -> UserStatus -- ^ The new status -- The user was present before, so he's present now. updateJ _ c (Present ct cs) = Present ct $ nub (c ++ cs) -- The user was present when we left that channel and now we've come back. -- We need to update the time we've missed. updateJ (Just now) cs (WasPresent lastSeen _ (Just (lastSpoke, missed)) channels) | head channels `elem` cs --- newMissed --- |---------------------------------------| --- |-------------------| | --- missed lastSeen now = let newMissed = addToClockTime missed now `diffClockTimes` lastSeen in newMissed `seq` Present (Just (lastSpoke, newMissed)) cs -- Otherwise, we create a new record of the user. updateJ _ cs _ = Present Nothing cs -- | Update a user who is not present. We just convert absolute missing time -- into relative time (i.e. start the "watch"). updateNP :: ClockTime -> Channel -> UserStatus -> UserStatus updateNP now _ (NotPresent ct missed c) = NotPresent ct (stopWatch now missed) c -- The user might be gone, thus it's meaningless when we last heard him speak. updateNP now chan (WasPresent lastSeen missed _ cs) | head cs == chan = WasPresent lastSeen (stopWatch now missed) Nothing cs updateNP _ _ status = status ------------------------------------------------------------------------ -- Stop watches mini-library -- zeroWatch :: StopWatch zeroWatch = Stopped noTimeDiff startWatch :: ClockTime -> StopWatch -> StopWatch startWatch now (Stopped td) = Running $ td `addToClockTime` now startWatch _ alreadyStarted = alreadyStarted stopWatch :: ClockTime -> StopWatch -> StopWatch stopWatch now (Running t) = Stopped $ t `diffClockTimes` now stopWatch _ alreadyStopped = alreadyStopped