{-# LANGUAGE TemplateHaskell #-}
module Lambdabot.Main
( lambdabotVersion
, Config
, DSum(..)
, (==>)
, lambdabotMain
, Modules
, modules
, module Lambdabot.Plugin.Core
, Priority(..)
) where
import Lambdabot.Bot
import Lambdabot.Config
import Lambdabot.Logging
import Lambdabot.Module
import Lambdabot.Monad
import Lambdabot.Plugin.Core
import Lambdabot.Util
import Lambdabot.Util.Signals
import Control.Exception.Lifted as E
import Control.Monad.Identity
import Data.Dependent.Sum
import Data.List
import Data.IORef
import Data.Some
import Data.Version
import Language.Haskell.TH
import Paths_lambdabot_core (version)
import System.Exit
import System.Log.Formatter
import qualified System.Log.Logger as L
import System.Log.Handler.Simple
import Network.Socket (withSocketsDo)
lambdabotVersion :: Version
lambdabotVersion :: Version
lambdabotVersion = Version
version
setupLogging :: LB ()
setupLogging :: LB ()
setupLogging = do
Handle
stream <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Handle
consoleLogHandle
Priority
level <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Priority
consoleLogLevel
[Char]
format <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config [Char]
consoleLogFormat
GenericHandler Handle
unformattedHandler <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io (Handle -> Priority -> IO (GenericHandler Handle)
streamHandler Handle
stream Priority
level)
let consoleHandler :: GenericHandler Handle
consoleHandler = GenericHandler Handle
unformattedHandler
{ formatter :: LogFormatter (GenericHandler Handle)
formatter = forall a. [Char] -> LogFormatter a
simpleLogFormatter [Char]
format }
Bool
setRoot <- forall (m :: * -> *) a. MonadConfig m => Config a -> m a
getConfig Config Bool
replaceRootLogger
forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ if Bool
setRoot
then [Char] -> (Logger -> Logger) -> IO ()
L.updateGlobalLogger [Char]
L.rootLoggerName
(Priority -> Logger -> Logger
L.setLevel Priority
level forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LogHandler a => [a] -> Logger -> Logger
L.setHandlers [GenericHandler Handle
consoleHandler])
else [Char] -> (Logger -> Logger) -> IO ()
L.updateGlobalLogger [Char]
"Lambdabot"
(Priority -> Logger -> Logger
L.setLevel Priority
level forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. LogHandler a => a -> Logger -> Logger
L.addHandler GenericHandler Handle
consoleHandler)
lambdabotMain :: Modules -> [DSum Config Identity] -> IO ExitCode
lambdabotMain :: Modules -> [DSum Config Identity] -> IO ExitCode
lambdabotMain Modules
initialise [DSum Config Identity]
cfg = forall a. IO a -> IO a
withSocketsDo forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. MonadBaseControl IO m => m a -> m a
withIrcSignalCatch forall a b. (a -> b) -> a -> b
$ do
IRCRState
rost <- [DSum Config Identity] -> IO IRCRState
initRoState [DSum Config Identity]
cfg
IORef IRCRWState
rwst <- forall a. a -> IO (IORef a)
newIORef IRCRWState
initRwState
forall a. LB a -> (IRCRState, IORef IRCRWState) -> IO a
runLB (Modules -> LB ExitCode
lambdabotRun Modules
initialise) (IRCRState
rost, IORef IRCRWState
rwst)
forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch` \SomeException
e -> do
case forall e. Exception e => SomeException -> Maybe e
fromException SomeException
e of
Just ExitCode
code -> forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
code
Maybe ExitCode
Nothing -> do
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
errorM (forall a. Show a => a -> [Char]
show SomeException
e)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ExitCode
ExitFailure Int
1)
lambdabotRun :: Modules -> LB ExitCode
lambdabotRun :: Modules -> LB ExitCode
lambdabotRun Modules
ms = do
LB ()
setupLogging
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
infoM [Char]
"Initialising plugins"
forall a. Modules -> LB a -> LB a
withModules Modules
ms forall a b. (a -> b) -> a -> b
$ do
forall (m :: * -> *). MonadLogging m => [Char] -> m ()
infoM [Char]
"Done loading plugins"
LB ()
reportInitDone
forall (m :: * -> *). MonadLB m => m ()
waitForQuit forall (m :: * -> *) e a.
(MonadBaseControl IO m, Exception e) =>
m a -> (e -> m a) -> m a
`E.catch`
(\e :: SomeException
e@SomeException{} -> forall (m :: * -> *). MonadLogging m => [Char] -> m ()
errorM (forall a. Show a => a -> [Char]
show SomeException
e))
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ [Char] -> LB ()
ircUnloadModule forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LB [[Char]]
listModules
forall (m :: * -> *) a. Monad m => a -> m a
return ExitCode
ExitSuccess
type Modules = [(String, Some Module)]
modules :: [String] -> Q Exp
modules :: [[Char]] -> Q Exp
modules [[Char]]
xs = [| $(listE $ map instalify (nub xs)) |]
where
instalify :: [Char] -> m Exp
instalify [Char]
x =
let module' :: m Exp
module' = forall (m :: * -> *). Quote m => Name -> m Exp
varE forall a b. (a -> b) -> a -> b
$ [Char] -> Name
mkName ([Char]
x forall a. [a] -> [a] -> [a]
++ [Char]
"Plugin")
in [| (x, Some $module') |]
withModules :: Modules -> LB a -> LB a
withModules :: forall a. Modules -> LB a -> LB a
withModules [] = forall a. a -> a
id
withModules (([Char]
n, Some Module a
m):Modules
ms) = forall st a. [Char] -> Module st -> LB a -> LB a
withModule [Char]
n Module a
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Modules -> LB a -> LB a
withModules Modules
ms
withModule :: String -> Module st -> LB a -> LB a
withModule :: forall st a. [Char] -> Module st -> LB a -> LB a
withModule [Char]
name Module st
m = forall (m :: * -> *) a b c.
MonadBaseControl IO m =>
m a -> m b -> m c -> m c
bracket_ (forall st. [Char] -> Module st -> LB ()
ircLoadModule [Char]
name Module st
m) ([Char] -> LB ()
ircUnloadModule [Char]
name)