content: {-# 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 mName m = do
      infoM ("Loading module " ++ show mName)
  
      savedState <- readGlobalState m 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{} -> do
              errorM ("Module " ++ show mName ++ " failed to load.  Exception thrown: " ++ show e)
  
              unregisterModule mName
              fail "Refusing to load due to a broken plugin"
  
  --
  -- | Unregister a module's entry in the irc state
  --
  ircUnloadModule :: String -> LB ()
  ircUnloadModule mName = do
      infoM ("Unloading module " ++ show mName)
  
      inModuleNamed mName (fail "module not loaded") $ do
          m <- asks theModule
          when (moduleSticky m) $ fail "module is sticky"
  
          moduleExit m
              `E.catch` \e@SomeException{} ->
                  errorM ("Module " ++ show mName ++ " threw the following exception in moduleExit: " ++ show e)
  
          writeGlobalState
  
      unregisterModule mName
  
  ------------------------------------------------------------------------
  
  -- | Checks whether the given user has admin permissions
  checkPrivs :: IrcMessage -> LB Bool
  checkPrivs msg = gets (S.member (nick msg) . ircPrivilegedUsers)
  
  -- | Checks whether the given user is being ignored.
  --   Privileged users can't be ignored.
  checkIgnore :: IrcMessage -> LB Bool
  checkIgnore msg = liftM2 (&&) (liftM not (checkPrivs msg))
                    (gets (S.member (nick msg) . 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 svr cpage = do
      send $ codepage svr cpage
  
  ircGetChannels :: LB [Nick]
  ircGetChannels = (map getCN . M.keys) `fmap` gets 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 svr msg = do
      modify $ \state' -> state' { ircPersists = M.delete svr $ ircPersists state' }
      send  $ quit svr msg
      liftIO $ threadDelay 1000
      noticeM "Quitting"
  
  ircReconnect :: String -> String -> LB ()
  ircReconnect svr msg = do
      modify $ \state' -> state' { ircPersists = M.insertWith (flip const) svr False $ ircPersists state' }
      send $ quit svr msg
      liftIO $ threadDelay 1000
  
  -- | Send a message to a channel\/user, applying all output filters
  ircPrivmsg :: Nick      -- ^ The channel\/user.
             -> String        -- ^ The message.
             -> LB ()
  
  ircPrivmsg who msg = do
      sendlines <- applyOutputFilters who msg
      w <- getConfig textWidth
      mapM_ (\s -> ircPrivmsg' who (take w s)) (take 10 sendlines)
  
  -- A raw send version (bypasses output filters)
  ircPrivmsg' :: Nick -> String -> LB ()
  ircPrivmsg' who ""  = ircPrivmsg' who " "
  ircPrivmsg' who msg = send $ privmsg who msg
  