{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Lambdabot.Module
( Module(..)
, newModule
, ModuleID
, newModuleID
, ModuleInfo(..)
, ModuleT
, runModuleT
) where
import qualified Lambdabot.Command as Cmd
import Lambdabot.Config
import Lambdabot.Logging
import {-# SOURCE #-} Lambdabot.Monad
import Lambdabot.Util.Serial
import Control.Applicative
import Control.Concurrent (MVar)
import Control.Monad
import Control.Monad.Fail (MonadFail)
import qualified Control.Monad.Fail
import Control.Monad.Base
import Control.Monad.Reader (MonadReader(..), ReaderT(..), asks)
import Control.Monad.Trans (MonadTrans(..), MonadIO(..))
import Control.Monad.Trans.Control
import Data.Unique.Tag
import Control.Monad.Catch (MonadThrow, MonadCatch, MonadMask)
#if !defined(MIN_VERSION_haskeline) || !MIN_VERSION_haskeline(0,8,0)
import System.Console.Haskeline.MonadException (MonadException)
#endif
data Module st = Module {
forall st. Module st -> Maybe (Serial st)
moduleSerialize :: !(Maybe (Serial st)),
forall st. Module st -> LB st
moduleDefState :: !(LB st),
forall st. Module st -> Bool
moduleSticky :: !Bool,
forall st. Module st -> ModuleT st LB [Command (ModuleT st LB)]
moduleCmds :: !(ModuleT st LB [Cmd.Command (ModuleT st LB)]),
forall st. Module st -> ModuleT st LB ()
moduleInit :: !(ModuleT st LB ()),
forall st. Module st -> ModuleT st LB ()
moduleExit :: !(ModuleT st LB ()),
forall st. Module st -> String -> Cmd (ModuleT st LB) ()
contextual
:: !(String
-> Cmd.Cmd (ModuleT st LB) ())
}
newModule :: Module st
newModule :: forall st. Module st
newModule = Module
{ contextual :: String -> Cmd (ModuleT st LB) ()
contextual = \String
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
, moduleCmds :: ModuleT st LB [Command (ModuleT st LB)]
moduleCmds = forall (m :: * -> *) a. Monad m => a -> m a
return []
, moduleExit :: ModuleT st LB ()
moduleExit = forall (m :: * -> *) a. Monad m => a -> m a
return ()
, moduleInit :: ModuleT st LB ()
moduleInit = forall (m :: * -> *) a. Monad m => a -> m a
return ()
, moduleSticky :: Bool
moduleSticky = Bool
False
, moduleSerialize :: Maybe (Serial st)
moduleSerialize = forall a. Maybe a
Nothing
, moduleDefState :: LB st
moduleDefState = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => String -> a
error String
"state not initialized"
}
newtype ModuleID st = ModuleID (Tag RealWorld st)
deriving (forall a b. ModuleID a -> ModuleID b -> Maybe (a :~: b)
forall k (f :: k -> *).
(forall (a :: k) (b :: k). f a -> f b -> Maybe (a :~: b)) -> GEq f
geq :: forall a b. ModuleID a -> ModuleID b -> Maybe (a :~: b)
$cgeq :: forall a b. ModuleID a -> ModuleID b -> Maybe (a :~: b)
GEq, GEq ModuleID
forall a b. ModuleID a -> ModuleID b -> GOrdering a b
forall k (f :: k -> *).
GEq f
-> (forall (a :: k) (b :: k). f a -> f b -> GOrdering a b)
-> GCompare f
gcompare :: forall a b. ModuleID a -> ModuleID b -> GOrdering a b
$cgcompare :: forall a b. ModuleID a -> ModuleID b -> GOrdering a b
GCompare)
newModuleID :: IO (ModuleID st)
newModuleID :: forall st. IO (ModuleID st)
newModuleID = forall st. Tag RealWorld st -> ModuleID st
ModuleID forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. PrimMonad m => m (Tag (PrimState m) a)
newTag
data ModuleInfo st = ModuleInfo
{ forall st. ModuleInfo st -> String
moduleName :: !String
, forall st. ModuleInfo st -> ModuleID st
moduleID :: !(ModuleID st)
, forall st. ModuleInfo st -> Module st
theModule :: !(Module st)
, forall st. ModuleInfo st -> MVar st
moduleState :: !(MVar st)
}
newtype ModuleT st m a = ModuleT { forall st (m :: * -> *) a.
ModuleT st m a -> ReaderT (ModuleInfo st) m a
unModuleT :: ReaderT (ModuleInfo st) m a }
deriving (forall a. a -> ModuleT st m a
forall a b. ModuleT st m a -> ModuleT st m b -> ModuleT st m a
forall a b. ModuleT st m a -> ModuleT st m b -> ModuleT st m b
forall a b.
ModuleT st m (a -> b) -> ModuleT st m a -> ModuleT st m b
forall a b c.
(a -> b -> c) -> ModuleT st m a -> ModuleT st m b -> ModuleT st m c
forall {st} {m :: * -> *}. Applicative m => Functor (ModuleT st m)
forall st (m :: * -> *) a. Applicative m => a -> ModuleT st m a
forall st (m :: * -> *) a b.
Applicative m =>
ModuleT st m a -> ModuleT st m b -> ModuleT st m a
forall st (m :: * -> *) a b.
Applicative m =>
ModuleT st m a -> ModuleT st m b -> ModuleT st m b
forall st (m :: * -> *) a b.
Applicative m =>
ModuleT st m (a -> b) -> ModuleT st m a -> ModuleT st m b
forall st (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ModuleT st m a -> ModuleT st m b -> ModuleT st m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: forall a b. ModuleT st m a -> ModuleT st m b -> ModuleT st m a
$c<* :: forall st (m :: * -> *) a b.
Applicative m =>
ModuleT st m a -> ModuleT st m b -> ModuleT st m a
*> :: forall a b. ModuleT st m a -> ModuleT st m b -> ModuleT st m b
$c*> :: forall st (m :: * -> *) a b.
Applicative m =>
ModuleT st m a -> ModuleT st m b -> ModuleT st m b
liftA2 :: forall a b c.
(a -> b -> c) -> ModuleT st m a -> ModuleT st m b -> ModuleT st m c
$cliftA2 :: forall st (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c) -> ModuleT st m a -> ModuleT st m b -> ModuleT st m c
<*> :: forall a b.
ModuleT st m (a -> b) -> ModuleT st m a -> ModuleT st m b
$c<*> :: forall st (m :: * -> *) a b.
Applicative m =>
ModuleT st m (a -> b) -> ModuleT st m a -> ModuleT st m b
pure :: forall a. a -> ModuleT st m a
$cpure :: forall st (m :: * -> *) a. Applicative m => a -> ModuleT st m a
Applicative, forall a b. a -> ModuleT st m b -> ModuleT st m a
forall a b. (a -> b) -> ModuleT st m a -> ModuleT st m b
forall st (m :: * -> *) a b.
Functor m =>
a -> ModuleT st m b -> ModuleT st m a
forall st (m :: * -> *) a b.
Functor m =>
(a -> b) -> ModuleT st m a -> ModuleT st m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> ModuleT st m b -> ModuleT st m a
$c<$ :: forall st (m :: * -> *) a b.
Functor m =>
a -> ModuleT st m b -> ModuleT st m a
fmap :: forall a b. (a -> b) -> ModuleT st m a -> ModuleT st m b
$cfmap :: forall st (m :: * -> *) a b.
Functor m =>
(a -> b) -> ModuleT st m a -> ModuleT st m b
Functor, forall a. a -> ModuleT st m a
forall a b. ModuleT st m a -> ModuleT st m b -> ModuleT st m b
forall a b.
ModuleT st m a -> (a -> ModuleT st m b) -> ModuleT st m b
forall {st} {m :: * -> *}. Monad m => Applicative (ModuleT st m)
forall st (m :: * -> *) a. Monad m => a -> ModuleT st m a
forall st (m :: * -> *) a b.
Monad m =>
ModuleT st m a -> ModuleT st m b -> ModuleT st m b
forall st (m :: * -> *) a b.
Monad m =>
ModuleT st m a -> (a -> ModuleT st m b) -> ModuleT st m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: forall a. a -> ModuleT st m a
$creturn :: forall st (m :: * -> *) a. Monad m => a -> ModuleT st m a
>> :: forall a b. ModuleT st m a -> ModuleT st m b -> ModuleT st m b
$c>> :: forall st (m :: * -> *) a b.
Monad m =>
ModuleT st m a -> ModuleT st m b -> ModuleT st m b
>>= :: forall a b.
ModuleT st m a -> (a -> ModuleT st m b) -> ModuleT st m b
$c>>= :: forall st (m :: * -> *) a b.
Monad m =>
ModuleT st m a -> (a -> ModuleT st m b) -> ModuleT st m b
Monad, MonadReader (ModuleInfo st),
forall st (m :: * -> *) a. Monad m => m a -> ModuleT st m a
forall (m :: * -> *) a. Monad m => m a -> ModuleT st m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: forall (m :: * -> *) a. Monad m => m a -> ModuleT st m a
$clift :: forall st (m :: * -> *) a. Monad m => m a -> ModuleT st m a
MonadTrans, forall a. IO a -> ModuleT st m a
forall {st} {m :: * -> *}. MonadIO m => Monad (ModuleT st m)
forall st (m :: * -> *) a. MonadIO m => IO a -> ModuleT st m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
liftIO :: forall a. IO a -> ModuleT st m a
$cliftIO :: forall st (m :: * -> *) a. MonadIO m => IO a -> ModuleT st m a
MonadIO, forall a. Config a -> ModuleT st m a
forall {st} {m :: * -> *}. MonadConfig m => Monad (ModuleT st m)
forall st (m :: * -> *) a.
MonadConfig m =>
Config a -> ModuleT st m a
forall (m :: * -> *).
Monad m -> (forall a. Config a -> m a) -> MonadConfig m
getConfig :: forall a. Config a -> ModuleT st m a
$cgetConfig :: forall st (m :: * -> *) a.
MonadConfig m =>
Config a -> ModuleT st m a
MonadConfig, forall a. String -> ModuleT st m a
forall {st} {m :: * -> *}. MonadFail m => Monad (ModuleT st m)
forall st (m :: * -> *) a. MonadFail m => String -> ModuleT st m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
fail :: forall a. String -> ModuleT st m a
$cfail :: forall st (m :: * -> *) a. MonadFail m => String -> ModuleT st m a
MonadFail,
#if !defined(MIN_VERSION_haskeline) || !MIN_VERSION_haskeline(0,8,0)
MonadException,
#endif
forall e a. Exception e => e -> ModuleT st m a
forall {st} {m :: * -> *}. MonadThrow m => Monad (ModuleT st m)
forall st (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ModuleT st m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
throwM :: forall e a. Exception e => e -> ModuleT st m a
$cthrowM :: forall st (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> ModuleT st m a
MonadThrow, forall e a.
Exception e =>
ModuleT st m a -> (e -> ModuleT st m a) -> ModuleT st m a
forall {st} {m :: * -> *}.
MonadCatch m =>
MonadThrow (ModuleT st m)
forall st (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ModuleT st m a -> (e -> ModuleT st m a) -> ModuleT st m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
catch :: forall e a.
Exception e =>
ModuleT st m a -> (e -> ModuleT st m a) -> ModuleT st m a
$ccatch :: forall st (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
ModuleT st m a -> (e -> ModuleT st m a) -> ModuleT st m a
MonadCatch, forall b.
((forall a. ModuleT st m a -> ModuleT st m a) -> ModuleT st m b)
-> ModuleT st m b
forall a b c.
ModuleT st m a
-> (a -> ExitCase b -> ModuleT st m c)
-> (a -> ModuleT st m b)
-> ModuleT st m (b, c)
forall {st} {m :: * -> *}. MonadMask m => MonadCatch (ModuleT st m)
forall st (m :: * -> *) b.
MonadMask m =>
((forall a. ModuleT st m a -> ModuleT st m a) -> ModuleT st m b)
-> ModuleT st m b
forall st (m :: * -> *) a b c.
MonadMask m =>
ModuleT st m a
-> (a -> ExitCase b -> ModuleT st m c)
-> (a -> ModuleT st m b)
-> ModuleT st m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
generalBracket :: forall a b c.
ModuleT st m a
-> (a -> ExitCase b -> ModuleT st m c)
-> (a -> ModuleT st m b)
-> ModuleT st m (b, c)
$cgeneralBracket :: forall st (m :: * -> *) a b c.
MonadMask m =>
ModuleT st m a
-> (a -> ExitCase b -> ModuleT st m c)
-> (a -> ModuleT st m b)
-> ModuleT st m (b, c)
uninterruptibleMask :: forall b.
((forall a. ModuleT st m a -> ModuleT st m a) -> ModuleT st m b)
-> ModuleT st m b
$cuninterruptibleMask :: forall st (m :: * -> *) b.
MonadMask m =>
((forall a. ModuleT st m a -> ModuleT st m a) -> ModuleT st m b)
-> ModuleT st m b
mask :: forall b.
((forall a. ModuleT st m a -> ModuleT st m a) -> ModuleT st m b)
-> ModuleT st m b
$cmask :: forall st (m :: * -> *) b.
MonadMask m =>
((forall a. ModuleT st m a -> ModuleT st m a) -> ModuleT st m b)
-> ModuleT st m b
MonadMask)
runModuleT :: ModuleT st m a -> ModuleInfo st -> m a
runModuleT :: forall st (m :: * -> *) a. ModuleT st m a -> ModuleInfo st -> m a
runModuleT = forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall st (m :: * -> *) a.
ModuleT st m a -> ReaderT (ModuleInfo st) m a
unModuleT
instance MonadLogging m => MonadLogging (ModuleT st m) where
getCurrentLogger :: ModuleT st m [String]
getCurrentLogger = do
[String]
parent <- forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall (m :: * -> *). MonadLogging m => m [String]
getCurrentLogger
String
self <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall st. ModuleInfo st -> String
moduleName
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
parent forall a. [a] -> [a] -> [a]
++ [String
"Plugin", String
self])
logM :: String -> Priority -> String -> ModuleT st m ()
logM String
a Priority
b String
c = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (forall (m :: * -> *).
MonadLogging m =>
String -> Priority -> String -> m ()
logM String
a Priority
b String
c)
instance MonadBase b m => MonadBase b (ModuleT st m) where
liftBase :: forall α. b α -> ModuleT st m α
liftBase = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (b :: * -> *) (m :: * -> *) α. MonadBase b m => b α -> m α
liftBase
instance MonadTransControl (ModuleT st) where
type StT (ModuleT st) a = a
liftWith :: forall (m :: * -> *) a.
Monad m =>
(Run (ModuleT st) -> m a) -> ModuleT st m a
liftWith Run (ModuleT st) -> m a
f = do
ModuleInfo st
r <- forall st (m :: * -> *) a.
ReaderT (ModuleInfo st) m a -> ModuleT st m a
ModuleT forall r (m :: * -> *). MonadReader r m => m r
ask
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Run (ModuleT st) -> m a
f forall a b. (a -> b) -> a -> b
$ \ModuleT st n b
t -> forall st (m :: * -> *) a. ModuleT st m a -> ModuleInfo st -> m a
runModuleT ModuleT st n b
t ModuleInfo st
r
restoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT (ModuleT st) a) -> ModuleT st m a
restoreT = forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift
{-# INLINE liftWith #-}
{-# INLINE restoreT #-}
instance MonadBaseControl b m => MonadBaseControl b (ModuleT st m) where
type StM (ModuleT st m) a = ComposeSt (ModuleT st) m a
liftBaseWith :: forall a. (RunInBase (ModuleT st m) b -> b a) -> ModuleT st m a
liftBaseWith = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
(RunInBaseDefault t m b -> b a) -> t m a
defaultLiftBaseWith
restoreM :: forall a. StM (ModuleT st m) a -> ModuleT st m a
restoreM = forall (t :: (* -> *) -> * -> *) (b :: * -> *) (m :: * -> *) a.
(MonadTransControl t, MonadBaseControl b m) =>
ComposeSt t m a -> t m a
defaultRestoreM
{-# INLINE liftBaseWith #-}
{-# INLINE restoreM #-}