| Safe Haskell | None | 
|---|---|
| Language | Haskell2010 | 
Polysemy.Internal.Tactics
Synopsis
- data Tactics f n r m a where- GetInitialState :: Tactics f n r m (f ())
- HoistInterpretation :: (a -> n b) -> Tactics f n r m (f a -> Sem r (f b))
- HoistInterpretationH :: (a -> n b) -> f a -> Tactics f n r m (f b)
- GetInspector :: Tactics f n r m (Inspector f)
 
- getInitialStateT :: forall f m r e. Sem (WithTactics e f m r) (f ())
- getInspectorT :: forall e f m r. Sem (WithTactics e f m r) (Inspector f)
- newtype Inspector f = Inspector {}
- runT :: m a -> Sem (WithTactics e f m r) (Sem (e ': r) (f a))
- runTSimple :: m a -> Tactical e m r a
- bindT :: (a -> m b) -> Sem (WithTactics e f m r) (f a -> Sem (e ': r) (f b))
- bindTSimple :: forall m f r e a b. (a -> m b) -> f a -> Sem (WithTactics e f m r) (f b)
- pureT :: a -> Tactical e m r a
- liftT :: forall m f r e a. Functor f => Sem r a -> Sem (WithTactics e f m r) (f a)
- runTactics :: Functor f => f () -> (forall x. f (m x) -> Sem r2 (f x)) -> (forall x. f x -> Maybe x) -> (forall x. f (m x) -> Sem r (f x)) -> Sem (Tactics f m r2 ': r) a -> Sem r a
- type Tactical e m r x = forall f. Functor f => Sem (WithTactics e f m r) (f x)
- type WithTactics e f m r = Tactics f m (e ': r) ': r
Documentation
data Tactics f n r m a where Source #
Constructors
| GetInitialState :: Tactics f n r m (f ()) | |
| HoistInterpretation :: (a -> n b) -> Tactics f n r m (f a -> Sem r (f b)) | |
| HoistInterpretationH :: (a -> n b) -> f a -> Tactics f n r m (f b) | |
| GetInspector :: Tactics f n r m (Inspector f) | 
getInitialStateT :: forall f m r e. Sem (WithTactics e f m r) (f ()) Source #
getInspectorT :: forall e f m r. Sem (WithTactics e f m r) (Inspector f) Source #
Get a natural transformation capable of potentially inspecting values
 inside of f. Binding the result of getInspectorT produces a function that
 can sometimes peek inside values returned by bindT.
This is often useful for running callback functions that are not managed by polysemy code.
Example
We can use the result of getInspectorT to "undo" pureT (or any of the other
 Tactical functions):
ins <-getInspectorTfa <-pureT"hello" fb <-pureTTrue let a =inspectins fa -- Just "hello" b =inspectins fb -- Just True
A container for inspect. See the documentation for getInspectorT.
Constructors
| Inspector | |
| Fields 
 | |
Arguments
| :: m a | The monadic action to lift. This is usually a parameter in your effect. | 
| -> Sem (WithTactics e f m r) (Sem (e ': r) (f a)) | 
Arguments
| :: m a | The monadic action to lift. This is usually a parameter in your effect. | 
| -> Tactical e m r a | 
Run a monadic action in a Tactical environment. The stateful environment
 used will be the same one that the effect is initally run in.
 Use bindTSimple if you'd prefer to explicitly manage your stateful
 environment.
This is a less flexible but significantly simpler variant of runT.
 Instead of returning a Sem action corresponding to the provided action,
 runTSimple runs the action immediately.
Since: 1.5.0.0
Arguments
| :: (a -> m b) | The monadic continuation to lift. This is usually a parameter in your effect. Continuations lifted via  | 
| -> Sem (WithTactics e f m r) (f a -> Sem (e ': r) (f b)) | 
Arguments
| :: forall m f r e a b. (a -> m b) | The monadic continuation to lift. This is usually a parameter in your effect. Continuations executed via  | 
| -> f a | |
| -> Sem (WithTactics e f m r) (f b) | 
Lift a kleisli action into the stateful environment.
 You can use bindTSimple to execute an effect parameter of the form
 a -> m b by providing the result of a runTSimple or another
 bindTSimple.
This is a less flexible but significantly simpler variant of bindT.
 Instead of returning a Sem kleisli action corresponding to the
 provided kleisli action, bindTSimple runs the kleisli action immediately.
Since: 1.5.0.0
liftT :: forall m f r e a. Functor f => Sem r a -> Sem (WithTactics e f m r) (f a) Source #
Internal function to create first-order interpreter combinators out of higher-order ones.
runTactics :: Functor f => f () -> (forall x. f (m x) -> Sem r2 (f x)) -> (forall x. f x -> Maybe x) -> (forall x. f (m x) -> Sem r (f x)) -> Sem (Tactics f m r2 ': r) a -> Sem r a Source #
Run the Tactics effect.
type Tactical e m r x = forall f. Functor f => Sem (WithTactics e f m r) (f x) Source #
Tactical is an environment in which you're capable of explicitly
 threading higher-order effect states. This is provided by the (internal)
 effect Tactics, which is capable of rewriting monadic actions so they run
 in the correct stateful environment.
Inside a Tactical, you're capable of running pureT, runT and bindT
 which are the main tools for rewriting monadic stateful environments.
For example, consider trying to write an interpreter for
 Resource, whose effect is defined as:
dataResourcem a whereBracket:: m a -> (a -> m ()) -> (a -> m b) ->Resourcem b
Here we have an m a which clearly needs to be run first, and then
 subsequently call the a -> m () and a -> m b arguments. In a Tactical
 environment, we can write the threading code thusly:
Bracketalloc dealloc use -> do alloc' <-runTalloc dealloc' <-bindTdealloc use' <-bindTuse
where
alloc' ::Sem(Resource': r) (f a1) dealloc' :: f a1 ->Sem(Resource': r) (f ()) use' :: f a1 ->Sem(Resource': r) (f x)
The f type here is existential and corresponds to "whatever
 state the other effects want to keep track of." f is always
 a Functor.
alloc', dealloc' and use' are now in a form that can be
 easily consumed by your interpreter. At this point, simply bind
 them in the desired order and continue on your merry way.
We can see from the types of dealloc' and use' that since they both
 consume a f a1, they must run in the same stateful environment. This
 means, for illustration, any puts run inside the use
 block will not be visible inside of the dealloc block.
Power users may explicitly use getInitialStateT and bindT to construct
 whatever data flow they'd like; although this is usually unnecessary.
type WithTactics e f m r = Tactics f m (e ': r) ': r Source #