free-concurrent-0.1.0.1: Free monads suitable for concurrent computation

Safe HaskellSafe
LanguageHaskell2010

Control.Concurrent.Free

Synopsis

Documentation

data F f a Source

The combination of a free functor, a free applicative functor, and free monad over f.

The semantics of the Functor, Applicative and Monad instances are such that it tries to pick the lowest possible abstraction to perform the operation.

This means that if a computation is constructed using fmap, pure and <*>, it can be parallelised up until the point where the first monadic join sits.

Instances

liftF :: f a -> F f a Source

Lifts an f a into a F f a.

hoist :: (forall a. f a -> g a) -> F f a -> F g a Source

Given a natural transformation from f to g this gives a monoidal natural transformation from F f to F g.

retractA :: Applicative f => F f a -> Maybe (f a) Source

Partially interprets the free monad over f using the semantics for pure and <*> given by the Applicative instance for f. If it encounters a monadic join, the result is Nothing.

retractM :: Monad f => F f a -> f a Source

Interprets the free monad over f using the semantics for return and >>= given by the Monad instance for f.

foldA :: Applicative g => (forall x. f x -> g x) -> F f a -> Maybe (g a) Source

Given a natural transformation from f to g, this gives a partial monoidal natural transformation from F f to g.

foldM :: Monad m => (forall x. f x -> m x) -> F f a -> m a Source

Given a natural transformation from f to m, this gives a canonical monoidal natural transformation from F f to m.

foldConcurrentM :: Monad m => (forall x. f x -> m (m x)) -> F f a -> m a Source

Interprets the free monad over f using the transformation from f to m m.

The semantics of the concurrency are given by the transformation, which produces a result that is unwrapped in two stages: The first monadic layer should spawn the concurrent action, and reveal the second layer, which should block until the spawned action has returned with a result.

retractConcurrentIO :: F IO a -> IO a Source

Interprets the free monad over IO using concurrent semantics, meaning multiple actions may run in parallel.

foldConcurrentIO :: (forall x. f x -> IO x) -> F f a -> IO a Source

Given a natural transformation from f to IO, this gives a natural transformation from F f to IO where the actions may run concurrently.