module Lambdabot.Module
( Module(..)
, newModule
, ModuleT(..)
, getRef
, getModuleName
, bindModule0
, bindModule1
, bindModule2
) where
import qualified Lambdabot.Command as Cmd
import Lambdabot.Config
import Lambdabot.Logging
import Lambdabot.Monad
import Lambdabot.Util.Serial
import Control.Applicative
import Control.Concurrent (MVar)
import Control.Monad
import Control.Monad.Base
import Control.Monad.Reader (MonadReader(..), ReaderT(..))
import Control.Monad.Trans (MonadTrans(..), MonadIO(..))
import Control.Monad.Trans.Control
import System.Console.Haskeline.MonadException (MonadException)
data Module st = Module {
moduleSerialize :: !(Maybe (Serial st)),
moduleDefState :: !(LB st),
moduleSticky :: !Bool,
moduleCmds :: !(ModuleT st LB [Cmd.Command (ModuleT st LB)]),
moduleInit :: !(ModuleT st LB ()),
moduleExit :: !(ModuleT st LB ()),
contextual
:: !(String
-> Cmd.Cmd (ModuleT st LB) ())
}
newModule :: Module st
newModule = Module
{ contextual = \_ -> return ()
, moduleCmds = return []
, moduleExit = return ()
, moduleInit = return ()
, moduleSticky = False
, moduleSerialize = Nothing
, moduleDefState = return $ error "state not initialized"
}
newtype ModuleT st m a = ModuleT { runModuleT :: ReaderT (MVar st, String) m a }
deriving (Applicative, Functor, Monad, MonadTrans, MonadIO, MonadException, MonadConfig)
instance MonadLogging m => MonadLogging (ModuleT st m) where
getCurrentLogger = do
parent <- lift getCurrentLogger
self <- getModuleName
return (parent ++ ["Plugin", self])
logM a b c = lift (logM a b c)
instance MonadBase b m => MonadBase b (ModuleT st m) where
liftBase = lift . liftBase
instance MonadTransControl (ModuleT st) where
newtype StT (ModuleT st) a = StModule {unStModule :: a}
liftWith f = do
r <- ModuleT ask
lift $ f $ \t -> liftM StModule (runReaderT (runModuleT t) r)
restoreT = lift . liftM unStModule
instance MonadBaseControl b m => MonadBaseControl b (ModuleT st m) where
newtype StM (ModuleT st m) a = StMModule {unStMModule :: ComposeSt (ModuleT st) m a}
liftBaseWith = defaultLiftBaseWith StMModule
restoreM = defaultRestoreM unStMModule
getRef :: Monad m => ModuleT st m (MVar st)
getRef = ModuleT $ ask >>= return . fst
getModuleName :: Monad m => ModuleT mod m String
getModuleName = ModuleT $ ask >>= return . snd
bindModule0 :: ModuleT mod LB a -> ModuleT mod LB (LB a)
bindModule0 act = bindModule1 (const act) >>= return . ($ ())
bindModule1 :: (a -> ModuleT mod LB b) -> ModuleT mod LB (a -> LB b)
bindModule1 act = ModuleT $
ask >>= \st -> return (\val -> runReaderT (runModuleT $ act val) st)
bindModule2 :: (a -> b -> ModuleT mod LB c) -> ModuleT mod LB (a -> b -> LB c)
bindModule2 act = bindModule1 (uncurry act) >>= return . curry