fx-0.4: Revamped effect system

Safe HaskellNone
LanguageHaskell2010

Fx

Contents

Synopsis

Fx

data Fx env err res Source #

Effectful computation with explicit errors in the context of provided environment.

Calling fail causes the whole app to interrupt outputting a message to console. fail is intended to be used in events which you expect never to happen, and hence which should be considered bugs. It is similar to calling fail on IO, with a major difference of the error never getting lost in a concurrent environment.

Calling fail results in ErrorCallFxExceptionReason in the triggerred FxException. Thus in effect it is the same as calling the error function.

Instances
EnvMapping Fx Source # 
Instance details

Defined in Fx

Methods

mapEnv :: (b -> a) -> Fx a err res -> Fx b err res Source #

FxRunning () Void (Fx env err) Source #

Executes an effect with no environment and all errors handled in Fx with any environment and error.

Same as (mapEnv (const ()) . first absurd).

Instance details

Defined in Fx

Methods

runFx :: Fx () Void res -> Fx env err res Source #

Bifunctor (Fx env) Source # 
Instance details

Defined in Fx

Methods

bimap :: (a -> b) -> (c -> d) -> Fx env a c -> Fx env b d #

first :: (a -> b) -> Fx env a c -> Fx env b c #

second :: (b -> c) -> Fx env a b -> Fx env a c #

ErrHandling (Fx env) Source # 
Instance details

Defined in Fx

Methods

throwErr :: err -> Fx env err res Source #

handleErr :: (a -> Fx env b res) -> Fx env a res -> Fx env b res Source #

Monad (Fx env err) Source # 
Instance details

Defined in Fx

Methods

(>>=) :: Fx env err a -> (a -> Fx env err b) -> Fx env err b #

(>>) :: Fx env err a -> Fx env err b -> Fx env err b #

return :: a -> Fx env err a #

fail :: String -> Fx env err a #

Functor (Fx env err) Source # 
Instance details

Defined in Fx

Methods

fmap :: (a -> b) -> Fx env err a -> Fx env err b #

(<$) :: a -> Fx env err b -> Fx env err a #

MonadFail (Fx env err) Source # 
Instance details

Defined in Fx

Methods

fail :: String -> Fx env err a #

Applicative (Fx env err) Source # 
Instance details

Defined in Fx

Methods

pure :: a -> Fx env err a #

(<*>) :: Fx env err (a -> b) -> Fx env err a -> Fx env err b #

liftA2 :: (a -> b -> c) -> Fx env err a -> Fx env err b -> Fx env err c #

(*>) :: Fx env err a -> Fx env err b -> Fx env err b #

(<*) :: Fx env err a -> Fx env err b -> Fx env err a #

MonadIO (Fx env SomeException) Source # 
Instance details

Defined in Fx

Methods

liftIO :: IO a -> Fx env SomeException a #

Monoid err => Alternative (Fx env err) Source # 
Instance details

Defined in Fx

Methods

empty :: Fx env err a #

(<|>) :: Fx env err a -> Fx env err a -> Fx env err a #

some :: Fx env err a -> Fx env err [a] #

many :: Fx env err a -> Fx env err [a] #

Monoid err => MonadPlus (Fx env err) Source # 
Instance details

Defined in Fx

Methods

mzero :: Fx env err a #

mplus :: Fx env err a -> Fx env err a -> Fx env err a #

Selective (Fx env err) Source # 
Instance details

Defined in Fx

Methods

select :: Fx env err (Either a b) -> Fx env err (a -> b) -> Fx env err b #

Environment handling

provideAndUse :: Provider err env -> Fx env err res -> Fx env' err res Source #

Execute Fx in the scope of a provided environment.

handleEnv :: (env -> Fx env err res) -> Fx env err res Source #

Collapse an env handler into an environmental effect.

Warning: This function leaks the abstraction over the environment. It is your responsibility to ensure that you don't use it to return the environment and use it outside of the handler's scope.

Concurrency

start :: Fx env err res -> Fx env err' (Future err res) Source #

Spawn a thread and start running an effect on it, returning the associated future.

Fatal errors on the spawned thread are guaranteed to get propagated to the top. By fatal errors we mean calls to error, fail and uncaught exceptions.

Normal errors (the explicit err parameter) will only propagate if you use wait at some point.

Warning: It is your responsibility to ensure that the whole future executes before the running Fx finishes. Otherwise you will lose the environment in scope of which the future executes. To achieve that use wait.

wait :: Future err res -> Fx env err res Source #

Block until the future completes either with a result or an error.

concurrently :: Conc env err res -> Fx env err res Source #

Execute concurrent effects.

IO execution

These functions leak abstraction in one way or the other, requiring you to ensure that your code doesn't throw unexpected exceptions. try are catch are your tools for that.

Besides these functions Fx also has an instance of MonadIO, which provides the only non-leaky way of running IO, catching all possible exceptions.

runTotalIO :: IO res -> Fx env err res Source #

Turn a non-failing IO action into an effect.

Warning: It is your responsibility to ensure that it does not throw exceptions!

runPartialIO :: IO (Either err res) -> Fx env err res Source #

Run IO which produces either an error or result.

Warning: It is your responsibility to ensure that it does not throw exceptions!

runExceptionalIO :: Exception exc => IO res -> Fx env exc res Source #

Run IO which only throws a specific type of exception.

Warning: It is your responsibility to ensure that it doesn't throw any other exceptions!

runSTM :: STM res -> Fx env err res Source #

Run STM, crashing in case of STM exceptions.

Same as runTotalIO . atomically.

Provider

data Provider err env Source #

Effectful computation with explicit errors, which encompasses environment acquisition and releasing.

Composes well, allowing you to merge multiple providers into one.

Builds up on ideas expressed in http://www.haskellforall.com/2013/06/the-resource-applicative.html and later released as the "managed" package.

Instances
Bifunctor Provider Source # 
Instance details

Defined in Fx

Methods

bimap :: (a -> b) -> (c -> d) -> Provider a c -> Provider b d #

first :: (a -> b) -> Provider a c -> Provider b c #

second :: (b -> c) -> Provider a b -> Provider a c #

FxRunning () err (Provider err) Source # 
Instance details

Defined in Fx

Methods

runFx :: Fx () err res -> Provider err res Source #

Monad (Provider err) Source # 
Instance details

Defined in Fx

Methods

(>>=) :: Provider err a -> (a -> Provider err b) -> Provider err b #

(>>) :: Provider err a -> Provider err b -> Provider err b #

return :: a -> Provider err a #

fail :: String -> Provider err a #

Functor (Provider err) Source # 
Instance details

Defined in Fx

Methods

fmap :: (a -> b) -> Provider err a -> Provider err b #

(<$) :: a -> Provider err b -> Provider err a #

Applicative (Provider err) Source # 
Instance details

Defined in Fx

Methods

pure :: a -> Provider err a #

(<*>) :: Provider err (a -> b) -> Provider err a -> Provider err b #

liftA2 :: (a -> b -> c) -> Provider err a -> Provider err b -> Provider err c #

(*>) :: Provider err a -> Provider err b -> Provider err b #

(<*) :: Provider err a -> Provider err b -> Provider err a #

MonadIO (Provider SomeException) Source # 
Instance details

Defined in Fx

Methods

liftIO :: IO a -> Provider SomeException a #

acquireAndRelease :: Fx () err env -> (env -> Fx () err ()) -> Provider err env Source #

Create a resource provider from acquiring and releasing effects.

pool :: Int -> Provider err env -> Provider err (Provider err' env) Source #

Convert a single resource provider into a pool provider.

The wrapper provider acquires the specified amount of resources using the original provider, and returns a modified version of the original provider, whose acquisition and releasing merely takes one resource out of the pool and puts it back when done. No actual acquisition or releasing happens in the wrapped provider. No errors get raised in it either.

Use this when you need to access a resource concurrently.

Future

data Future err res Source #

Handle to a result of an action which may still be being executed on another thread.

The way you deal with it is thru the start and wait functions.

Instances
Bifunctor Future Source # 
Instance details

Defined in Fx

Methods

bimap :: (a -> b) -> (c -> d) -> Future a c -> Future b d #

first :: (a -> b) -> Future a c -> Future b c #

second :: (b -> c) -> Future a b -> Future a c #

ErrHandling Future Source # 
Instance details

Defined in Fx

Methods

throwErr :: err -> Future err res Source #

handleErr :: (a -> Future b res) -> Future a res -> Future b res Source #

Functor (Future err) Source # 
Instance details

Defined in Fx

Methods

fmap :: (a -> b) -> Future err a -> Future err b #

(<$) :: a -> Future err b -> Future err a #

Applicative (Future err) Source # 
Instance details

Defined in Fx

Methods

pure :: a -> Future err a #

(<*>) :: Future err (a -> b) -> Future err a -> Future err b #

liftA2 :: (a -> b -> c) -> Future err a -> Future err b -> Future err c #

(*>) :: Future err a -> Future err b -> Future err b #

(<*) :: Future err a -> Future err b -> Future err a #

Selective (Future err) Source #

Decides whether to wait for the result of another future.

Instance details

Defined in Fx

Methods

select :: Future err (Either a b) -> Future err (a -> b) -> Future err b #

Conc

data Conc env err res Source #

Wrapper over Fx, whose instances compose by running computations on separate threads.

You can turn Fx into Conc using runFx.

Instances
EnvMapping Conc Source # 
Instance details

Defined in Fx

Methods

mapEnv :: (b -> a) -> Conc a err res -> Conc b err res Source #

FxRunning env err (Conc env err) Source # 
Instance details

Defined in Fx

Methods

runFx :: Fx env err res -> Conc env err res Source #

Bifunctor (Conc env) Source # 
Instance details

Defined in Fx

Methods

bimap :: (a -> b) -> (c -> d) -> Conc env a c -> Conc env b d #

first :: (a -> b) -> Conc env a c -> Conc env b c #

second :: (b -> c) -> Conc env a b -> Conc env a c #

ErrHandling (Conc env) Source # 
Instance details

Defined in Fx

Methods

throwErr :: err -> Conc env err res Source #

handleErr :: (a -> Conc env b res) -> Conc env a res -> Conc env b res Source #

Functor (Conc env err) Source # 
Instance details

Defined in Fx

Methods

fmap :: (a -> b) -> Conc env err a -> Conc env err b #

(<$) :: a -> Conc env err b -> Conc env err a #

Applicative (Conc env err) Source # 
Instance details

Defined in Fx

Methods

pure :: a -> Conc env err a #

(<*>) :: Conc env err (a -> b) -> Conc env err a -> Conc env err b #

liftA2 :: (a -> b -> c) -> Conc env err a -> Conc env err b -> Conc env err c #

(*>) :: Conc env err a -> Conc env err b -> Conc env err b #

(<*) :: Conc env err a -> Conc env err b -> Conc env err a #

Selective (Conc env err) Source #

Spawns a computation, deciding whether to wait for it.

Instance details

Defined in Fx

Methods

select :: Conc env err (Either a b) -> Conc env err (a -> b) -> Conc env err b #

Classes

FxRunning

class FxRunning env err m | m -> env, m -> err where Source #

Support for running of Fx.

Apart from other things this is your interface to turn Fx into IO or Conc.

Methods

runFx :: Fx env err res -> m res Source #

Instances
FxRunning () Void IO Source #

Executes an effect with no environment and all errors handled.

Instance details

Defined in Fx

Methods

runFx :: Fx () Void res -> IO res Source #

FxRunning () err (Provider err) Source # 
Instance details

Defined in Fx

Methods

runFx :: Fx () err res -> Provider err res Source #

FxRunning () err (ExceptT err IO) Source # 
Instance details

Defined in Fx

Methods

runFx :: Fx () err res -> ExceptT err IO res Source #

FxRunning () Void (Fx env err) Source #

Executes an effect with no environment and all errors handled in Fx with any environment and error.

Same as (mapEnv (const ()) . first absurd).

Instance details

Defined in Fx

Methods

runFx :: Fx () Void res -> Fx env err res Source #

FxRunning env err (Conc env err) Source # 
Instance details

Defined in Fx

Methods

runFx :: Fx env err res -> Conc env err res Source #

FxRunning env err (ReaderT env (ExceptT err IO)) Source # 
Instance details

Defined in Fx

Methods

runFx :: Fx env err res -> ReaderT env (ExceptT err IO) res Source #

ErrHandling

class ErrHandling m where Source #

Support for error handling.

Functions provided by this class are particularly helpful, when you need to map into error of type Void.

Methods

throwErr :: err -> m err res Source #

Interrupt the current computation raising an error.

handleErr :: (a -> m b res) -> m a res -> m b res Source #

Handle error in another failing action. Sort of like a bind operation over the error type parameter.

Instances
ErrHandling Future Source # 
Instance details

Defined in Fx

Methods

throwErr :: err -> Future err res Source #

handleErr :: (a -> Future b res) -> Future a res -> Future b res Source #

ErrHandling (Conc env) Source # 
Instance details

Defined in Fx

Methods

throwErr :: err -> Conc env err res Source #

handleErr :: (a -> Conc env b res) -> Conc env a res -> Conc env b res Source #

ErrHandling (Fx env) Source # 
Instance details

Defined in Fx

Methods

throwErr :: err -> Fx env err res Source #

handleErr :: (a -> Fx env b res) -> Fx env a res -> Fx env b res Source #

exposeErr :: (ErrHandling m, Functor (m a), Applicative (m b)) => m a res -> m b (Either a res) Source #

Expose the error in result, producing an action, which is compatible with any error type.

absorbErr :: (ErrHandling m, Applicative (m b)) => (a -> res) -> m a res -> m b res Source #

Map from error to result, leaving the error be anything.

EnvMapping

class EnvMapping m where Source #

Support for mapping of the environment.

Methods

mapEnv :: (b -> a) -> m a err res -> m b err res Source #

Map the environment. Please notice that the expected function is contravariant.

Instances
EnvMapping Conc Source # 
Instance details

Defined in Fx

Methods

mapEnv :: (b -> a) -> Conc a err res -> Conc b err res Source #

EnvMapping Fx Source # 
Instance details

Defined in Fx

Methods

mapEnv :: (b -> a) -> Fx a err res -> Fx b err res Source #

Exceptions

data FxException Source #

Fatal failure of an Fx application. Informs of an unrecoverable condition that the application has reached. It is not meant to be caught, because it implies that there is either a bug in your code or a bug in the "fx" library itself, which needs reporting.

Consists of a list of thread identifiers specifying the nesting path of the faulty thread and the reason of failure.