Safe Haskell | None |
---|---|
Language | Haskell2010 |
Alternative multi-valued version of mtl's RWS / RWST. In contrast to
this version only takes a single list of types as
parameter, but with additional encoding of the allowed access for each
element. This supports the MultiRWS
(T)
notion more succinctly, i.e.
to pass a "state" element to a function that only requiresexpects readget
access. This is not possible with MonadMultiGet
MultiRWS
.
- newtype MultiGSTT ts m a = MultiGSTT {
- runMultiGSTTRaw :: StateT (HListM ts) m a
- type MultiGSTTNull = MultiGSTT '[]
- type MultiGST r = MultiGSTT r Identity
- type ContainsReader = HListMContains GettableFlag
- type ContainsState = HListMContains SettableFlag
- type ContainsWriter = HListMContains TellableFlag
- class Monad m => MonadMultiReader a m where
- class (Monad m, Monoid a) => MonadMultiWriter a m where
- class Monad m => MonadMultiGet a m where
- class MonadMultiGet a m => MonadMultiState a m where
- data CanReadWrite a
- runMultiGSTTNil :: Monad m => MultiGSTT '[] m a -> m a
- runMultiGSTTNil_ :: Monad m => MultiGSTT '[] m a -> m ()
- withReader :: Monad m => t -> MultiGSTT (Gettable t ': tr) m a -> MultiGSTT tr m a
- withReader_ :: Monad m => t -> MultiGSTT (Gettable t ': tr) m a -> MultiGSTT tr m ()
- withReaders :: Monad m => HList rs -> MultiGSTT (AppendM (HListMReaders rs) ts) m a -> MultiGSTT ts m a
- withWriter :: (Monoid t, Monad m) => MultiGSTT (Tellable t ': tr) m a -> MultiGSTT tr m (a, t)
- withWriterAW :: (Monoid t, Monad m) => MultiGSTT (Tellable t ': tr) m a -> MultiGSTT tr m (a, t)
- withWriterWA :: (Monoid t, Monad m) => MultiGSTT (Tellable t ': tr) m a -> MultiGSTT tr m (t, a)
- withWriterW :: (Monoid t, Monad m) => MultiGSTT (Tellable t ': tr) m a -> MultiGSTT tr m t
- withState :: Monad m => t -> MultiGSTT (Settable t ': tr) m a -> MultiGSTT tr m (a, t)
- withStateAS :: Monad m => t -> MultiGSTT (Settable t ': tr) m a -> MultiGSTT tr m (a, t)
- withStateSA :: Monad m => t -> MultiGSTT (Settable t ': tr) m a -> MultiGSTT tr m (t, a)
- withStateA :: Monad m => t -> MultiGSTT (Settable t ': tr) m a -> MultiGSTT tr m a
- withStateS :: Monad m => t -> MultiGSTT (Settable t ': tr) m a -> MultiGSTT tr m t
- withState_ :: Monad m => t -> MultiGSTT (Settable t ': tr) m a -> MultiGSTT tr m ()
- without :: Monad m => MultiGSTT tr m a -> MultiGSTT (ct ': tr) m a
- mGetRaw :: Monad m => MultiGSTT ts m (HListM ts)
- mSetRaw :: Monad m => HListM ts -> MultiGSTT ts m ()
- mGetRawR :: (Monad m, HListMGettableClass ts) => MultiGSTT ts m (HList (HListMGettableOnly ts))
- mapMultiGSTT :: ts ~ HListM cts => (m (a, ts) -> m' (a', ts)) -> MultiGSTT cts m a -> MultiGSTT cts m' a'
Documentation
newtype MultiGSTT ts m a Source #
MultiGSTT | |
|
(Monad m, Monoid a, HListMContains TellableFlag a cts) => MonadMultiWriter a (MultiGSTT cts m) Source # | |
(Monad m, HListMContains GettableFlag a cts) => MonadMultiGet a (MultiGSTT cts m) Source # | |
(Monad m, HListMContains SettableFlag a cts) => MonadMultiState a (MultiGSTT cts m) Source # | |
MonadTrans (MultiGSTT ts) Source # | |
Monad m => Monad (MultiGSTT ts m) Source # | |
Functor m => Functor (MultiGSTT ts m) Source # | |
Monad m => Applicative (MultiGSTT ts m) Source # | |
MonadIO m => MonadIO (MultiGSTT ts m) Source # | |
MonadPlus m => Alternative (MultiGSTT ts m) Source # | |
MonadPlus m => MonadPlus (MultiGSTT ts m) Source # | |
type MultiGSTTNull = MultiGSTT '[] Source #
MonadMulti classes
type ContainsReader = HListMContains GettableFlag Source #
type ContainsState = HListMContains SettableFlag Source #
type ContainsWriter = HListMContains TellableFlag Source #
class Monad m => MonadMultiReader a m where Source #
All methods must be defined.
The idea is: Any monad stack is instance of MonadMultiReader a
, iff
the stack contains a MultiReaderT x
with a element of x.
(MonadTrans t, Monad (t m), MonadMultiReader a m) => MonadMultiReader a (t m) Source # | |
(Monad m, ContainsType a c) => MonadMultiReader a (MultiReaderT c m) Source # | |
(Monad m, ContainsType a c) => MonadMultiReader a (MultiReaderT c m) Source # | |
(Monad m, ContainsType a r) => MonadMultiReader a (MultiRWST r w s m) Source # | |
(Monad m, ContainsType a r) => MonadMultiReader a (MultiRWST r w s m) Source # | |
class (Monad m, Monoid a) => MonadMultiWriter a m where Source #
(MonadTrans t, Monad (t m), MonadMultiWriter a m) => MonadMultiWriter a (t m) Source # | |
(Monad m, ContainsType a c, Monoid a) => MonadMultiWriter a (MultiWriterT c m) Source # | |
(Monad m, ContainsType a c, Monoid a) => MonadMultiWriter a (MultiWriterT c m) Source # | |
(Monad m, Monoid a, HListMContains TellableFlag a cts) => MonadMultiWriter a (MultiGSTT cts m) Source # | |
(Monad m, Monoid a, HListMContains TellableFlag a cts) => MonadMultiWriter a (MultiGSTT cts m) Source # | |
(Monad m, ContainsType a w, Monoid a) => MonadMultiWriter a (MultiRWST r w s m) Source # | |
(Monad m, ContainsType a w, Monoid a) => MonadMultiWriter a (MultiRWST r w s m) Source # | |
class Monad m => MonadMultiGet a m where Source #
In contrast to MonadMultiReader, MonadMultiGet is defined for State too, so it corresponds to read-access of any kind.
Note however that for MultiRWS, only the values from the state
part can
be accessed via MonadMultiGet
, due to limitations of the design of
MultiRWS
and of the type system. This is issue is resolved in the
MultiGST
type.
(MonadTrans t, Monad (t m), MonadMultiGet a m) => MonadMultiGet a (t m) Source # | |
(Monad m, ContainsType a c) => MonadMultiGet a (MultiReaderT c m) Source # | |
(Monad m, ContainsType a c) => MonadMultiGet a (MultiReaderT c m) Source # | |
(Monad m, ContainsType a c) => MonadMultiGet a (MultiStateT c m) Source # | |
(Monad m, ContainsType a c) => MonadMultiGet a (MultiStateT c m) Source # | |
(Monad m, HListMContains GettableFlag a cts) => MonadMultiGet a (MultiGSTT cts m) Source # | |
(Monad m, HListMContains GettableFlag a cts) => MonadMultiGet a (MultiGSTT cts m) Source # | |
(Monad m, ContainsType a s) => MonadMultiGet a (MultiRWST r w s m) Source # | |
(Monad m, ContainsType a s) => MonadMultiGet a (MultiRWST r w s m) Source # | |
class MonadMultiGet a m => MonadMultiState a m where Source #
(MonadTrans t, Monad (t m), MonadMultiState a m) => MonadMultiState a (t m) Source # | |
(Monad m, ContainsType a c) => MonadMultiState a (MultiStateT c m) Source # | |
(Monad m, ContainsType a c) => MonadMultiState a (MultiStateT c m) Source # | |
(Monad m, HListMContains SettableFlag a cts) => MonadMultiState a (MultiGSTT cts m) Source # | |
(Monad m, HListMContains SettableFlag a cts) => MonadMultiState a (MultiGSTT cts m) Source # | |
(Monad m, ContainsType a s) => MonadMultiState a (MultiRWST r w s m) Source # | |
(Monad m, ContainsType a s) => MonadMultiState a (MultiRWST r w s m) Source # | |
run-functions
runMultiGSTTNil :: Monad m => MultiGSTT '[] m a -> m a Source #
runMultiGSTTNil_ :: Monad m => MultiGSTT '[] m a -> m () Source #
with-functions
withReaders :: Monad m => HList rs -> MultiGSTT (AppendM (HListMReaders rs) ts) m a -> MultiGSTT ts m a Source #
withWriter :: (Monoid t, Monad m) => MultiGSTT (Tellable t ': tr) m a -> MultiGSTT tr m (a, t) Source #
withWriterAW :: (Monoid t, Monad m) => MultiGSTT (Tellable t ': tr) m a -> MultiGSTT tr m (a, t) Source #
withWriterWA :: (Monoid t, Monad m) => MultiGSTT (Tellable t ': tr) m a -> MultiGSTT tr m (t, a) Source #
without-functions
other functions
mGetRawR :: (Monad m, HListMGettableClass ts) => MultiGSTT ts m (HList (HListMGettableOnly ts)) Source #
mapMultiGSTT :: ts ~ HListM cts => (m (a, ts) -> m' (a', ts)) -> MultiGSTT cts m a -> MultiGSTT cts m' a' Source #