{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FlexibleContexts #-} -- | Type classes for returning failures. -- -- Note: This module used to contain a lot more functionality, but I believe it -- was unused functionality. If you want any of it back, just email me. module Control.Failure ( -- * Type class Failure (..) -- * General exceptions , exception {- -- * Wrapping failures , WrapFailure (..) -- * Convenience 'String' failure , StringException (..) , failureString -- * Convert 'Failure's into concrete types , Try (..) , NothingException (..) , NullException (..) -} ) where import Control.Exception (throwIO, Exception (toException), SomeException (..)) import Control.Monad.Trans.Error () import Control.Monad.Trans.Class (MonadTrans (lift)) class Monad f => Failure e f where failure :: e -> f v -- | Convert to a 'SomeException' via 'toException' before calling 'failure'. exception :: (Exception e, Failure SomeException m) => e -> m a exception :: forall e (m :: * -> *) a. (Exception e, Failure SomeException m) => e -> m a exception = SomeException -> m a forall e (f :: * -> *) v. Failure e f => e -> f v failure (SomeException -> m a) -> (e -> SomeException) -> e -> m a forall b c a. (b -> c) -> (a -> b) -> a -> c . e -> SomeException forall e. Exception e => e -> SomeException toException {- class Failure e f => WrapFailure e f where -- | Wrap the failure value, if any, with the given function. This is -- useful in particular when you want all the exceptions returned from a -- certain library to be of a certain type, even if they were generated by -- a different library. wrapFailure :: (forall eIn. Exception eIn => eIn -> e) -> f a -> f a instance Exception e => WrapFailure e IO where wrapFailure f m = m `catch` \e@SomeException{} -> throwIO (f e) class Try f where type Error f -- Turn a concrete failure into an abstract failure try :: Failure (Error f) f' => f a -> f' a -- | Call 'failure' with a 'String'. failureString :: Failure StringException m => String -> m a failureString = failure . StringException newtype StringException = StringException String deriving Typeable instance Show StringException where show (StringException s) = "StringException: " ++ s instance Exception StringException -} -- -------------- -- base instances -- -------------- instance Failure e Maybe where failure :: forall v. e -> Maybe v failure e _ = Maybe v forall a. Maybe a Nothing instance Failure e [] where failure :: forall v. e -> [v] failure e _ = [] instance Failure e (Either e) where failure :: forall v. e -> Either e v failure = e -> Either e v forall e v. e -> Either e v Left instance Exception e => Failure e IO where failure :: forall v. e -> IO v failure = e -> IO v forall e a. Exception e => e -> IO a throwIO -- | Instance for all monad transformers, simply lift the @failure@ into the -- base monad. instance (MonadTrans t, Failure e m, Monad (t m)) => Failure e (t m) where failure :: forall v. e -> t m v failure = m v -> t m v forall (t :: (* -> *) -> * -> *) (m :: * -> *) a. (MonadTrans t, Monad m) => m a -> t m a lift (m v -> t m v) -> (e -> m v) -> e -> t m v forall b c a. (b -> c) -> (a -> b) -> a -> c . e -> m v forall e (f :: * -> *) v. Failure e f => e -> f v failure {- -- not a monad or applicative instance Failure e (Either e) where failure = Left data NothingException = NothingException deriving (Show, Typeable) instance Exception NothingException instance Try Maybe where type Error Maybe = NothingException try Nothing = failure NothingException try (Just x) = return x instance Try (Either e) where type Error (Either e) = e try (Left e) = failure e try (Right x) = return x data NullException = NullException deriving (Show, Typeable) instance Exception NullException instance Try [] where type Error [] = NullException try [] = failure NullException try (x:_) = return x -}