{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE TupleSections #-} {-# LANGUAGE UndecidableInstances #-} {- | Module: Control.Monad.Failable Description: Yet another error monad but for people who are not crazy Copyright: (c) Erick Gonzalez, 2019 License: BSD3 Maintainer: erick@codemonkeylabs.de This library provides a 'Failable' error monad class to unify errors across monads and transformers most commonly used to implement pipelines that can fail. -} module Control.Monad.Failable ( -- | -- 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 -- Failable(..), Hoistable(..), RunnableStateT(..), -- * Utility functions autohoist, failableIO) where import Data.Bifunctor (second) import Control.Exception (Exception(..), SomeException(..), throw, catch) 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 -- in a function running in one with this class constraint, in order to report error conditions class (Monad m) => Failable m where -- | 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. failure :: (Exception e) => e -> m a -- | recover from a possible failure. Basically a generalized @catch@ for a @Failable@. recover :: (e ~ SomeException) => m a -> (e -> m a) -> m a -- | A 'Hoistable' is a type that can be "promoted" or "hoisted" to a Failable monad. class (Failable m) => Hoistable m t e' | t -> e' where -- | 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 -- hoist :: (Exception e) => (e' -> e) -> t a -> m a -- | Utility function to capture the idiom `hoist id` .. which is used to promote a type -- to a failable without requiring any error transformation autohoist :: (Exception e, Hoistable m t e) => t a -> m a autohoist = hoist id instance Failable IO where failure = throw recover = catch instance Failable [] where failure _ = [] recover [] f = f $ toException () recover xs _ = xs instance Failable Maybe where failure _ = Nothing recover Nothing f = f $ toException () recover v _ = v instance e ~ SomeException => Failable (Either e) where failure = Left . toException recover (Left err) f = f err recover v _ = v instance (Monad m) => Failable (MaybeT m) where failure _ = MaybeT $ return Nothing recover a f = MaybeT $ runMaybeT a >>= recover' where recover' Nothing = runMaybeT . f $ toException () recover' x = return x instance (Monad m, e ~ SomeException) => Failable (ExceptT e m) where failure = throwError . toException recover a f = ExceptT $ runExceptT a >>= recover' 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 instance (Failable m) => Hoistable m (Either e') e' where hoist f = either (failure . f) return -- | 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) -- failableIO :: (Failable m, MonadIO m) => IO a -> m a failableIO actions = do result <- liftIO $ tryIOError actions either failure return result