Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- data Exceptional eff exc m a
- type SafeError exc = Exceptional (Throw exc) exc
- catching :: forall eff exc m a. Eff (Exceptional eff exc) m => ExceptionallyC eff exc m a -> (exc -> m a) -> m a
- trying :: forall eff exc m a. Eff (Exceptional eff exc) m => ExceptionallyC eff exc m a -> m (Either exc a)
- throwing :: forall eff exc m a. Effs [Exceptional eff exc, Throw exc] m => ExceptionallyC eff exc m a -> m a
- catchSafe :: forall exc m a. Eff (SafeError exc) m => ExceptionallyC (Throw exc) exc m a -> (exc -> m a) -> m a
- trySafe :: forall exc m a. Eff (SafeError exc) m => ExceptionallyC (Throw exc) exc m a -> m (Either exc a)
- runExceptional :: forall eff exc m a. (Member eff (Derivs m), Eff (Catch exc) m) => ExceptionalC eff exc m a -> m a
- runExceptionalJust :: forall eff smallExc bigExc m a. (Member eff (Derivs m), Eff (Error bigExc) m) => (bigExc -> Maybe smallExc) -> InterpretReifiedC (Exceptional eff smallExc) m a -> m a
- safeErrorToError :: forall exc m a. Eff (Error exc) m => SafeErrorToErrorC exc m a -> m a
- runSafeError :: forall e m a p. (Carrier m, Threaders '[ErrorThreads] m p) => SafeErrorC e m a -> m a
- safeErrorToIO :: forall e m a. (Eff (Embed IO) m, MonadCatch m) => SafeErrorToIOC e m a -> m a
- safeErrorToErrorIO :: forall e m a. Effs '[Embed IO, ErrorIO] m => SafeErrorToErrorIOC e m a -> m a
- runExceptionalJustSimple :: forall eff smallExc bigExc m a p. (Member eff (Derivs m), Eff (Error bigExc) m, Threaders '[ReaderThreads] m p) => (bigExc -> Maybe smallExc) -> InterpretSimpleC (Exceptional eff smallExc) m a -> m a
- safeErrorToIOSimple :: forall e m a p. (Eff (Embed IO) m, MonadCatch m, Threaders '[ReaderThreads] m p) => SafeErrorToIOSimpleC e m a -> m a
- safeErrorToErrorIOSimple :: forall e m a p. (Effs '[ErrorIO, Embed IO] m, Threaders '[ReaderThreads] m p) => SafeErrorToErrorIOSimpleC e m a -> m a
- class (forall e. Threads (ExceptT e) p) => ErrorThreads p
- class MonadThrow m => MonadCatch (m :: Type -> Type)
- data ExceptionallyC (eff :: Effect) (exc :: *) m a
- type ExceptionalC eff exc = InterpretC ExceptionalH (Exceptional eff exc)
- type SafeErrorToErrorC exc = ExceptionalC (Throw exc) exc
- type SafeErrorC exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, ErrorC exc]
- type SafeErrorToIOC' s s' exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, ErrorToIOC' s s' exc]
- type SafeErrorToIOC e m a = forall s s'. ReifiesErrorHandler s s' e (ErrorIOToIOC m) => SafeErrorToIOC' s s' e m a
- type SafeErrorToErrorIOC' s s' exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, InterpretErrorC' s s' exc]
- type SafeErrorToErrorIOC e m a = forall s s'. ReifiesErrorHandler s s' e m => SafeErrorToErrorIOC' s s' e m a
- type SafeErrorToIOSimpleC exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, ErrorToIOSimpleC exc]
- type SafeErrorToErrorIOSimpleC exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, InterpretErrorSimpleC exc]
Effects
data Exceptional eff exc m a Source #
An effect that allows for the safe use of an effect eff
that may
throw exceptions of the type exc
by forcing the user to eventually
catch those exceptions at some point of the program.
The main combinator of Exceptional
is catching
.
This could be unsafe in the presence of Conc
.
If you use catching
on a computation that:
- Spawns an asynchronous computation
- Throws an exception inside the asynchronous computation from a use of
eff
- Returns the
Async
of that asynchronous computation
Then wait
ing on that Async
outside of the catching
will throw that exception without it being caught.
type SafeError exc = Exceptional (Throw exc) exc Source #
A particularly useful specialization of Exceptional
, for gaining
restricted access to an
effect.
Main combinators are Error
exccatchSafe
and trySafe
.
Actions
catching :: forall eff exc m a. Eff (Exceptional eff exc) m => ExceptionallyC eff exc m a -> (exc -> m a) -> m a Source #
Gain access to eff
and
within a region,
but only if you're ready to handle any unhandled exception Catch
exce :: exc
that may arise from the use of eff
within that region.
For example:
-- A part of the program unknowing and uncaring that the use of SomeEffect -- may throw exceptions. uncaringProgram ::Eff
SomeEffect m => m String uncaringProgram = do doSomeThing doSomeOtherThing caringProgram ::Eff
(Exceptional
SomeEffect SomeEffectExc) m => m String caringProgram =catching
@eff uncaringProgram (\(exc :: SomeEffectExc) -> handlerForSomeEffectExc exc)
trying :: forall eff exc m a. Eff (Exceptional eff exc) m => ExceptionallyC eff exc m a -> m (Either exc a) Source #
Gain access to eff
within a region. If any use of eff
within that region throw
s an unhandled exception e :: exc
,
then this returns Left e
.
throwing :: forall eff exc m a. Effs [Exceptional eff exc, Throw exc] m => ExceptionallyC eff exc m a -> m a Source #
Gain access to eff
within a region, rethrowing
any exception e :: exc
that may occur from the use of
eff
within that region.
catchSafe :: forall exc m a. Eff (SafeError exc) m => ExceptionallyC (Throw exc) exc m a -> (exc -> m a) -> m a Source #
Gain access to
within a region,
but only if you're ready to handle any unhandled exception Error
exce :: exc
that may arise from within that region.
trySafe :: forall exc m a. Eff (SafeError exc) m => ExceptionallyC (Throw exc) exc m a -> m (Either exc a) Source #
Interpretations
runExceptional :: forall eff exc m a. (Member eff (Derivs m), Eff (Catch exc) m) => ExceptionalC eff exc m a -> m a Source #
Run an
effect if both Exceptional
eff exceff
and
are part of the effect stack.Catch
exc
In order for this to be safe, you must ensure that the
catches all exceptions that arise from the use of Catch
exceff
and that
only uses of eff
throws those exceptions.
Otherwise, the use of catching
is liable to catch
exceptions not arising from uses of eff
, or fail to catch
exceptions that do arise from uses of eff
.
runExceptionalJust :: forall eff smallExc bigExc m a. (Member eff (Derivs m), Eff (Error bigExc) m) => (bigExc -> Maybe smallExc) -> InterpretReifiedC (Exceptional eff smallExc) m a -> m a Source #
Run an
effect if Exceptional
eff exceff
is part of the
effect stack, provided a function that identifies the kind of exceptions
that may arise from the use of eff
.
In order for this to be safe, you must ensure that the function
identifies all exceptions that arise from the use of eff
and that
only uses of eff
throws those exceptions.
Otherwise, the use of catching
is liable to catch
other exceptions not arising from uses of eff
, or fail to catch
exceptions that do arise from uses of eff
.
The type of this interpreter is higher-rank, as it makes use of
InterpretReifiedC
. This makes runExceptionalJust
difficult to
use partially applied; for example, you can't compose it using
.
You may prefer the simpler, but less performant, .
runExceptionalJustSimple
.
safeErrorToError :: forall exc m a. Eff (Error exc) m => SafeErrorToErrorC exc m a -> m a Source #
runSafeError :: forall e m a p. (Carrier m, Threaders '[ErrorThreads] m p) => SafeErrorC e m a -> m a Source #
Run a
effect purely.SafeError
e
Derivs
(SafeErrorC
e m) =SafeError
e ':Prims
m
Prims
(SafeErrorC
e m) =Optional
((->) e) ':Prims
m
safeErrorToIO :: forall e m a. (Eff (Embed IO) m, MonadCatch m) => SafeErrorToIOC e m a -> m a Source #
Runs a
effect by making use of SafeError
eIO
exceptions.
Derivs
(SafeErrorToIOC
e m) =SafeError
e ':Derivs
m
Prims
(SafeErrorToIOC
e m) =Optional
((->)SomeException
) ':Prims
m
This has a higher-rank type, as it makes use of SafeErrorToIOC
.
This makes safeErrorToIO
very difficult to use partially applied.
In particular, it can't be composed using
..
If performance is secondary, consider using the slower
safeErrorToIOSimple
, which doesn't have a higher-rank type.
safeErrorToErrorIO :: forall e m a. Effs '[Embed IO, ErrorIO] m => SafeErrorToErrorIOC e m a -> m a Source #
Runs a
effect by transforming it into SafeError
eErrorIO
and
.Embed
IO
This has a higher-rank type, as it makes use of SafeErrorToErrorIOC
.
This makes safeErrorToErrorIO
very difficult to use partially applied.
In particular, it can't be composed using
..
If performance is secondary, consider using the slower
safeErrorToErrorIOSimple
, which doesn't have a higher-rank type.
Simple variants of interpretations
runExceptionalJustSimple :: forall eff smallExc bigExc m a p. (Member eff (Derivs m), Eff (Error bigExc) m, Threaders '[ReaderThreads] m p) => (bigExc -> Maybe smallExc) -> InterpretSimpleC (Exceptional eff smallExc) m a -> m a Source #
Run an
effect if Exceptional
eff exceff
is part of the
effect stack, provided a function that identifies the kind of exceptions
that may arise from the use of eff
.
In order for this to be safe, you must ensure that the function
identifies all exceptions that arise from the use of eff
and that
only uses of eff
throws those exceptions.
Otherwise, the use of catching
is liable to catch
exceptions not arising from uses of eff
, or fail to catch
exceptions that do arise from uses of eff
.
This is a less performant version of runExceptionalJust
, but doesn't have
a higher-rank type. This makes runExceptionalJustSimple
much easier to use
partially applied.
safeErrorToIOSimple :: forall e m a p. (Eff (Embed IO) m, MonadCatch m, Threaders '[ReaderThreads] m p) => SafeErrorToIOSimpleC e m a -> m a Source #
Runs a
effect by making use of SafeError
eIO
exceptions.
Derivs
(SafeErrorToIOSimpleC
e m) =SafeError
e ':Derivs
m
Prims
(SafeErrorToIOSimpleC
e m) =Optional
((->)SomeException
) ':Prims
m
This is a less performant version of safeErrorToIO
that doesn't have
a higher-rank type, making it much easier to use partially applied.
safeErrorToErrorIOSimple :: forall e m a p. (Effs '[ErrorIO, Embed IO] m, Threaders '[ReaderThreads] m p) => SafeErrorToErrorIOSimpleC e m a -> m a Source #
Runs a
effect by transforming it into SafeError
eErrorIO
and
.Embed
IO
This is a less performant version of safeErrorToErrorIO
that doesn't have
a higher-rank type, making it much easier to use partially applied.
Threading constraints
class (forall e. Threads (ExceptT e) p) => ErrorThreads p Source #
ErrorThreads
accepts the following primitive effects:
Regional
s
Optional
s
(whens
is a functor)BaseControl
b
Unravel
p
ListenPrim
o
(wheno
is aMonoid
)WriterPrim
o
(wheno
is aMonoid
)ReaderPrim
i
Mask
Bracket
Fix
Instances
(forall e. Threads (ExceptT e) p) => ErrorThreads p Source # | |
Defined in Control.Effect.Internal.Error |
MonadCatch
class MonadThrow m => MonadCatch (m :: Type -> Type) #
A class for monads which allow exceptions to be caught, in particular
exceptions which were thrown by throwM
.
Instances should obey the following law:
catch (throwM e) f = f e
Note that the ability to catch an exception does not guarantee that we can
deal with all possible exit points from a computation. Some monads, such as
continuation-based stacks, allow for more than just a success/failure
strategy, and therefore catch
cannot be used by those monads to properly
implement a function such as finally
. For more information, see
MonadMask
.
Instances
Carriers
data ExceptionallyC (eff :: Effect) (exc :: *) m a Source #
Instances
type ExceptionalC eff exc = InterpretC ExceptionalH (Exceptional eff exc) Source #
type SafeErrorToErrorC exc = ExceptionalC (Throw exc) exc Source #
type SafeErrorC exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, ErrorC exc] Source #
type SafeErrorToIOC' s s' exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, ErrorToIOC' s s' exc] Source #
type SafeErrorToIOC e m a = forall s s'. ReifiesErrorHandler s s' e (ErrorIOToIOC m) => SafeErrorToIOC' s s' e m a Source #
type SafeErrorToErrorIOC' s s' exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, InterpretErrorC' s s' exc] Source #
type SafeErrorToErrorIOC e m a = forall s s'. ReifiesErrorHandler s s' e m => SafeErrorToErrorIOC' s s' e m a Source #
type SafeErrorToIOSimpleC exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, ErrorToIOSimpleC exc] Source #
type SafeErrorToErrorIOSimpleC exc = CompositionC '[IntroUnderC (SafeError exc) '[Catch exc, Throw exc], SafeErrorToErrorC exc, InterpretErrorSimpleC exc] Source #