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

------------------------------------------------------------------------

-- | The Module type class.
data Module st = Module {
        -- | If the module wants its state to be saved, this function should
        --   return a Serial.
        --
        --   The default implementation returns Nothing.
        forall st. Module st -> Maybe (Serial st)
moduleSerialize :: !(Maybe (Serial st)),

        -- | If the module maintains state, this method specifies the default state
        --   (for example in case the state can't be read from a state).
        --
        --   The default implementation returns an error and assumes the state is
        --   never accessed.
        forall st. Module st -> LB st
moduleDefState  :: !(LB st),

        -- | Is the module sticky? Sticky modules (as well as static ones) can't be
        --   unloaded. By default, modules are not sticky.
        forall st. Module st -> Bool
moduleSticky    :: !Bool,

        -- | The commands the module listens to.
        forall st. Module st -> ModuleT st LB [Command (ModuleT st LB)]
moduleCmds      :: !(ModuleT st LB [Cmd.Command (ModuleT st LB)]),

        -- | Initialize the module. The default implementation does nothing.
        forall st. Module st -> ModuleT st LB ()
moduleInit      :: !(ModuleT st LB ()),

        -- | Finalize the module. The default implementation does nothing.
        forall st. Module st -> ModuleT st LB ()
moduleExit      :: !(ModuleT st LB ()),

        -- | Process contextual input. A plugin that implements 'contextual'
        -- is able to respond to text not part of a normal command.
        forall st. Module st -> String -> Cmd (ModuleT st LB) ()
contextual
            :: !(String                           --  the text
             -> Cmd.Cmd (ModuleT st LB) ())       -- ^ the action
    }

------------------------------------------------------------------------

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

-- |Info about a running module.
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)
    }

-- | This transformer encodes the additional information a module might
--   need to access its name or its state.
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 #-}