lambdabot-irc-plugins (empty) → 5.0

raw patch · 8 files changed

+667/−0 lines, 8 filesdep +SafeSemaphoredep +basedep +bytestringsetup-changed

Dependencies added: SafeSemaphore, base, bytestring, containers, directory, filepath, lambdabot-core, lifted-base, mtl, network, split, time

Files

• LICENSE +22/−0
• Setup.hs +3/−0
• lambdabot-irc-plugins.cabal +55/−0
• src/Lambdabot/Plugin/IRC.hs +16/−0
• src/Lambdabot/Plugin/IRC/IRC.hs +190/−0
• src/Lambdabot/Plugin/IRC/Localtime.hs +66/−0
• src/Lambdabot/Plugin/IRC/Log.hs +203/−0
• src/Lambdabot/Plugin/IRC/Topic.hs +112/−0

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

@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+import Distribution.Simple+main = defaultMainWithHooks defaultUserHooks

@@ -0,0 +1,55 @@+name:                   lambdabot-irc-plugins+version:                5.0++license:                GPL+license-file:           LICENSE++author:                 Don Stewart+maintainer:             James Cook <mokus@deepbondi.net>++category:               Development, Web+synopsis:               IRC plugins for lambdabot.+description:            Lambdabot is an IRC bot written over several years by+                        those on the #haskell IRC channel.+                        .+                        Provided plugins:+                        .+                        [irc] Lets lambdabot connect to IRC.+                        [localtime] Check user's local time.+                        [log] Log IRC channels.+                        [topic] Modify channel topics.++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.IRC++  other-modules:        Lambdabot.Plugin.IRC.IRC+                        Lambdabot.Plugin.IRC.Localtime+                        Lambdabot.Plugin.IRC.Log+                        Lambdabot.Plugin.IRC.Topic++  build-depends:        base                    >= 4.4 && < 5,+                        bytestring              >= 0.9,+                        containers              >= 0.4,+                        directory               >= 1.1,+                        filepath                >= 1.3,+                        lambdabot-core          >= 5 && < 5.1,+                        lifted-base             >= 0.2,+                        mtl                     >= 2,+                        network                 >= 2.3.0.13,+                        time                    >= 1.4,+                        SafeSemaphore           >= 0.9,+                        split                   >= 0.2

@@ -0,0 +1,16 @@+module Lambdabot.Plugin.IRC+    ( ircPlugin+    , localtimePlugin+    , logPlugin+    , topicPlugin+    +    , ircPlugins+    ) where++import Lambdabot.Plugin.IRC.IRC+import Lambdabot.Plugin.IRC.Localtime+import Lambdabot.Plugin.IRC.Log+import Lambdabot.Plugin.IRC.Topic++ircPlugins :: [String]+ircPlugins = ["irc", "localtime", "log", "topic"]

@@ -0,0 +1,190 @@+-- | The plugin-level IRC interface.++module Lambdabot.Plugin.IRC.IRC (ircPlugin) where++import Lambdabot.IRC+import Lambdabot.Logging+import Lambdabot.Monad+import Lambdabot.Plugin+import Lambdabot.Util++import Control.Concurrent.Lifted+import qualified Control.Concurrent.SSem as SSem+import Control.Exception.Lifted as E (SomeException(..), throwIO, catch)+import Control.Monad+import Control.Monad.Trans+import qualified Data.ByteString.Char8 as P+import Data.List+import Data.List.Split+import Network( connectTo, PortID(..) )+import System.IO+import System.Timeout.Lifted+import Data.IORef++data IRCState =+    IRCState {+        password :: Maybe String+    }++type IRC = ModuleT IRCState LB++ircPlugin :: Module IRCState+ircPlugin = newModule+    { moduleCmds = return+        [ (command "irc-connect")+            { privileged = True+            , help = say "irc-connect tag host portnum nickname userinfo.  connect to an irc server"+            , process = \rest ->+                case splitOn " " rest of+                    tag:hostn:portn:nickn:uix -> do+                        pn <- (PortNumber . fromInteger) `fmap` readM portn+                        lift (online tag hostn pn nickn (intercalate " " uix))+                    _ -> say "Not enough parameters!"+            }+        , (command "irc-password")+            { privileged = True+            , help = say "irc-password pwd.  set password for next irc-connect command"+            , process = \rest ->+                case splitOn " " rest of+                    pwd:_ -> do+                        modifyMS (\ms -> ms{ password = Just pwd })+                    _ -> say "Not enough parameters!"+            }+        ]+    , moduleDefState = return $ IRCState{ password = Nothing }+    }++----------------------------------------------------------------------+-- Encoding and decoding of messages++-- | 'encodeMessage' takes a message and converts it to a function.+--   giving this function a string will attach the string to the message+--   and output a string containing IRC protocol commands ready for writing+--   on the outgoing stream socket.+encodeMessage :: IrcMessage -> String -> String+encodeMessage msg+  = encodePrefix (ircMsgPrefix msg) . encodeCommand (ircMsgCommand msg)+          . encodeParams (ircMsgParams msg)+  where+    encodePrefix [] = id+    encodePrefix prefix = showChar ':' . showString prefix . showChar ' '++    encodeCommand cmd = showString cmd++    encodeParams [] = id+    encodeParams (p:ps) = showChar ' ' . showString p . encodeParams ps++-- | 'decodeMessage' Takes an input line from the IRC protocol stream+--   and decodes it into a message.  TODO: this has too many parameters.+decodeMessage :: String -> String -> String -> IrcMessage+decodeMessage svr lbn line =+    let (prefix, rest1) = decodePrefix (,) line+        (cmd, rest2)    = decodeCmd (,) rest1+        params          = decodeParams rest2+    in IrcMessage { ircMsgServer = svr, ircMsgLBName = lbn, ircMsgPrefix = prefix,+                    ircMsgCommand = cmd, ircMsgParams = params }+  where+    decodePrefix k (':':cs) = decodePrefix' k cs+      where decodePrefix' j ""       = j "" ""+            decodePrefix' j (' ':ds) = j "" ds+            decodePrefix' j (c:ds)   = decodePrefix' (j . (c:)) ds++    decodePrefix k cs = k "" cs++    decodeCmd k []       = k "" ""+    decodeCmd k (' ':cs) = k "" cs+    decodeCmd k (c:cs)   = decodeCmd (k . (c:)) cs++    decodeParams :: String -> [String]+    decodeParams xs = decodeParams' [] [] xs+      where+        decodeParams' param params []+          | null param = reverse params+          | otherwise  = reverse (reverse param : params)+        decodeParams' param params (' ' : cs)+          | null param = decodeParams' [] params cs+          | otherwise  = decodeParams' [] (reverse param : params) cs+        decodeParams' param params rest@(c@':' : cs)+          | null param = reverse (rest : params)+          | otherwise  = decodeParams' (c:param) params cs+        decodeParams' param params (c:cs) = decodeParams' (c:param) params cs++ircSignOn :: String -> Nick -> Maybe String -> String -> LB ()+ircSignOn svr nickn pwd ircname = do+    maybe (return ()) (\pwd' -> send $ pass (nTag nickn) pwd') pwd+    send $ user (nTag nickn) (nName nickn) svr ircname+    send $ setNick nickn++------------------------------------------------------------------------+--+-- Lambdabot is mostly synchronous.  We have a main loop, which reads+-- messages and forks threads to execute commands (which write responces).+-- OR+-- We have a main loop which reads offline commands, and synchronously+-- interprets them.++online :: String -> String -> PortID -> String -> String -> IRC ()+online tag hostn portnum nickn ui = do+    sock    <- io $ connectTo hostn portnum+    io $ hSetBuffering sock NoBuffering+    -- Implements flood control: RFC 2813, section 5.8+    sem1    <- io $ SSem.new 0+    sem2    <- io $ SSem.new 4 -- one extra token stays in the MVar+    sendmv  <- io newEmptyMVar+    pongref <- io $ newIORef False+    io . void . fork . forever $ do+        SSem.wait sem1+        threadDelay 2000000+        SSem.signal sem2+    io . void . fork . forever $ do+        SSem.wait sem2+        putMVar sendmv ()+        SSem.signal sem1+    E.catch +        (addServer tag (io . sendMsg sock sendmv))+        (\err@SomeException{} -> io (hClose sock) >> E.throwIO err)+    pwd <- password `fmap` readMS+    modifyMS $ \ms -> ms{ password = Nothing }+    lb $ ircSignOn hostn (Nick tag nickn) pwd ui+    lb . void . fork $ E.catch+        (readerLoop tag nickn pongref sock)+        (\e@SomeException{} -> do+            errorM (show e)+            remServer tag)+    lb . void . fork $ E.catch+        (pingPongDelay >> pingPongLoop tag hostn pongref sock)+        (\e@SomeException{} -> do+            errorM (show e)+            remServer tag)++pingPongDelay :: LB ()+pingPongDelay = io $ threadDelay 120000000++pingPongLoop :: String -> String -> IORef Bool -> Handle -> LB ()+pingPongLoop tag hostn pongref sock = do+    io $ writeIORef pongref False+    io $ P.hPut sock $ P.pack $ "PING " ++ hostn ++ "\r\n"+    pingPongDelay+    pong <- io $ readIORef pongref+    if pong+        then pingPongLoop tag hostn pongref sock+        else errorM "Ping timeout." >> remServer tag++readerLoop :: String -> String -> IORef Bool -> Handle -> LB ()+readerLoop tag nickn pongref sock = forever $ do+    line <- io $ hGetLine sock+    let line' = filter (`notElem` "\r\n") line+    if "PING " `isPrefixOf` line'+        then io $ P.hPut sock $ P.pack $ "PONG " ++ drop 5 line' ++ "\r\n"+        else void . fork . void . timeout 15000000 $ do+            let msg = decodeMessage tag nickn line'+            if ircMsgCommand msg == "PONG"+                then io $ writeIORef pongref True+                else received msg++sendMsg :: Handle -> MVar () -> IrcMessage -> IO ()+sendMsg sock mv msg =+    E.catch (do takeMVar mv+                P.hPut sock $ P.pack $ encodeMessage msg "\r\n")+            (\err -> do errorM (show (err :: IOError))+                        hClose sock)

@@ -0,0 +1,66 @@+{-# LANGUAGE TypeFamilies #-}++-- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons+-- GPL version 2 or later (see http://www.gnu.org/copyleft/gpl.html)++-- | Simple wrapper over privmsg to get time information via the CTCP+module Lambdabot.Plugin.IRC.Localtime (localtimePlugin) where++import Lambdabot.Plugin+import Lambdabot.Bot (ircPrivmsg')+import qualified Data.Map as M++type TimeMap = M.Map Nick  -- the person who's time we requested+                    [Nick] -- a list of targets waiting on this time++localtimePlugin :: Module TimeMap+localtimePlugin = newModule+    { moduleDefState = return M.empty++    , moduleCmds = return+        [ (command "time")+            { aliases = ["localtime"]+            , help = say "time <user>. Print a user's local time. User's client must support ctcp pings."+            , process = doLocalTime+            }+        , (command "localtime-reply")+            { help = say "time <user>. Print a user's local time. User's client must support ctcp pings."+            , process = doReply+            }+        ]+    } :: Module TimeMap++-- record this person as a callback, for when we (asynchronously) get a result+doLocalTime :: (MonadLBState m, LBState m ~ M.Map Nick [Nick]) =>+               [Char] -> Cmd m ()+doLocalTime [] = do+    n <- getSender+    doLocalTime (nName n)++doLocalTime rawWho = do+    whoAsked <- getTarget+    whoToPing <- readNick $ fst $ break (== ' ') rawWho+    me <- getLambdabotName+    if whoToPing /= me+        then do+            modifyMS $ \st -> M.insertWith (++) whoToPing [whoAsked] st+            -- this is a CTCP time call, which returns a NOTICE+            lb $ ircPrivmsg' whoToPing ("\^ATIME\^A")     -- has to be raw+        else say "I live on the internet, do you expect me to have a local time?"++-- the Base module caught the NOTICE TIME, mapped it to a PRIVMGS, and here it is :)+doReply :: (MonadLBState m, LBState m ~ M.Map Nick [Nick]) =>+           [Char] -> Cmd m ()+doReply text = do+    let (whoGotPinged', time') = break (== ':') text+        time = drop 1 time'+    whoGotPinged <- readNick whoGotPinged'++    targets <- withMS $ \st set -> do+        case M.lookup whoGotPinged st of+            Nothing -> return []+            Just xs -> do set (M.insert whoGotPinged [] st) -- clear the callback state+                          return xs+    whoGotPinged'' <- showNick whoGotPinged+    let txt = "Local time for " ++ whoGotPinged'' ++ " is " ++ time+    lb $ flip mapM_ targets $ flip ircPrivmsg' txt

@@ -0,0 +1,203 @@+-- Copyright (c) 2004 Thomas Jaeger+-- Copyright (c) 2005 Simon Winwood+-- Copyright (c) 2005 Don Stewart+-- Copyright (c) 2005 David House <dmouse@gmail.com>+--+-- | Logging an IRC channel..+--+module Lambdabot.Plugin.IRC.Log (logPlugin) where++import Lambdabot.Bot+import Lambdabot.Compat.FreenodeNick+import Lambdabot.IRC+import qualified Lambdabot.Message as Msg+import Lambdabot.Nick+import Lambdabot.Plugin+import Lambdabot.Util++import Control.Monad+import qualified Data.Map as M+import Data.Time+import System.Directory (createDirectoryIfMissing)+import System.FilePath+import System.IO++-- ------------------------------------------------------------------------++type Channel = Nick++type DateStamp = (Int, Int, Integer)+data ChanState = CS { chanHandle  :: Handle,+                      chanDate    :: DateStamp }+               deriving (Show, Eq)+type LogState = M.Map Channel ChanState+type Log = ModuleT LogState LB++data Event =+    Said Nick UTCTime String+    | Joined Nick String UTCTime+    | Parted Nick String UTCTime -- covers quitting as well+    | Renick Nick String UTCTime Nick+    deriving (Eq)++instance Show Event where+    show (Said nick ct what)      = timeStamp ct ++ " <" ++ nName nick ++ "> " ++ what+    show (Joined nick usr ct)     = timeStamp ct ++ " " ++ show (FreenodeNick nick)+                                    ++ " (" ++ usr ++ ") joined."+    show (Parted nick usr ct)     = timeStamp ct ++ " " ++ show (FreenodeNick nick)+                                    ++ " (" ++ usr ++ ") left."+    show (Renick nick usr ct new) = timeStamp ct ++ " " ++ show  (FreenodeNick nick)+                                    ++ " (" ++ usr ++ ") is now " ++ show (FreenodeNick new) ++ "."++-- * Dispatchers and Module instance declaration+--+logPlugin :: Module (M.Map Channel ChanState)+logPlugin = newModule+    { moduleDefState  = return M.empty+    , moduleExit      = cleanLogState+    , moduleInit      = do+        let doLog f m hdl = logString hdl . show . f m+            wrapCB f = bindModule1 $ \msg -> do+                now <- io getCurrentTime+                -- map over the channels this message was directed to, adding to each+                -- of their log files.+                mapM_ (withValidLog (doLog f msg) now) (Msg.channels msg)+            connect signal cb = ircSignalConnect signal =<< wrapCB cb++        connect "PRIVMSG" msgCB+        connect "JOIN"    joinCB+        connect "PART"    partCB+        connect "NICK"    nickCB+    }++-- * Logging helpers+--++-- | Show a number, padded to the left with zeroes up to the specified width+showWidth :: Int    -- ^ Width to fill to+          -> Int    -- ^ Number to show+          -> String -- ^ Padded string+showWidth width n = zeroes ++ num+    where num    = show n+          zeroes = replicate (width - length num) '0'++timeStamp :: UTCTime -> String+timeStamp (UTCTime _ ct) =+    (showWidth 2 (hours `mod` 24)) ++ ":" +++    (showWidth 2 (mins  `mod` 60)) ++ ":" +++    (showWidth 2 (secs  `mod` 60))+    where+        secs  = round ct :: Int+        mins  = secs `div` 60+        hours = mins `div` 60++-- | Show a DateStamp.+dateToString :: DateStamp -> String+dateToString (d, m, y) = (showWidth 2 $ fromInteger y) ++ "-" +++                         (showWidth 2 $ fromEnum m + 1) ++ "-" +++                         (showWidth 2 d)++-- | UTCTime -> DateStamp conversion+dateStamp :: UTCTime -> DateStamp+dateStamp (UTCTime day _) = (d, m, y)+    where (y,m,d) = toGregorian day++-- * State manipulation functions+--++-- | Cleans up after the module (closes files)+cleanLogState :: Log ()+cleanLogState =+    withMS $ \state writer -> do+      io $ M.fold (\cs iom -> iom >> hClose (chanHandle cs)) (return ()) state+      writer M.empty++-- | Fetch a channel from the internal map. Uses LB's fail if not found.+getChannel :: Channel -> Log ChanState+getChannel c = (readMS >>=) . mLookup $ c+    where mLookup k = maybe (fail "getChannel: not found") return . M.lookup k++getDate :: Channel -> Log DateStamp+getDate c = fmap chanDate . getChannel $ c++getHandle :: Channel -> Log Handle+getHandle c = fmap chanHandle . getChannel $ c+    -- add points. otherwise:+    -- Unbound implicit parameters (?ref::GHC.IOBase.MVar LogState, ?name::String)+    --  arising from instantiating a type signature at+    -- Plugin/Log.hs:187:30-39+    -- Probable cause: `getChannel' is applied to too few arguments++-- | Put a DateStamp and a Handle. Used by 'openChannelFile' and+--  'reopenChannelMaybe'.+putHdlAndDS :: Channel -> Handle -> DateStamp -> Log ()+putHdlAndDS c hdl ds =+        modifyMS (M.adjust (\cs -> cs {chanHandle = hdl, chanDate = ds}) c)+++-- * Logging IO+--++-- | Open a file to write the log to.+openChannelFile :: Channel -> UTCTime -> Log Handle+openChannelFile chan ct = do+    stateDir <- getConfig outputDir+    let dir  = stateDir </> "Log" </> nTag chan </> nName chan+        file = dir </> (dateToString date) <.> "txt"+    io $ createDirectoryIfMissing True dir >> openFile file AppendMode+    where date = dateStamp ct++-- | Close and re-open a log file, and update the state.+reopenChannelMaybe :: Channel -> UTCTime -> Log ()+reopenChannelMaybe chan ct = do+  date <- getDate chan+  when (date /= dateStamp ct) $ do+    hdl <- getHandle chan+    io $ hClose hdl+    hdl' <- openChannelFile chan ct+    putHdlAndDS chan hdl' (dateStamp ct)++-- | Initialise the channel state (if it not already inited)+initChannelMaybe :: Nick -> UTCTime -> Log ()+initChannelMaybe chan ct = do+  chanp <- liftM (M.member chan) readMS+  unless chanp $ do+    hdl <- openChannelFile chan ct+    modifyMS (M.insert chan $ CS hdl (dateStamp ct))++-- | Ensure that the log is correctly initialised etc.+withValidLog :: (Handle -> UTCTime -> Log a) -> UTCTime -> Channel -> Log a+withValidLog f ct chan = do+  initChannelMaybe chan ct+  reopenChannelMaybe chan ct+  hdl <- getHandle chan+  rv <- f hdl ct+  return rv++-- | Log a string. Main logging workhorse.+logString :: Handle -> String -> Log ()+logString hdl str = io $ hPutStrLn hdl str >> hFlush hdl+  -- We flush on each operation to ensure logs are up to date.++-- * The event loggers themselves+--++-- | When somebody joins.+joinCB :: IrcMessage -> UTCTime -> Event+joinCB msg ct = Joined (Msg.nick msg) (Msg.fullName msg) ct++-- | When somebody quits.+partCB :: IrcMessage -> UTCTime -> Event+partCB msg ct = Parted (Msg.nick msg) (Msg.fullName msg) ct++-- | When somebody changes his\/her name.+-- TODO:  We should only do this for channels that the user is currently on.+nickCB :: IrcMessage -> UTCTime -> Event+nickCB msg ct = Renick (Msg.nick msg) (Msg.fullName msg) ct+                       (parseNick (Msg.server msg) $ drop 1 $ head $ ircMsgParams msg)++-- | When somebody speaks.+msgCB :: IrcMessage -> UTCTime -> Event+msgCB msg ct = Said (Msg.nick msg) ct+                    (tail . concat . tail $ ircMsgParams msg)+                      -- each lines is :foo

@@ -0,0 +1,112 @@+-- | The Topic plugin is an interface for messing with the channel topic.+--   It can alter the topic in various ways and keep track of the changes.+--   The advantage of having the bot maintain the topic is that we get an+--   authoritative source for the current topic, when the IRC server decides+--   to delete it due to Network Splits.+module Lambdabot.Plugin.IRC.Topic (topicPlugin) where++import Lambdabot.IRC+import Lambdabot.Monad+import Lambdabot.Plugin+import Lambdabot.Util++import qualified Data.Map as M++import Control.Monad.State (gets)++type Topic = ModuleT () LB++type TopicAction = Nick -> String -> Cmd Topic ()+data TopicCommand = TopicCommand+    { _commandAliases    :: [String]+    , _commandHelp       :: String+    , _invokeCommand     :: TopicAction+    }++commands :: [TopicCommand]+commands =+    [ TopicCommand ["set-topic"]+      "Set the topic of the channel, without using all that listy stuff"+      (installTopic)+    , TopicCommand ["get-topic"]+      "Recite the topic of the channel"+      (reciteTopic)++    , TopicCommand ["unshift-topic", "queue-topic"]+      "Add a new topic item to the front of the topic list"+      (alterListTopic (:))+    , TopicCommand ["shift-topic"]+      "Remove a topic item from the front of the topic list"+      (alterListTopic (const tail))++    , TopicCommand ["push-topic"]+      "Add a new topic item to the end of the topic stack"+      (alterListTopic (\arg -> (++ [arg])))+    , TopicCommand ["pop-topic", "dequeue-topic"]+      "Pop an item from the end of the topic stack"+      (alterListTopic (const init))++    , TopicCommand ["clear-topic"]+      "Empty the topic stack"+      (alterListTopic (\_ _ -> []))+    ]++topicPlugin :: Module ()+topicPlugin = newModule+    { moduleCmds = return+        [ (command name)+            { help = say helpStr+            , aliases = aliases'+            , process = \args -> do+                tgt <- getTarget+                (chan, rest) <- case splitFirstWord args of+                        (c@('#':_), r)  -> do+                            c' <- readNick c+                            return (Just c', r)+                        _               -> case nName tgt of+                            ('#':_)         -> return (Just tgt, args)+                            _               -> return (Nothing, args)++                case chan of+                    Just chan' -> invoke chan' rest+                    Nothing    -> say "What channel?"+            }+        | TopicCommand (name:aliases') helpStr invoke <- commands+        ]+    }++------------------------------------------------------------------------+-- Topic action implementations++installTopic :: TopicAction+installTopic chan topic = withTopic chan $ \_ -> do+    lb (send (setTopic chan topic))++reciteTopic :: TopicAction+reciteTopic chan ""       = withTopic chan $ \topic -> do+    say (nName chan ++ ": " ++ topic)+reciteTopic _ ('#':_)     = say "One channel at a time.  Jeepers!"+reciteTopic _ _           = say "I don't know what all that extra stuff is about."++alterTopic :: (String -> String -> String) -> TopicAction+alterTopic f chan args = withTopic chan $ \oldTopic -> do+    lb (send (setTopic chan (f args oldTopic)))++alterListTopic :: (String -> [String] -> [String]) -> TopicAction+alterListTopic f = alterTopic $ \args topic -> show $ case reads topic of+    [(xs, "")]  -> f args xs+    _           -> f args [topic]++------------------------------------------------------------------------++lookupTopic :: Nick -> LB (Maybe String)+lookupTopic chan = gets (\s -> M.lookup (mkCN chan) (ircChannels s))++-- | 'withTopic' is like 'lookupTopic' except that it ditches the Maybe in+--   favor of just yelling at the user when things don't work out as planned.+withTopic :: Nick -> (String -> Cmd Topic ()) -> Cmd Topic ()+withTopic chan f = do+    maybetopic <- lb (lookupTopic chan)+    case maybetopic of+        Just t  -> f t+        Nothing -> say "I don't know that channel."