{-# 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)

-- | The Lambdabot entry point.
-- Initialise plugins, connect, and run the bot in the LB monad
--
-- Also, handle any fatal exceptions (such as non-recoverable signals),
-- (i.e. print a message and exit). Non-fatal exceptions should be dealt
-- with in the mainLoop or further down.
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
            -- clean up and go home
            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)) -- catch anything, print informative message, and clean up
    
    -- clean up any dynamically loaded modules
    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)