summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorerick <>2019-03-13 10:35:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-03-13 10:35:00 (GMT)
commiteae20b69d2cf4ce24ff4e8fd7664ca1a683850d5 (patch)
treeeb127a0c418c09fe783b51b11ddc238ce7a40dd9
parent0150df17f2c2c777ff7ecb49aaa9fffda87ca6f2 (diff)
version 1.2.0.01.2.0.0
-rw-r--r--failable.cabal4
-rw-r--r--src/Control/Monad/Failable.hs49
2 files changed, 50 insertions, 3 deletions
diff --git a/failable.cabal b/failable.cabal
index a05f2f3..a967c68 100644
--- a/failable.cabal
+++ b/failable.cabal
@@ -4,10 +4,10 @@ cabal-version: 1.12
--
-- see: https://github.com/sol/hpack
--
--- hash: 2156677b8596bc4da7b62af27300220dff65805690fad23c10ac51895c635b4b
+-- hash: 0abe156a52880d8108f2cd1ead2a01df5ab9adf98e83877eb4a53ed83789fab7
name: failable
-version: 1.1.0.0
+version: 1.2.0.0
synopsis: A 'Failable' error monad class to unify failure across monads that can fail
description: This library contains a 'Failable' error monad class to unify failure across monads and transformers most commonly used to implement pipelines that can fail and does so in a simple nonsense way by providing the means of signaling a computation "failure" while striving to keep the failure behaviour consistent with the actual definition of the monad/transformer. Please refer to the README file for a more elaborate description and some examples.
category: control, exceptions, monad
diff --git a/src/Control/Monad/Failable.hs b/src/Control/Monad/Failable.hs
index e80307e..4730e87 100644
--- a/src/Control/Monad/Failable.hs
+++ b/src/Control/Monad/Failable.hs
@@ -1,4 +1,10 @@
-{-# LANGUAGE FlexibleInstances, FunctionalDependencies, GADTs, MultiParamTypeClasses #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE UndecidableInstances #-}
+
{- |
Module: Control.Monad.Failable
Description: Yet another error monad but for people who are not crazy
@@ -64,13 +70,20 @@ module Control.Monad.Failable (
--
Failable(..), Hoistable(..), failableIO) where
+import Data.Bifunctor (second)
import Control.Exception (Exception(..), SomeException(..), throw, catch)
import Control.Monad (join)
import Control.Monad.Except (ExceptT(..), runExceptT, throwError)
import Control.Monad.IO.Class (MonadIO, liftIO)
+import Control.Monad.State.Class (MonadState, get, put)
+import Control.Monad.State.Strict (StateT, runStateT)
+import Control.Monad.Writer.Strict (WriterT, runWriterT, tell)
+import Control.Monad.Reader (ReaderT, runReaderT, ask)
+import Control.Monad.Trans (MonadTrans, lift)
import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
import System.IO.Error (tryIOError)
+
instance Exception ()
-- | The 'Failable' class. A Monad which is an instance of this class can be used as a context
@@ -105,6 +118,7 @@ class (Failable m) => Hoistable m t e' | t -> e' where
--
hoist :: (Exception e) => (e' -> e) -> t a -> m a
+
instance Failable IO where
failure = throw
recover = catch
@@ -136,6 +150,39 @@ instance (Monad m, e ~ SomeException) => Failable (ExceptT e m) where
where recover' (Left err) = runExceptT $ f err
recover' x = return x
+class (MonadTrans t, Monad m) => RunnableStateT t s m where
+ runS :: t m a -> s -> m (a, s)
+
+instance (Monad m) => RunnableStateT (StateT s) s m where
+ runS = runStateT
+
+instance (Monad m) => RunnableStateT (ReaderT r) r m where
+ runS a s = (, s) <$> runReaderT a s
+
+instance (Monad m, Monoid w) => RunnableStateT (WriterT w) w m where
+ runS a s = fmap (second $ mappend s) $ runWriterT a
+
+instance {-# OVERLAPPABLE #-} (Monad (t m), MonadTrans t, Failable m, RunnableStateT t s m, MonadState s (t m)) => Failable (t m) where
+ failure = lift . failure
+ recover a f = get >>= foo
+ where foo s = do
+ (r, s') <- lift $ runS a s `recover` \e -> runS (f e) s
+ put s'
+ return r
+
+instance (Monoid w, Failable m) => Failable (WriterT w m) where
+ failure = lift . failure
+ recover a f = do
+ (x, w) <- lift $ runWriterT a `recover` \e -> runWriterT (f e)
+ tell w
+ return x
+
+instance (Failable m) => Failable (ReaderT r m) where
+ failure = lift . failure
+ recover a f = do
+ r <- ask
+ lift $ runReaderT a r `recover` \e -> runReaderT (f e) r
+
instance (Failable m) => Hoistable m Maybe () where
hoist f = maybe (failure $ f ()) return