Copyright | (c) Erick Gonzalez 2019 |
---|---|
License | BSD3 |
Maintainer | erick@codemonkeylabs.de |
Safe Haskell | Safe |
Language | Haskell2010 |
Control.Monad.Failable
Contents
Description
This library provides a Failable
error monad class to unify errors across monads and
transformers most commonly used to implement pipelines that can fail.
Documentation
I am sure a lot of ink has been spilled in forums and around water coolers all around the world, debating the merits and fallacies of one approach or the other. The reason for this package is not to participate in this discussion but rather to provide a simple no nonsense means of signaling a computation "failure" in those monads that provide the inherent means to do so, and to do it in a consistent manner.
When triggering a failure in a monadic context which is an instance of this class, simply
define your custom exception type and abort the computation with failure
. For example:
data MyException = SomeProblem | AnotherProblem deriving (Show, Typeable) instance Exception MyException foo :: (Failable m) => Int -> m Int foo x = do y <- bar x if y < 0 then failure SomeProblem else return y
if foo is then called in a Maybe
Monad, it would return Nothing
in case of error
or Just ()
of course if succesful. In an Either SomeException
context, it would
return Left SomeProblem
in case of error or Right ()
upon success, etc.
When it comes to monad transformers incorporating the concept of failure, such as MaybeT
or
ExceptT
, it preserves the expected semantics upon failure of yielding an m Nothing
or
m (Either SomeException a)
when the transformer is "ran", instead of adopting the strategy
of passing the failure to the underlying monad (transformer) which might for example, throw
an async exception (as is the case of IO). Since the reason d'etre for something like runMaybeT
is to provide the underlying monad (transformer) with Maybe
like behaviour, i.e. have
Nothing
be returned in case of aborting the Maybe
pipeline so to speak, then throwing an
exception defeats IMHO the purpose of using MaybeT
in the first place.
>>>
foo 2 :: Maybe Int
>>>
Nothing
>>>
foo 2 :: Either SomeException Int
>>>
Left SomeProblem
>>>
foo 2 :: IO Int
>>>
* * * Exception: SomeProblem
>>>
runMaybeT $ foo 2 :: IO (Maybe Int)
>>>
Nothing
class Monad m => Failable m where Source #
The Failable
class. A Monad which is an instance of this class can be used as a context
in a function running in one with this class constraint, in order to report error conditions
Methods
failure :: Exception e => e -> m a Source #
trigger a failure. It takes an exception value as argument and it returns whatever might be used to abort a monadic computation in the monad instantiating this class.
recover :: e ~ SomeException => m a -> (e -> m a) -> m a Source #
recover from a possible failure. Basically a generalized catch
for a Failable
.
Instances
Failable [] Source # | |
Defined in Control.Monad.Failable | |
Failable Maybe Source # | |
Failable IO Source # | |
e ~ SomeException => Failable (Either e) Source # | |
(Monad (t m), MonadTrans t, Failable m, RunnableStateT t s m, MonadState s (t m)) => Failable (t m) Source # | |
Defined in Control.Monad.Failable | |
Monad m => Failable (MaybeT m) Source # | |
(Monad m, e ~ SomeException) => Failable (ExceptT e m) Source # | |
(Monoid w, Failable m) => Failable (WriterT w m) Source # | |
Failable m => Failable (ReaderT r m) Source # | |
class Failable m => Hoistable m t e' | t -> e' where Source #
A Hoistable
is a type that can be "promoted" or "hoisted" to a Failable monad.
Methods
hoist :: Exception e => (e' -> e) -> t a -> m a Source #
Given a transformation function to obtain an error in the target Failable
context from
an eventual errored value from the value being hoisted, It promotes such value to a Failable
operation. For example:
foo :: (Failable m) => String -> m Int foo = hoist BadValue . readEither
>>>
λ> runExceptT $ foo "5"
>>>
Right 5
>>>
λ> foo "X5"
>>>
*** Exception: BadValue "Prelude.read: no parse"
>>>
λ> runMaybeT $ foo "X5"
>>>
Nothing
failableIO :: (Failable m, MonadIO m) => IO a -> m a Source #
Perform a set of IO actions in a Failable
MonadIO
instance, triggering a
failure
upon an IO exception, instead of blindly triggering an asynchronos exception. This
serves ultimately to unify error handling in the Failable
context. For example:
foo :: (Failable m, MonadIO m) => m () foo = do failableIO $ do txt <- readFile "foo.txt" putStrLn txt
>>>
λ> runExceptT foo
>>>
Left foo.txt: openFile: does not exist (No such file or directory)
>>>
>>>
λ> runMaybeT foo
>>>
Nothing
>>>
>>>
λ> foo
>>>
*** Exception: foo.txt: openFile: does not exist (No such file or directory)
Orphan instances
Exception () Source # | |
Methods toException :: () -> SomeException # fromException :: SomeException -> Maybe () # displayException :: () -> String # |