    {-# LANGUAGE GADTs #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    -- | The guts of lambdabot.
    --
    -- The LB/Lambdabot monad
    -- Generic server connection,disconnection
    -- The module typeclass, type and operations on modules
    module Lambdabot.Bot
        ( ircLoadModule
        , ircUnloadModule
        , checkPrivs
        , checkIgnore

        , ircCodepage
        , ircGetChannels
        , ircQuit
        , ircReconnect
        , ircPrivmsg
        , ircPrivmsg'
        ) where

    import Lambdabot.ChanName
    import Lambdabot.Config
    import Lambdabot.Config.Core
    import Lambdabot.IRC
    import Lambdabot.Logging
    import Lambdabot.Message
    import Lambdabot.Module
    import Lambdabot.Monad
    import Lambdabot.Nick
    import Lambdabot.State

    import Control.Concurrent
    import Control.Exception.Lifted as E
    import Control.Monad
    import Control.Monad.Reader
    import Control.Monad.State
    import qualified Data.Map as M
    import qualified Data.Set as S

    ------------------------------------------------------------------------
    --
    -- | Register a module in the irc state
    --
    ircLoadModule :: String -> Module st -> LB ()
    ircLoadModule :: forall st. String -> Module st -> LB ()
    ircLoadModule String
    mName Module st
    m = do
        String -> LB ()
    forall (m :: * -> *). MonadLogging m => String -> m ()
    infoM (String
    "Loading module " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    mName)

        savedState <- Module st -> String -> LB (Maybe st)
    forall st. Module st -> String -> LB (Maybe st)
    readGlobalState Module st
    m String
    mName
        mState     <- maybe (moduleDefState m) return savedState

        mInfo       <- registerModule mName m mState

        flip runModuleT mInfo (do
                moduleInit m
                registerCommands =<< moduleCmds m)
            `E.catch` \e :: SomeException
    e@SomeException{} -> do
                String -> LB ()
    forall (m :: * -> *). MonadLogging m => String -> m ()
    errorM (String
    "Module " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    mName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " failed to load.  Exception thrown: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)

                String -> LB ()
    unregisterModule String
    mName
                String -> LB ()
    forall a. String -> LB a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "Refusing to load due to a broken plugin"

    --
    -- | Unregister a module's entry in the irc state
    --
    ircUnloadModule :: String -> LB ()
    ircUnloadModule :: String -> LB ()
    ircUnloadModule String
    mName = do
        String -> LB ()
    forall (m :: * -> *). MonadLogging m => String -> m ()
    infoM (String
    "Unloading module " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    mName)

        String -> LB () -> (forall st. ModuleT st LB ()) -> LB ()
    forall a. String -> LB a -> (forall st. ModuleT st LB a) -> LB a
    inModuleNamed String
    mName (String -> LB ()
    forall a. String -> LB a
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail String
    "module not loaded") ((forall st. ModuleT st LB ()) -> LB ())
    -> (forall st. ModuleT st LB ()) -> LB ()
    forall a b. (a -> b) -> a -> b
    $ do
            m <- (ModuleInfo st -> Module st) -> ModuleT st LB (Module st)
    forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
    asks ModuleInfo st -> Module st
    forall st. ModuleInfo st -> Module st
    theModule
            when (moduleSticky m) $ fail "module is sticky"

            moduleExit m
                `E.catch` \e :: SomeException
    e@SomeException{} ->
                    String -> ModuleT st LB ()
    forall (m :: * -> *). MonadLogging m => String -> m ()
    errorM (String
    "Module " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String -> String
    forall a. Show a => a -> String
    show String
    mName String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ String
    " threw the following exception in moduleExit: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e)

            writeGlobalState

        String -> LB ()
    unregisterModule String
    mName

    ------------------------------------------------------------------------

    -- | Checks whether the given user has admin permissions
    checkPrivs :: IrcMessage -> LB Bool
    checkPrivs :: IrcMessage -> LB Bool
    checkPrivs IrcMessage
    msg = (IRCRWState -> Bool) -> LB Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Nick -> Set Nick -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member (IrcMessage -> Nick
    forall a. Message a => a -> Nick
    nick IrcMessage
    msg) (Set Nick -> Bool)
    -> (IRCRWState -> Set Nick) -> IRCRWState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IRCRWState -> Set Nick
    ircPrivilegedUsers)

    -- | Checks whether the given user is being ignored.
    --   Privileged users can't be ignored.
    checkIgnore :: IrcMessage -> LB Bool
    checkIgnore :: IrcMessage -> LB Bool
    checkIgnore IrcMessage
    msg = (Bool -> Bool -> Bool) -> LB Bool -> LB Bool -> LB Bool
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 Bool -> Bool -> Bool
    (&&) ((Bool -> Bool) -> LB Bool -> LB Bool
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM Bool -> Bool
    not (IrcMessage -> LB Bool
    checkPrivs IrcMessage
    msg))
                      ((IRCRWState -> Bool) -> LB Bool
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Nick -> Set Nick -> Bool
    forall a. Ord a => a -> Set a -> Bool
    S.member (IrcMessage -> Nick
    forall a. Message a => a -> Nick
    nick IrcMessage
    msg) (Set Nick -> Bool)
    -> (IRCRWState -> Set Nick) -> IRCRWState -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IRCRWState -> Set Nick
    ircIgnoredUsers))

    ------------------------------------------------------------------------
    -- Some generic server operations

    -- Send a CODEPAGE command to set encoding for current session.
    -- Some IRC networks don't provide UTF-8 ports, but allow
    -- switching it in runtime
    ircCodepage :: String -> String -> LB ()
    ircCodepage :: String -> String -> LB ()
    ircCodepage String
    svr String
    cpage = do
        IrcMessage -> LB ()
    send (IrcMessage -> LB ()) -> IrcMessage -> LB ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> IrcMessage
    codepage String
    svr String
    cpage

    ircGetChannels :: LB [Nick]
    ircGetChannels :: LB [Nick]
    ircGetChannels = ((ChanName -> Nick) -> [ChanName] -> [Nick]
    forall a b. (a -> b) -> [a] -> [b]
    map ChanName -> Nick
    getCN ([ChanName] -> [Nick])
    -> (Map ChanName String -> [ChanName])
    -> Map ChanName String
    -> [Nick]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Map ChanName String -> [ChanName]
    forall k a. Map k a -> [k]
    M.keys) (Map ChanName String -> [Nick])
    -> LB (Map ChanName String) -> LB [Nick]
    forall a b. (a -> b) -> LB a -> LB b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    `fmap` (IRCRWState -> Map ChanName String) -> LB (Map ChanName String)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets IRCRWState -> Map ChanName String
    ircChannels

    -- Send a quit message, settle and wait for the server to drop our
    -- handle. At which point the main thread gets a closed handle eof
    -- exceptoin, we clean up and go home
    ircQuit :: String -> String -> LB ()
    ircQuit :: String -> String -> LB ()
    ircQuit String
    svr String
    msg = do
        (IRCRWState -> IRCRWState) -> LB ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((IRCRWState -> IRCRWState) -> LB ())
    -> (IRCRWState -> IRCRWState) -> LB ()
    forall a b. (a -> b) -> a -> b
    $ \IRCRWState
    state' -> IRCRWState
    state' { ircPersists = M.delete svr $ ircPersists state' }
        IrcMessage -> LB ()
    send  (IrcMessage -> LB ()) -> IrcMessage -> LB ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> IrcMessage
    quit String
    svr String
    msg
        IO () -> LB ()
    forall a. IO a -> LB a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> LB ()) -> IO () -> LB ()
    forall a b. (a -> b) -> a -> b
    $ Int -> IO ()
    threadDelay Int
    1000
        String -> LB ()
    forall (m :: * -> *). MonadLogging m => String -> m ()
    noticeM String
    "Quitting"

    ircReconnect :: String -> String -> LB ()
    ircReconnect :: String -> String -> LB ()
    ircReconnect String
    svr String
    msg = do
        (IRCRWState -> IRCRWState) -> LB ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify ((IRCRWState -> IRCRWState) -> LB ())
    -> (IRCRWState -> IRCRWState) -> LB ()
    forall a b. (a -> b) -> a -> b
    $ \IRCRWState
    state' -> IRCRWState
    state' { ircPersists = M.insertWith (flip const) svr False $ ircPersists state' }
        IrcMessage -> LB ()
    send (IrcMessage -> LB ()) -> IrcMessage -> LB ()
    forall a b. (a -> b) -> a -> b
    $ String -> String -> IrcMessage
    quit String
    svr String
    msg
        IO () -> LB ()
    forall a. IO a -> LB a
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    liftIO (IO () -> LB ()) -> IO () -> LB ()
    forall a b. (a -> b) -> a -> b
    $ Int -> IO ()
    threadDelay Int
    1000

    -- | Send a message to a channel\/user, applying all output filters
    ircPrivmsg :: Nick      -- ^ The channel\/user.
               -> String        -- ^ The message.
               -> LB ()

    ircPrivmsg :: Nick -> String -> LB ()
    ircPrivmsg Nick
    who String
    msg = do
        sendlines <- Nick -> String -> LB [String]
    applyOutputFilters Nick
    who String
    msg
        w <- getConfig textWidth
        mapM_ (\String
    s -> Nick -> String -> LB ()
    ircPrivmsg' Nick
    who (Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    w String
    s)) (take 10 sendlines)

    -- A raw send version (bypasses output filters)
    ircPrivmsg' :: Nick -> String -> LB ()
    ircPrivmsg' :: Nick -> String -> LB ()
    ircPrivmsg' Nick
    who String
    ""  = Nick -> String -> LB ()
    ircPrivmsg' Nick
    who String
    " "
    ircPrivmsg' Nick
    who String
    msg = IrcMessage -> LB ()
    send (IrcMessage -> LB ()) -> IrcMessage -> LB ()
    forall a b. (a -> b) -> a -> b
    $ Nick -> String -> IrcMessage
    privmsg Nick
    who String
    msg