module Lambdabot
( ircLoadModule
, ircUnloadModule
, ircSignalConnect
, ircInstallOutputFilter
, checkPrivs
, checkIgnore
, ircGetChannels
, ircQuit
, ircReconnect
, ircPrivmsg
, ircPrivmsg'
) where
import Lambdabot.ChanName
import Lambdabot.Command
import Lambdabot.IRC
import Lambdabot.Logging
import Lambdabot.Message
import Lambdabot.Module
import Lambdabot.Monad
import Lambdabot.Nick
import Lambdabot.OutputFilter
import Lambdabot.State
import Lambdabot.Util
import Control.Concurrent
import Control.Exception.Lifted
import Control.Monad.Error
import Control.Monad.Reader
import Control.Monad.State
import qualified Data.Map as M
import Data.Random.Source
import qualified Data.Set as S
ircLoadModule :: Module st -> String -> LB ()
ircLoadModule m modname = do
infoM ("Loading module " ++ show modname)
savedState <- readGlobalState m modname
state' <- maybe (moduleDefState m) return savedState
ref <- io $ newMVar state'
let modref = ModuleRef m ref modname
cmdref = CommandRef m ref modname
mbCmds <- flip runReaderT (ref, modname) . runModuleT $ do
initResult <- try (moduleInit m)
case initResult of
Left e -> return (Left e)
Right{} -> try (moduleCmds m)
case mbCmds of
Left e@SomeException{} -> do
errorM ("Module " ++ show modname ++ " failed to load. Exception thrown: " ++ show e)
fail "Refusing to load due to a broken plugin"
Right cmds -> do
s <- get
let modmap = ircModules s
cmdmap = ircCommands s
put s {
ircModules = M.insert modname modref modmap,
ircCommands = M.union (M.fromList [ (name,cmdref cmd) | cmd <- cmds, name <- cmdNames cmd ]) cmdmap
}
ircUnloadModule :: String -> LB ()
ircUnloadModule modname = do
infoM ("Unloading module " ++ show modname)
withModule modname (error "module not loaded") $ \m -> do
when (moduleSticky m) $ fail "module is sticky"
exitResult <- try (moduleExit m)
case exitResult of
Right{} -> return ()
Left e@SomeException{} -> errorM ("Module " ++ show modname ++ " threw the following exception in moduleExit: " ++ show e)
writeGlobalState m modname
s <- get
let modmap = ircModules s
cmdmap = ircCommands s
cbs = ircCallbacks s
svrs = ircServerMap s
ofs = ircOutputFilters s
put s
{ ircCommands = M.filter (\(CommandRef _ _ name _) -> name /= modname) cmdmap
, ircModules = M.delete modname modmap
, ircCallbacks = filter ((/=modname) . fst) `fmap` cbs
, ircServerMap = M.filter ((/=modname) . fst) svrs
, ircOutputFilters = filter ((/=modname) . fst) ofs
}
ircSignalConnect :: String -> Callback -> ModuleT mod LB ()
ircSignalConnect str f = do
s <- lift get
let cbs = ircCallbacks s
name <- getModuleName
case M.lookup str cbs of
Nothing -> lift (put s { ircCallbacks = M.insert str [(name,f)] cbs})
Just fs -> lift (put s { ircCallbacks = M.insert str ((name,f):fs) cbs})
ircInstallOutputFilter :: OutputFilter LB -> ModuleT mod LB ()
ircInstallOutputFilter f = do
name <- getModuleName
lift . modify $ \s ->
s { ircOutputFilters = (name, f): ircOutputFilters s }
checkPrivs :: IrcMessage -> LB Bool
checkPrivs msg = gets (S.member (nick msg) . ircPrivilegedUsers)
checkIgnore :: IrcMessage -> LB Bool
checkIgnore msg = liftM2 (&&) (liftM not (checkPrivs msg))
(gets (S.member (nick msg) . ircIgnoredUsers))
ircGetChannels :: LB [Nick]
ircGetChannels = (map getCN . M.keys) `fmap` gets ircChannels
ircQuit :: String -> String -> LB ()
ircQuit svr msg = do
modify $ \state' -> state' { ircStayConnected = False }
send $ quit svr msg
liftIO $ threadDelay 1000
noticeM "Quitting"
ircReconnect :: String -> String -> LB ()
ircReconnect svr msg = do
send $ quit svr msg
liftIO $ threadDelay 1000
ircPrivmsg :: Nick
-> String
-> LB ()
ircPrivmsg who msg = do
filters <- gets ircOutputFilters
sendlines <- foldr (\f -> (=<<) (f who)) ((return . lines) msg) $ map snd filters
mapM_ (\s -> ircPrivmsg' who (take textwidth s)) (take 10 sendlines)
ircPrivmsg' :: Nick -> String -> LB ()
ircPrivmsg' who "" = ircPrivmsg' who " "
ircPrivmsg' who msg = send $ privmsg who msg
monadRandom [d|
instance MonadRandom LB where
getRandomWord8 = LB (lift getRandomWord8)
getRandomWord16 = LB (lift getRandomWord16)
getRandomWord32 = LB (lift getRandomWord32)
getRandomWord64 = LB (lift getRandomWord64)
getRandomDouble = LB (lift getRandomDouble)
getRandomNByteInteger n = LB (lift (getRandomNByteInteger n))
|]