module Control.Monad.Objective.Class where
import Control.Object
#if MIN_VERSION_transformers(0,4,0)
import Control.Monad.Trans.Except
#else
import Control.Monad.Trans.Error
#endif
import Control.Monad.Trans.Identity
import Control.Monad.Trans.List
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Class
import Control.Monad.Trans.Cont
import Control.Monad.Trans.Reader
import Control.Monad.Trans.State.Lazy as Lazy
import Control.Monad.Trans.State.Strict as Strict
import Control.Monad.Trans.Writer.Lazy as Lazy
import Control.Monad.Trans.Writer.Strict as Strict
import qualified Control.Monad.Trans.RWS.Lazy as LazyRWS
import qualified Control.Monad.Trans.RWS.Strict as StrictRWS
import Data.Monoid
import Control.Monad
import Control.Monad.Free
infix 3 .-
infix 3 .&
class Monad m => MonadObjective m where
data Address (e :: * -> *) (m :: * -> *)
type Residence (m :: * -> *) :: * -> *
(.-) :: Address e m -> e a -> m a
new :: Object e (Residence m) -> m (Address e m)
invoke :: MonadObjective m => Object e (Residence m) -> m (Address e m)
invoke = new
(.&) :: (MonadObjective m, Stateful s e) => Address e m -> Strict.StateT s m a -> m a
c .& m = do
s <- c .- get_
(a, s') <- Strict.runStateT m s
c .- put_ s'
return a
(.|-) :: MonadObjective m => Address e m -> Free e a -> m a
_ .|- Pure a = return a
c .|- Free f = c .- f >>= (c .|-)
instance MonadObjective m => MonadObjective (ReaderT r m) where
data Address e (ReaderT r m) = WrapReaderT (Address e m)
type Residence (ReaderT r m) = Residence m
WrapReaderT c .- e = lift (c .- e)
new = liftM WrapReaderT . lift . new
instance (Monoid w, MonadObjective m) => MonadObjective (LazyRWS.RWST r w s m) where
data Address e (LazyRWS.RWST r w s m) = WrapLazyRWST (Address e m)
type Residence (LazyRWS.RWST r w s m) = Residence m
WrapLazyRWST c .- e = lift (c .- e)
new = liftM WrapLazyRWST . lift . new
instance (Monoid w, MonadObjective m) => MonadObjective (StrictRWS.RWST r w s m) where
data Address e (StrictRWS.RWST r w s m) = WrapStrictRWST (Address e m)
type Residence (StrictRWS.RWST r w s m) = Residence m
WrapStrictRWST c .- e = lift (c .- e)
new = liftM WrapStrictRWST . lift . new
instance MonadObjective m => MonadObjective (ContT r m) where
data Address e (ContT r m) = WrapContT (Address e m)
type Residence (ContT r m) = Residence m
WrapContT c .- e = lift (c .- e)
new = liftM WrapContT . lift . new
#if MIN_VERSION_transformers(0,4,0)
instance MonadObjective m => MonadObjective (ExceptT er m) where
data Address e (ExceptT er m) = WrapExceptT (Address e m)
type Residence (ExceptT er m) = Residence m
WrapExceptT c .- e = lift (c .- e)
new = liftM WrapExceptT . lift . new
#else
instance (Error er, MonadObjective m) => MonadObjective (ErrorT er m) where
data Address e (ErrorT er m) = WrapErrorT (Address e m)
type Residence (ErrorT er m) = Residence m
WrapErrorT c .- e = lift (c .- e)
new = liftM WrapErrorT . lift . new
#endif
instance MonadObjective m => MonadObjective (IdentityT m) where
data Address e (IdentityT m) = WrapIdentityT (Address e m)
type Residence (IdentityT m) = Residence m
WrapIdentityT c .- e = lift (c .- e)
new = liftM WrapIdentityT . lift . new
instance MonadObjective m => MonadObjective (ListT m) where
data Address e (ListT m) = WrapListT (Address e m)
type Residence (ListT m) = Residence m
WrapListT c .- e = lift (c .- e)
new = liftM WrapListT . lift . new
instance MonadObjective m => MonadObjective (MaybeT m) where
data Address e (MaybeT m) = WrapMaybeT (Address e m)
type Residence (MaybeT m) = Residence m
WrapMaybeT c .- e = lift (c .- e)
new = liftM WrapMaybeT . lift . new
instance MonadObjective m => MonadObjective (Lazy.StateT s m) where
data Address e (Lazy.StateT s m) = WrapLazyStateT (Address e m)
type Residence (Lazy.StateT s m) = Residence m
WrapLazyStateT c .- e = lift (c .- e)
new = liftM WrapLazyStateT . lift . new
instance MonadObjective m => MonadObjective (Strict.StateT s m) where
data Address e (Strict.StateT s m) = WrapStrictStateT (Address e m)
type Residence (Strict.StateT s m) = Residence m
WrapStrictStateT c .- e = lift (c .- e)
new = liftM WrapStrictStateT . lift . new
instance (Monoid w, MonadObjective m) => MonadObjective (Lazy.WriterT w m) where
data Address e (Lazy.WriterT w m) = WrapLazyWriterT (Address e m)
type Residence (Lazy.WriterT w m) = Residence m
WrapLazyWriterT c .- e = lift (c .- e)
new = liftM WrapLazyWriterT . lift . new
instance (Monoid w, MonadObjective m) => MonadObjective (Strict.WriterT w m) where
data Address e (Strict.WriterT w m) = WrapStrictWriterT (Address e m)
type Residence (Strict.WriterT w m) = Residence m
WrapStrictWriterT c .- e = lift (c .- e)
new = liftM WrapStrictWriterT . lift . new