lambdabot-social-plugins (empty) → 5.0
raw patch · 12 files changed
+1256/−0 lines, 12 filesdep +basedep +binarydep +bytestringsetup-changed
Dependencies added: base, binary, bytestring, containers, lambdabot-core, mtl, split, time
Files
- LICENSE +22/−0
- Setup.hs +3/−0
- lambdabot-social-plugins.cabal +56/−0
- src/Lambdabot/Plugin/Social.hs +18/−0
- src/Lambdabot/Plugin/Social/Activity.hs +59/−0
- src/Lambdabot/Plugin/Social/Karma.hs +110/−0
- src/Lambdabot/Plugin/Social/Poll.hs +194/−0
- src/Lambdabot/Plugin/Social/Seen.hs +332/−0
- src/Lambdabot/Plugin/Social/Seen/StopWatch.hs +30/−0
- src/Lambdabot/Plugin/Social/Seen/UserStatus.hs +77/−0
- src/Lambdabot/Plugin/Social/Tell.hs +296/−0
- src/Lambdabot/Util/NickEq.hs +59/−0
+ LICENSE view
@@ -0,0 +1,22 @@+Copyright (c) 2003 Andrew J. Bromage+Portions Copyright (c) 2003 Shae Erisson, Sven M. Hallberg, Taylor Campbell+Portions Copyright (c) 2003-2006 Members of the AUTHORS file++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject+to the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY+KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE+WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE+LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION+OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION+WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.hs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks
+ lambdabot-social-plugins.cabal view
@@ -0,0 +1,56 @@+name: lambdabot-social-plugins+version: 5.0++license: GPL+license-file: LICENSE++author: Don Stewart+maintainer: James Cook <mokus@deepbondi.net>++category: Development, Web+synopsis: Social plugins for Lambdabot+description: Lambdabot is an IRC bot written over several years by+ those on the #haskell IRC channel.+ .+ Provided plugins:+ .+ [activity] Check where and how much is lambdabot used.+ [karma] Track who's been good and who's been naughty.+ [poll] Let the people vote.+ [seen] Track who was around when.+ [tell] Leave messages for other users.++homepage: http://haskell.org/haskellwiki/Lambdabot++build-type: Simple+cabal-version: >= 1.8+tested-with: GHC == 7.6.3, GHC == 7.8.3++source-repository head+ type: git+ location: https://github.com/lambdabot/lambdabot.git++library+ hs-source-dirs: src+ ghc-options: -Wall+ -funbox-strict-fields++ exposed-modules: Lambdabot.Plugin.Social++ other-modules: Lambdabot.Plugin.Social.Activity+ Lambdabot.Plugin.Social.Karma+ Lambdabot.Plugin.Social.Poll+ Lambdabot.Plugin.Social.Seen+ Lambdabot.Plugin.Social.Seen.StopWatch+ Lambdabot.Plugin.Social.Seen.UserStatus+ Lambdabot.Plugin.Social.Tell+ Lambdabot.Util.NickEq++ build-depends: base >= 4.4 && < 5,+ binary >= 0.5,+ bytestring >= 0.9,+ containers >= 0.4,+ lambdabot-core >= 5 && < 5.1,+ mtl >= 2,+ split >= 0.2,+ time >= 1.4
+ src/Lambdabot/Plugin/Social.hs view
@@ -0,0 +1,18 @@+module Lambdabot.Plugin.Social+ ( activityPlugin+ , karmaPlugin+ , pollPlugin+ , seenPlugin+ , tellPlugin+ + , socialPlugins+ ) where++import Lambdabot.Plugin.Social.Activity+import Lambdabot.Plugin.Social.Karma+import Lambdabot.Plugin.Social.Poll+import Lambdabot.Plugin.Social.Seen+import Lambdabot.Plugin.Social.Tell++socialPlugins :: [String]+socialPlugins = ["activity", "karma", "poll", "seen", "tell"]
+ src/Lambdabot/Plugin/Social/Activity.hs view
@@ -0,0 +1,59 @@+-- | Logging an IRC channel..+module Lambdabot.Plugin.Social.Activity (activityPlugin) where++import Lambdabot.Bot+import Lambdabot.Plugin+import Lambdabot.Util++import Control.Arrow ((&&&))+import Control.Exception (evaluate)+import Data.List+import Data.Maybe+import Data.Time++type ActivityState = [(UTCTime,Nick)]+type Activity = ModuleT ActivityState LB++activityPlugin :: Module [(UTCTime, Nick)]+activityPlugin = newModule+ { moduleDefState = return []+ , moduleInit = bindModule2 activityFilter >>= ircInstallOutputFilter++ , moduleCmds = return+ [ (command "activity")+ { help = say helpStr+ , process = activity False+ }+ , (command "activity-full")+ { help = say helpStr+ , privileged = True+ , process = activity True+ }+ ]+ }++helpStr :: String+helpStr = "activity seconds. Find out where/how much the bot is being used"++activity :: Bool -> String -> Cmd Activity ()+activity full args = do+ let obscure nm+ | full || isPrefixOf "#" (nName nm) = return nm+ | otherwise = readNick "private"++ now <- io getCurrentTime+ let cutoff = addUTCTime (- fromInteger (fromMaybe 90 $ readM args)) now+ users <- mapM (obscure . snd) . takeWhile ((> cutoff) . fst) =<< readMS+ let agg_users = reverse . sort . map (length &&& head) . group . sort $ users+ fmt_agg <- fmap (intercalate " " . (:) (show (length users) ++ "*total"))+ (mapM (\(n,u) -> do u' <- showNick u; return (show n ++ "*" ++ u')) $ agg_users)++ say fmt_agg++activityFilter :: Nick -> [String] -> Activity [String]+activityFilter target lns = do+ io $ evaluate $ foldr seq () $ map (foldr seq ()) $ lns+ withMS $ \ st wr -> do+ now <- io getCurrentTime+ wr (map (const (now,target)) lns ++ st)+ return lns
+ src/Lambdabot/Plugin/Social/Karma.hs view
@@ -0,0 +1,110 @@+-- | Karma+module Lambdabot.Plugin.Social.Karma (karmaPlugin) where++import Lambdabot.Compat.FreenodeNick+import Lambdabot.Plugin+import qualified Lambdabot.Util.NickEq as E++import Data.Char+import Data.List+import qualified Data.Map as M+import Data.Maybe+import Text.Printf++type KarmaState = M.Map Nick Integer+type Karma = ModuleT KarmaState LB++karmaPlugin :: Module KarmaState+karmaPlugin = newModule+ { moduleCmds = return+ [ (command "karma")+ { help = say "karma <polynick>. Return a person's karma value"+ , process = \rest -> withMsg $ \msg -> do+ sender <- getSender+ tellKarma sender $ case words rest of+ [] -> E.mononickToPolynick sender+ (nick:_) -> E.readPolynick msg nick++ }+ , (command "karma+")+ { help = say "karma+ <nick>. Increment someone's karma"+ , process = doCmd 1+ }+ , (command "karma-")+ { help = say "karma- <nick>. Decrement someone's karma"+ , process = doCmd (-1)+ }+ , (command "karma-all")+ { help = say "karma-all. List all karma"+ , process = const listKarma+ }+ ]++ , moduleDefState = return $ M.empty+ , moduleSerialize = Just freenodeNickMapSerial++ -- nick++($| )+ , contextual = \text -> withMsg $ \_ -> do+ sender <- getSender++ let ws = words text+ decs = match "--"+ incs = match "++"+ match m = mapM readNick . filter okay . map (reverse . drop 2)+ . filter (isPrefixOf m) . map reverse $ ws+ okay x = not (elem x badNicks || any (`isPrefixOf` x) badPrefixes)+ -- Special cases. Ignore the null nick. C must also be ignored+ -- because C++ and C-- are languages.+ badNicks = ["", "C", "c", "notepad"]+ -- More special cases, to ignore Perl code.+ badPrefixes = ["$", "@", "%"]++ mapM_ (changeKarma (-1) sender) =<< decs+ mapM_ (changeKarma 1 sender) =<< incs+ }++doCmd :: Integer -> String -> Cmd Karma ()+doCmd dk rest = do+ sender <- getSender+ case words rest of+ [] -> say "usage @karma(+|-) nick"+ (nick:_) -> do+ nick' <- readNick nick+ changeKarma dk sender nick' >>= say++------------------------------------------------------------------------++tellKarma :: Nick -> E.Polynick -> Cmd Karma ()+tellKarma sender nick = do+ lookup' <- lb E.lookupMononickMap+ karma <- (sum . map snd . lookup' nick) `fmap` readMS+ nickStr <- withMsg (return . flip E.showPolynick nick)+ say $ concat [if E.mononickToPolynick sender == nick then "You have" else nickStr ++ " has"+ ," a karma of "+ ,show karma]++listKarma :: Cmd Karma ()+listKarma = do+ ks <- M.toList `fmap` readMS+ let ks' = sortBy (\(_,e) (_,e') -> e' `compare` e) ks+ flip mapM_ ks' $ \(k,e) -> do+ k' <- showNick k+ say (printf " %-20s %4d" k' e)++changeKarma :: Integer -> Nick -> Nick -> Cmd Karma String+changeKarma km sender nick+ | map toLower (nName nick) == "java" && km > 0 = do+ me <- getLambdabotName+ changeKarma (-km) me sender+ | sender == nick = return "You can't change your own karma, silly."+ | otherwise = do+ nickStr <- showNick nick+ withMS $ \fm write -> do+ let fm' = M.insertWith (+) nick km fm+ let karma = fromMaybe 0 $ M.lookup nick fm'+ write fm'+ return (fmt nickStr km (show karma))+ where+ fmt n v k | v < 0 = n ++ "'s karma lowered to " ++ k ++ "."+ | v == 0 = n ++ "'s karma unchanged at " ++ k ++ "."+ | otherwise = n ++ "'s karma raised to " ++ k ++ "."
+ src/Lambdabot/Plugin/Social/Poll.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE TypeFamilies #-}+-- | Module: Vote+-- | Support for voting+-- |+-- | License: lGPL+-- |+-- | added by Kenneth Hoste (boegel), 22/11/2005+-- | inspiration: Where plugin (thanks shapr,dons)+module Lambdabot.Plugin.Social.Poll (pollPlugin) where++import Lambdabot.Plugin+import qualified Data.ByteString.Char8 as P+import Data.List+import qualified Data.Map as M++newPoll :: Poll+newPoll = (True,[])++appendPoll :: String -> Poll -> (Maybe Poll)+appendPoll choice (o,ls) = Just (o,(choice,0):ls)++voteOnPoll :: Poll -> String -> (Poll,String)+voteOnPoll (o,poll) choice =+ if any (\(x,_) -> x == choice) poll+ then ((o,map (\(c,n) ->+ if c == choice then (c,n+1)+ else (c,n)) poll)+ ,"voted on " ++ show choice)+ else ((o,poll),show choice ++ " is not currently a candidate in this poll")++------------------------------------------------------------------------++type Count = Int+type Candidate = String+type PollName = P.ByteString+type Poll = (Bool, [(Candidate, Count)])+type VoteState = M.Map PollName Poll+type VoteWriter = VoteState -> Cmd Vote ()+type Vote = ModuleT VoteState LB++------------------------------------------------------------------------+-- Define a serialiser++voteSerial :: Serial VoteState+voteSerial = Serial (Just . showPacked) (Just . readPacked)++------------------------------------------------------------------------++pollPlugin :: Module (M.Map PollName Poll)+pollPlugin = newModule+ { moduleCmds = return+ [ (command "poll-list")+ { help = say "poll-list Shows all current polls"+ , process = \_ -> do+ result <- withMS $ \factFM writer -> processCommand factFM writer "poll-list" []+ say result+ }+ , (command "poll-show")+ { help = say "poll-show <poll> Shows all choices for some poll"+ , process = process_ "poll-show"+ }+ , (command "poll-add")+ { help = say "poll-add <name> Adds a new poll, with no candidates"+ , process = process_ "poll-add"+ }+ , (command "choice-add")+ { help = say "choice-add <poll> <choice> Adds a new choice to the given poll"+ , process = process_ "choice-add"+ }+ , (command "vote")+ -- todo, should @vote foo automagically add foo as a possibility?+ { help = say "vote <poll> <choice> Vote for <choice> in <poll>"+ , process = process_ "vote"+ }+ , (command "poll-result")+ { help = say "poll-result <poll> Show result for given poll"+ , process = process_ "poll-result"+ }+ , (command "poll-close")+ { help = say "poll-close <poll> Closes a poll"+ , process = process_ "poll-close"+ }+ , (command "poll-remove")+ { help = say "poll-remove <poll> Removes a poll"+ , process = process_ "poll-remove"+ }+ ]++ , moduleDefState = return M.empty+ , moduleSerialize = Just voteSerial+ }++process_ :: [Char] -> [Char] -> Cmd Vote ()+process_ cmd [] = say ("Missing argument. Check @help " ++ cmd ++ " for info.")+process_ cmd dat = do+ result <- withMS $ \fm writer -> processCommand fm writer cmd (words dat)+ say result++------------------------------------------------------------------------++processCommand :: VoteState -> VoteWriter -> String -> [String] -> Cmd Vote String+processCommand fm writer cmd dat = case cmd of++ -- show all current polls+ "poll-list" -> return $ listPolls fm++ -- show candidates+ "poll-show" -> return $ case length dat of+ 1 -> showPoll fm (head dat)+ _ -> "usage: @poll-show <poll>"++ -- declare a new poll+ "poll-add" -> case length dat of+ 1 -> addPoll fm writer (head dat)+ _ -> return "usage: @poll-add <poll> with \"ThisTopic\" style names"++ "choice-add" -> case length dat of+ 2 -> addChoice fm writer (head dat) (last dat)+ _ -> return "usage: @choice-add <poll> <choice>"++ "vote" -> case length dat of+ 2 -> vote fm writer (head dat) (last dat)+ _ -> return "usage: @vote <poll> <choice>"++ "poll-result" -> return $ case length dat of+ 1 -> showResult fm (head dat)+ _ -> "usage: @poll-result <poll>"++ "poll-close" -> case length dat of+ 1 -> closePoll fm writer (head dat)+ _ -> return "usage: @poll-close <poll>"++ "poll-remove" -> case length dat of+ 1 -> removePoll fm writer (head dat)+ _ -> return "usage: @poll-remove <poll>"++ _ -> return "Unknown command."++------------------------------------------------------------------------++listPolls :: VoteState -> String+listPolls fm = show $ map fst (M.toList fm)++showPoll :: VoteState -> String -> String+showPoll fm poll =+ case M.lookup (P.pack poll) fm of+ Nothing -> "No such poll: " ++ show poll ++ " Use @poll-list to see the available polls."+ Just p -> show $ map fst (snd p)++addPoll :: VoteState -> VoteWriter -> String -> Cmd Vote String+addPoll fm writer poll =+ case M.lookup (P.pack poll) fm of+ Nothing -> do writer $ M.insert (P.pack poll) newPoll fm+ return $ "Added new poll: " ++ show poll+ Just _ -> return $ "Poll " ++ show poll +++ " already exists, choose another name for your poll"++addChoice :: VoteState -> VoteWriter -> String -> String -> Cmd Vote String+addChoice fm writer poll choice = case M.lookup (P.pack poll) fm of+ Nothing -> return $ "No such poll: " ++ show poll+ Just _ -> do writer $ M.update (appendPoll choice) (P.pack poll) fm+ return $ "New candidate " ++ show choice +++ ", added to poll " ++ show poll ++ "."++vote :: VoteState -> VoteWriter -> String -> String -> Cmd Vote String+vote fm writer poll choice = case M.lookup (P.pack poll) fm of+ Nothing -> return $ "No such poll:" ++ show poll+ Just (False,_) -> return $ "The "++ show poll ++ " poll is closed, sorry !"+ Just p@(True,_) -> do let (np,msg) = voteOnPoll p choice+ writer $ M.update (const (Just np)) (P.pack poll) fm+ return msg++showResult :: VoteState -> String -> String+showResult fm poll = case M.lookup (P.pack poll) fm of+ Nothing -> "No such poll: " ++ show poll+ Just (o,p) -> "Poll results for " ++ poll ++ " (" ++ (status o) ++ "): "+ ++ (concat $ intersperse ", " $ map ppr p)+ where+ status s | s = "Open"+ | otherwise = "Closed"+ ppr (x,y) = x ++ "=" ++ show y++removePoll :: VoteState -> VoteWriter -> String -> Cmd Vote String+removePoll fm writer poll = case M.lookup (P.pack poll) fm of+ Just (True,_) -> return "Poll should be closed before you can remove it."+ Just (False,_) -> do writer $ M.delete (P.pack poll) fm+ return $ "poll " ++ show poll ++ " removed."+ Nothing -> return $ "No such poll: " ++ show poll++closePoll :: VoteState -> VoteWriter -> String -> Cmd Vote String+closePoll fm writer poll = case M.lookup (P.pack poll) fm of+ Nothing -> return $ "No such poll: " ++ show poll+ Just (_,p) -> do writer $ M.update (const (Just (False,p))) (P.pack poll) fm+ return $ "Poll " ++ show poll ++ " closed."
+ src/Lambdabot/Plugin/Social/Seen.hs view
@@ -0,0 +1,332 @@+-- 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 Lambdabot.Plugin.Social.Seen (seenPlugin) where++import Lambdabot.Bot+import Lambdabot.Compat.AltTime+import Lambdabot.Compat.PackedNick+import Lambdabot.IRC+import Lambdabot.Logging+import qualified Lambdabot.Message as G+import Lambdabot.Nick+import Lambdabot.Plugin+import Lambdabot.Util++import Lambdabot.Plugin.Social.Seen.StopWatch+import Lambdabot.Plugin.Social.Seen.UserStatus++import Control.Exception+import Control.Monad+import Control.Monad.Trans+import Data.Binary+import qualified Data.ByteString.Char8 as P+import qualified Data.ByteString.Lazy as L+import Data.Char+import Data.List+import qualified Data.Map as M+import Text.Printf++type SeenState = (MaxMap, SeenMap)+type SeenMap = M.Map PackedNick UserStatus+type MaxMap = M.Map Channel Int++type Seen = ModuleT SeenState LB++------------------------------------------------------------------------++seenPlugin :: Module (M.Map Channel Int, M.Map PackedNick UserStatus)+seenPlugin = newModule+ { moduleDefState = return (M.empty,M.empty)++ , moduleCmds = return+ [ (command "users")+ { help = say "users [chan]. Report the maximum number of users seen in a channel, and active users in the last 30 minutes"+ , process = doUsers+ }+ , (command "seen")+ { help = say "seen <user>. Report if a user has been seen by the bot"+ , process = doSeen+ }+ ]++ , moduleInit = do+ sequence_+ [ ircSignalConnect signal =<< bindModule1 (withSeenFM cb)+ | (signal, cb) <- zip+ ["JOIN", "PART", "QUIT", "NICK", "353", "PRIVMSG"]+ [joinCB, partCB, quitCB, nickCB, joinChanCB, msgCB]+ ]++ c <- lb $ findOrCreateLBFile "seen"+ s <- io $ P.readFile c+ let ls = L.fromChunks [s]+ mbDecoded <- io . try . evaluate $ decode ls+ case mbDecoded of+ Left exc@SomeException{} -> do+ -- try reading the old format (slightly different type... oh, "binary"...)+ mbOld <- io . try . evaluate $ decode ls+ case mbOld of+ Left SomeException{} ->+ warningM ("WARNING: failed to read Seen module state: " ++ show exc)+ Right (maxMap, seenMap) ->+ writeMS (M.mapKeys P.pack maxMap, seenMap)+ Right decoded -> writeMS decoded++ , moduleExit = do+ chans <- lift $ ircGetChannels+ unless (null chans) $ do+ ct <- io getClockTime+ modifyMS $ \(n,m) -> (n, botPart ct (map packNick chans) m)++ -- and write out our state:+ withMS $ \s _ -> lb (findOrCreateLBFile "seen") >>= \ c -> io (encodeFile c s)+ }++lcNick :: Nick -> Nick+lcNick (Nick svr nck) = Nick svr (map toLower nck)++------------------------------------------------------------------------++doUsers :: String -> Cmd Seen ()+doUsers rest = withMsg $ \msg -> do+ -- first step towards tracking the maximum number of users+ chan <- getTarget+ (m, seenFM) <- readMS+ s <- io getClockTime+ let who = packNick $ lcNick $ if null rest then chan else parseNick (G.server msg) rest+ now = length [ () | (_,Present _ chans) <- M.toList seenFM+ , who `elem` chans ]++ n = case M.lookup who m of Nothing -> 1; Just n' -> n'++ active = length [() | (_,st@(Present _ chans)) <- M.toList seenFM+ , who `elem` chans && isActive st ]++ isActive (Present (Just (ct,_td)) _cs) = recent ct+ isActive _ = False++ recent t = diffClockTimes s t < gap_minutes+ gap_minutes = TimeDiff 1800 -- 30 minutes++ percent p q = 100 * (fromIntegral p / fromIntegral q) :: Double++ total 0 0 = "0"+ total p q = printf "%d (%0.1f%%)" p (percent p q)++ say $! printf "Maximum users seen in %s: %d, currently: %s, active: %s"+ (fmtNick (G.server msg) $ unpackNick who) n (total now n) (total active now)++doSeen :: String -> Cmd Seen ()+doSeen rest = withMsg $ \msg -> do+ target <- getTarget+ (_,seenFM) <- readMS+ now <- io getClockTime+ let (txt,safe) = (getAnswer msg rest seenFM now)+ if safe || not ("#" `isPrefixOf` nName target)+ then mapM_ say txt+ else lb (ircPrivmsg (G.nick msg) (unlines txt))++getAnswer :: G.Message a => a -> String -> SeenMap -> ClockTime -> ([String], Bool)+getAnswer msg rest seenFM now+ | null nick' =+ 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 = diffClockTimes now t < gap_minutes+ gap_minutes = TimeDiff 900 -- 15 minutes+ in (["Lately, I have seen " ++ (if null people then "nobody"+ else listToStr "and" (map upAndShow people)) ++ "."], False)++ | pnick == G.lambdabotName msg =+ case M.lookup (packNick pnick) seenFM of+ Just (Present _ cs) ->+ (["Yes, I'm here. I'm in " ++ listToStr "and" (map upAndShow cs)], True)+ _ -> error "I'm here, but not here. And very confused!"++ | head (nName pnick) == '#' =+ let people = map fst $ filter inChan $ M.toList seenFM+ inChan (_nick,state) = case state of+ (Present (Just _) cs)+ -> packNick pnick `elem` cs+ _ -> False+ in (["In "++nick'++" I can see "+ ++ (if null people then "nobody" -- todo, how far back does this go?+ else listToStr "and" (map upAndShow people)) ++ "."], False)++ | otherwise = (return $ concat (case M.lookup (packNick pnick) seenFM of+ Just (Present mct cs) -> nickPresent mct (map upAndShow cs)+ Just (NotPresent ct td chans) -> nickNotPresent ct td (map upAndShow chans)+ Just (WasPresent ct sw _ chans) -> nickWasPresent ct sw (map upAndShow chans)+ Just (NewNick newnick) -> nickIsNew newnick+ _ -> ["I haven't seen ", nick, "."]), True)+ where+ -- I guess the only way out of this spagetty hell are printf-style responses.+ upAndShow = fmtNick (G.server msg) . unpackNick+ nickPresent mct cs =+ [ 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 =+ [ "I saw ", nick, " leaving ", listToStr "and" chans, " "+ , clockDifference ct, prettyMissed missed ", and " ""+ ]+ nickWasPresent ct sw chans =+ [ "Last time I saw ", nick, " was when I left "+ , listToStr "and" chans , " ", clockDifference ct+ , prettyMissed sw ", and " ""+ ]+ nickIsNew newnick =+ [ if you then "You have" else nick++" has"+ , " changed nick to ", us, "."+ ] ++ fst (getAnswer msg us seenFM now)+ where+ us = upAndShow $ findFunc newnick+ findFunc pstr = case M.lookup pstr seenFM of+ Just (NewNick pstr') -> findFunc pstr'+ Just _ -> pstr+ Nothing -> error "SeenModule.nickIsNew: Nothing"++ nick' = takeWhile (not . isSpace) rest+ you = pnick == lcNick (G.nick msg)+ nick = if you then "you" else nick'+ pnick = lcNick $ parseNick (G.server msg) 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 ++ "."+-}++-- | extract channels from message as packed, lower cased, strings.+msgChans :: G.Message a => a -> [Channel]+msgChans = map (packNick . lcNick) . G.channels++-- | 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 :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap+joinCB msg _ct nick fm+ | nick == lbNick = Right fm+ | otherwise = Right $! insertUpd (updateJ Nothing chans) nick newInfo fm+ where+ insertUpd f = M.insertWith (\_ -> f)+ lbNick = packNick $ G.lambdabotName msg+ newInfo = Present Nothing chans+ chans = msgChans msg++-- | Update the state to reflect the bot leaving channel(s)+botPart :: ClockTime -> [Channel] -> SeenMap -> SeenMap+botPart ct cs = fmap botPart'+ 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 :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap+partCB msg ct nick fm+ | nick == lbNick = Right $ botPart ct (msgChans msg) fm+ | otherwise = case M.lookup nick fm of+ Just (Present mct xs) ->+ case xs \\ (msgChans 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"+ where lbNick = packNick $ G.lambdabotName msg++-- | when somebody quits+quitCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap+quitCB _ ct nick fm = 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 :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap+nickCB msg _ nick fm = case M.lookup nick fm of+ Just status -> Right $! M.insert lcnewnick status+ $ M.insert nick (NewNick lcnewnick) fm+ _ -> Left "someone who isn't here changed nick"+ where+ newnick = drop 1 $ head (ircMsgParams msg)+ lcnewnick = packNick $ lcNick $ parseNick (G.server msg) newnick++-- | when the bot joins a channel+joinChanCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap+joinChanCB msg now _nick fm+ = Right $! fmap (updateNP now chan) (foldl insertNick fm chanUsers)+ where+ l = ircMsgParams msg+ chan = packNick $ lcNick $ parseNick (G.server msg) $ l !! 2+ chanUsers = map (packNick . lcNick . parseNick (G.server msg)) $ words (drop 1 (l !! 3)) -- remove ':'+ unUserMode nick = Nick (nTag nick) (dropWhile (`elem` "@+") $ nName nick)+ insertUpd f = M.insertWith (\_ -> f)+ insertNick fm' u = insertUpd (updateJ (Just now) [chan])+ (packNick . unUserMode . lcNick . unpackNick $ u)+ (Present Nothing [chan]) fm'++-- | when somebody speaks, update their clocktime+msgCB :: IrcMessage -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap+msgCB _ ct nick fm =+ 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"+++-- | 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 :: G.Message a+ => (a -> ClockTime -> PackedNick -> SeenMap -> Either String SeenMap)+ -> (a -> Seen ())++withSeenFM f msg = do+ let chan = packNick . lcNick . head . G.channels $! msg+ nick = packNick . lcNick . G.nick $ msg++ withMS $ \(maxUsers,state) writer -> do+ ct <- io getClockTime+ case f msg ct nick state of+ Left _ -> return ()+ Right newstate -> do+ let curUsers = length $!+ [ () | (_,Present _ chans) <- M.toList state+ , chan `elem` chans ]++ newMax = case M.lookup chan maxUsers of+ Nothing -> M.insert chan curUsers maxUsers+ Just n -> if n < curUsers+ then M.insert chan curUsers maxUsers+ else maxUsers++ newMax `seq` newstate `seq` writer (newMax, newstate)
+ src/Lambdabot/Plugin/Social/Seen/StopWatch.hs view
@@ -0,0 +1,30 @@+module Lambdabot.Plugin.Social.Seen.StopWatch where++import Lambdabot.Compat.AltTime++import Data.Binary++data StopWatch+ = Stopped !TimeDiff+ | Running !ClockTime+ deriving (Show,Read)++instance Binary StopWatch where+ put (Stopped td) = putWord8 0 >> put td+ put (Running ct) = putWord8 1 >> put ct++ get = getWord8 >>= \h -> case h of+ 0 -> fmap Stopped get+ 1 -> fmap Running get+ _ -> error "Seen.StopWatch.get"++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
+ src/Lambdabot/Plugin/Social/Seen/UserStatus.hs view
@@ -0,0 +1,77 @@+module Lambdabot.Plugin.Social.Seen.UserStatus where++import Control.Applicative+import Data.Binary+import qualified Data.ByteString as BS+import Data.List+import Lambdabot.Compat.AltTime+import Lambdabot.Compat.PackedNick+import Lambdabot.Plugin.Social.Seen.StopWatch++-- | The type of channels+type Channel = BS.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 !PackedNick+ -- ^ The user changed nick to something new.+ deriving (Show, Read)++instance Binary UserStatus where+ put (Present sp ch) = putWord8 0 >> put sp >> put ch+ put (NotPresent ct sw ch) = putWord8 1 >> put ct >> put sw >> put ch+ put (WasPresent ct sw sp ch) = putWord8 2 >> put ct >> put sw >> put sp >> put ch+ put (NewNick n) = putWord8 3 >> put n++ get = getWord8 >>= \h -> case h of+ 0 -> Present <$> get <*> get+ 1 -> NotPresent <$> get <*> get <*> get+ 2 -> WasPresent <$> get <*> get <*> get <*> get+ 3 -> NewNick <$> get+ _ -> error "Seen.UserStatus.get"++-- | Update the user status when a user joins a channel.+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
+ src/Lambdabot/Plugin/Social/Tell.hs view
@@ -0,0 +1,296 @@+{- Leave a message with lambdabot, the faithful secretary++> 17:11 < davidhouse> @tell dmhouse foo+> 17:11 < hsbot> Consider it noted+> 17:11 < davidhouse> @tell dmhouse bar+> 17:11 < hsbot> Consider it noted+> 17:11 < dmhouse> hello!+> 17:11 < hsbot> dmhouse: You have 2 new messages. '/msg hsbot @messages' to read them.+> 17:11 < dmhouse> Notice how I'm speaking again, and hsbot isn't buzzing me more than that one time.+> 17:12 < dmhouse> It'll buzz me after a day's worth of not checking my messages.+> 17:12 < dmhouse> If I want to check them in the intermittent period, I can either send a /msg, or:+> 17:12 < dmhouse> @messages?+> 17:12 < hsbot> You have 2 messages+> 17:12 < dmhouse> Let's check them, shall we?+>+> [In a /msg to hsbot]+> 17:12 <hsbot> davidhouse said less than a minute ago: foo+> 17:12 <hsbot> davidhouse said less than a minute ago: bar+>+> [Back in the channel+> 17:12 < dmhouse> You needn't use a /msg, however. If you're not going to annoy the channel by printing 20 of+> your messages, feel free to just type '@messages' in the channel.+> 17:12 < davidhouse> @tell dmhouse foobar+> 17:12 < hsbot> Consider it noted+> 17:12 < davidhouse> @ask dmhouse barfoo+> 17:12 < hsbot> Consider it noted+> 17:12 < davidhouse> You can see there @ask. It's just a synonym for @tell, but it prints "foo asked X ago M",+> which is more natural. E.g. '@ask dons whether he's applied my latest patch yet?'+> 17:13 < dmhouse> For the admins, a useful little debugging tool is @print-notices.+> 17:13 < hsbot> dmhouse: You have 2 new messages. '/msg hsbot @messages' to read them.+> 17:14 < dmhouse> Notice that hsbot pinged me there, even though it's less than a day since I last checked my+> messages, because there have been some new ones posted.+> 17:14 < dmhouse> @print-notices+> 17:14 < hsbot> {"dmhouse":=(Just Thu Jun 8 17:13:46 BST 2006,[Note {noteSender = "davidhouse", noteContents =+> "foobar", noteTime = Thu Jun 8 17:12:50 BST 2006, noteType = Tell},Note {noteSender =+ "davidhouse", noteContents = "barfoo", noteTime = Thu Jun 8 17:12:55 BST 2006, noteType = Ask}])}+> 17:15 < dmhouse> There you can see the two notes. The internal state is a map from recipient nicks to a pair of+> (when we last buzzed them about having messages, a list of the notes they've got stacked up).+> 17:16 < dmhouse> Finally, if you don't want to bother checking your messages, then the following command will+> likely be useful.+> 17:16 < dmhouse> @clear-messages+> 17:16 < hsbot> Messages cleared.+> 17:16 < dmhouse> That's all, folks!+> 17:17 < dmhouse> Any comments, queries or complaints to dmhouse@gmail.com. The source should be fairly readable, so+> hack away!+-}++module Lambdabot.Plugin.Social.Tell (tellPlugin) where++import Lambdabot.Compat.AltTime+import Lambdabot.Compat.FreenodeNick+import Lambdabot.Plugin+import Lambdabot.Util++import Control.Monad+import qualified Data.Map as M+import Data.Maybe (fromMaybe)+import Text.Printf (printf)++-- | Was it @tell or @ask that was the original command?+data NoteType = Tell | Ask deriving (Show, Eq, Read)+-- | The Note datatype. Fields self-explanatory.+data Note = Note { noteSender :: FreenodeNick,+ noteContents :: String,+ noteTime :: ClockTime,+ noteType :: NoteType }+ deriving (Eq, Show, Read)+-- | The state. A map of (times we last told this nick they've got messages, the+-- messages themselves, the auto-reply)+type NoticeEntry = (Maybe ClockTime, [Note], Maybe String)+type NoticeBoard = M.Map FreenodeNick NoticeEntry++type Tell = ModuleT NoticeBoard LB++tellPlugin :: Module NoticeBoard+tellPlugin = newModule+ { moduleCmds = return+ [ (command "tell")+ { help = say "tell <nick> <message>. When <nick> shows activity, tell them <message>."+ , process = doTell Tell . words+ }+ , (command "ask")+ { help = say "ask <nick> <message>. When <nick> shows activity, ask them <message>."+ , process = doTell Ask . words+ }+ , (command "messages")+ { help = say "messages. Check your messages, responding in private."+ , process = const (doMessages False)+ }+ , (command "messages-loud")+ { help = say "messages. Check your messages, responding in public."+ , process = const (doMessages True)+ }+ , (command "messages?")+ { help = say "messages?. Tells you whether you have any messages"+ , process = const $ do+ sender <- getSender+ ms <- getMessages sender+ case ms of+ Just _ -> doRemind sender say+ Nothing -> say "Sorry, no messages today."+ }+ , (command "clear-messages")+ { help = say "clear-messages. Clears your messages."+ , process = const $ do+ sender <- getSender+ clearMessages sender+ say "Messages cleared."+ }+ , (command "auto-reply")+ { help = say "auto-reply. Lets lambda-bot auto-reply if someone sends you a message"+ , process = doAutoReply+ }+ , (command "auto-reply?")+ { help = say "auto-reply?. Tells you your auto-reply status"+ , process = const $ do+ sender <- getSender+ a <- getAutoReply sender+ case a of+ Just s -> say $ "Your auto-reply is \"" ++ s ++ "\"."+ Nothing -> say "You do not have an auto-reply message set."+ }+ , (command "clear-auto-reply")+ { help = say "clear-auto-reply. Clears your auto-reply message."+ , process = const $ do+ sender <- getSender+ clearAutoReply sender+ say "Auto-reply message cleared."+ }+ , (command "print-notices")+ { privileged = True+ , help = say "print-notices. Print the current map of notes."+ , process = const ((say . show) =<< readMS)+ }+ , (command "purge-notices")+ { privileged = True+ , help = say $+ "purge-notices [<nick> [<nick> [<nick> ...]]]]. "+ ++ "Clear all notes for specified nicks, or all notices if you don't "+ ++ "specify a nick."+ , process = \args -> do+ users <- mapM readNick (words args)+ if null users+ then writeMS M.empty+ else mapM_ clearMessages users+ say "Messages purged."+ }+ ]+ , moduleDefState = return M.empty+ , moduleSerialize = Just mapSerial+ -- Hook onto contextual. Grab nicks of incoming messages, and tell them+ -- if they have any messages, if it's less than a day since we last did so.+ , contextual = const $ do+ sender <- getSender+ remp <- needToRemind sender+ if remp+ then doRemind sender (lb . ircPrivmsg sender)+ else return ()+ }++-- | Take a note and the current time, then display it+showNote :: ClockTime -> Note -> Cmd Tell String+showNote time note = do+ sender <- showNick (getFreenodeNick (noteSender note))+ let diff = time `diffClockTimes` noteTime note+ ago = case timeDiffPretty diff of+ [] -> "less than a minute"+ pr -> pr+ action = case noteType note of Tell -> "said"; Ask -> "asked"+ return $ printf "%s %s %s ago: %s" sender action ago (noteContents note)++-- | Is it less than a day since we last reminded this nick they've got messages?+needToRemind :: Nick -> Cmd Tell Bool+needToRemind n = do+ st <- readMS+ now <- io getClockTime+ return $ case M.lookup (FreenodeNick n) st of+ Just (Just lastTime, _, _) ->+ let diff = now `diffClockTimes` lastTime+ in diff > TimeDiff 86400+ Just (Nothing, _, _) -> True+ Nothing -> True++-- | Add a note to the NoticeBoard+writeDown :: Nick -> Nick -> String -> NoteType -> Cmd Tell ()+writeDown to from what ntype = do+ time <- io getClockTime+ let note = Note { noteSender = FreenodeNick from,+ noteContents = what,+ noteTime = time,+ noteType = ntype }+ modEntry to $ \(_, ns, a) -> (Nothing, ns ++ [note], a)++-- | Return a user's notes, or Nothing if they don't have any+getMessages :: Nick -> Cmd Tell (Maybe [Note])+getMessages sender = do+ st <- readMS+ return $ case M.lookup (FreenodeNick sender) st of+ Nothing -> Nothing+ Just (_, [], _) -> Nothing+ Just (_, ns, _) -> Just ns++-- | Clear a user's messages.+clearMessages :: Nick -> Cmd Tell ()+clearMessages sender = modEntry sender $ \(_, _, a) -> (Nothing, [], a)++-- | Sets a user's auto-reply message+setAutoReply :: Nick -> String -> Cmd Tell ()+setAutoReply sender msg = modEntry sender $ \(t, ns, _) -> (t, ns, Just msg)++-- | Gets a user's auto-reply message+getAutoReply :: Nick -> Cmd Tell (Maybe String)+getAutoReply sender = fmap (join . fmap (\(_,_,a) -> a) . M.lookup (FreenodeNick sender)) readMS++-- | Clears the auto-reply message+clearAutoReply :: Nick -> Cmd Tell ()+clearAutoReply sender = modEntry sender $ \(t, ns, _) -> (t, ns, Nothing)++-- | Modifies an entry, taking care of missing entries and cleaning up empty entries.+-- (We consider an entry empty even if it still has a timestamp.)+modEntry :: Nick -> (NoticeEntry -> NoticeEntry) -> Cmd Tell ()+modEntry sender f = modifyMS $ M.alter (cleanup . f . fromMaybe empty) (FreenodeNick sender)+ where empty = (Nothing, [], Nothing)+ cleanup (_, [], Nothing) = Nothing+ cleanup e = Just e++-- * Handlers+--++-- | Give a user their messages+doMessages :: Bool -> Cmd Tell ()+doMessages loud = do+ sender <- getSender+ msgs <- getMessages sender+ clearMessages sender++ let tellNote = if loud+ then say+ else lb . ircPrivmsg sender++ case msgs of+ Nothing -> say "You don't have any messages"+ Just mesgs -> do+ time <- io getClockTime+ mapM_ (showNote time >=> tellNote) mesgs++verb :: NoteType -> String+verb Ask = "ask"+verb Tell= "tell"++-- | Execute a @tell or @ask command.+doTell :: NoteType -> [String] -> Cmd Tell ()+doTell ntype [] = say ("Who should I " ++ verb ntype ++ "?")+doTell ntype (who':args) = do+ let who = dropFromEnd (== ':') who'+ recipient <- readNick who+ sender <- getSender+ me <- getLambdabotName+ let rest = unwords args+ (record, res)+ | sender == recipient = (False, "You can " ++ verb ntype ++ " yourself!")+ | recipient == me = (False, "Nice try ;)")+ | null args = (False, "What should I " ++ verb ntype ++ " " ++ who ++ "?")+ | otherwise = (True, "Consider it noted.")+ when record $ do+ autoReply <- getAutoReply recipient+ case autoReply of+ Nothing -> return ()+ Just s -> say $ who ++ " lets you know: " ++ s+ writeDown recipient sender rest ntype+ say res++-- | Execute a @auto-reply+doAutoReply :: String -> Cmd Tell ()+doAutoReply "" = say "No auto-reply message given. Did you mean @clear-auto-reply?"+doAutoReply msg = do+ sender <- getSender+ setAutoReply sender msg+ say "Auto-Reply messages noted. You can check the status with auto-reply? and clear it with clear-auto-reply."++-- | Remind a user that they have messages.+doRemind :: Nick -> (String -> Cmd Tell ()) -> Cmd Tell ()+doRemind sender remind = do+ ms <- getMessages sender+ now <- io getClockTime+ modEntry sender $ \(_,ns,a) -> (Just now, ns, a)+ case ms of+ Just msgs -> do+ me <- showNick =<< getLambdabotName+ let n = length msgs+ (messages, pronoun)+ | n > 1 = ("messages", "them")+ | otherwise = ("message", "it")+ remind $ printf "You have %d new %s. '/msg %s @messages' to read %s."+ n messages me pronoun+ Nothing -> return ()
+ src/Lambdabot/Util/NickEq.hs view
@@ -0,0 +1,59 @@+--+-- | Nickname equality subsystem.+--+-- This component is responsible for deciding whether two nicknames+-- refer to the same person, for the purposes of @tell et al. Nickname+-- equality must be monadic because it uses mutable state maintained+-- by the @link and @unlink commands.+--+-- Also provided is a concept of polynicks (by analogy to polytypes);+-- polynicks can refer to an (open) set of nicknames. For instance '@tell+-- *lambdabot Why does X do Y' could tell a message to anyone who has+-- identified as a lambdabot maintainer. A polynick consists of a+-- bar-separated list of (nicks or open terms); an open term is like a+-- nick but preceded with a star.++module Lambdabot.Util.NickEq+ ( Polynick+ , nickMatches+ , readPolynick+ , showPolynick+ + , lookupMononickMap+ , mononickToPolynick+ ) where++import Lambdabot.Message+import Lambdabot.Monad+import Lambdabot.Nick++import Data.List (intercalate)+import Data.List.Split (splitOn)+import qualified Data.Map as M+import Data.Maybe (mapMaybe)++data Polynick = Polynick [Nick] deriving (Eq) -- for now++-- |Determine if a nick matches a polynick. The state is read at the+-- point of binding.+nickMatches :: LB (Nick -> Polynick -> Bool)+nickMatches = return m'+ where+ m' nck (Polynick nck2) = nck `elem` nck2++-- | Parse a read polynick.+readPolynick :: Message a => a -> String -> Polynick+readPolynick m = Polynick . map (parseNick (server m)) . splitOn "|"++-- | Format a polynick.+showPolynick :: Message a => a -> Polynick -> String+showPolynick m (Polynick n) = intercalate "|" $ map (fmtNick (server m)) n++-- | Convert a regular mononick into a polynick.+mononickToPolynick :: Nick -> Polynick+mononickToPolynick = Polynick . (:[])++-- | Lookup (using a polynick) in a map keyed on mononicks.+lookupMononickMap :: LB (Polynick -> M.Map Nick a -> [(Nick,a)])+lookupMononickMap = return $ look'+ where look' (Polynick ns) m = mapMaybe (\n -> (,) n `fmap` M.lookup n m) ns