Merge pull request #91 from natefaubion/monad-throw

Add MonadThrow class

Author: garyb

src/Control/Monad/Error/Class.purs

@@ -7,24 +7,34 @@ import Prelude
 import Data.Maybe (Maybe(..))
 import Data.Either (Either(..), either)
 
--- | The `MonadError` type class represents those monads which support errors via
--- | `throwError` and `catchError`.
+-- | The `MonadThrow` type class represents those monads which support errors via
+-- | `throwError`, where `throwError e` halts, yielding the error `e`.
+-- |
+-- | An implementation is provided for `ExceptT`, and for other monad transformers
+-- | defined in this library.
+-- |
+-- | Laws:
+-- |
+-- | - Left zero: `throwError e >>= f = throwError e`
+-- |
+class Monad m <= MonadThrow e m | m -> e where
+  throwError :: forall a. e -> m a
+
+-- | The `MonadError` type class represents those monads which support catching
+-- | errors.
 -- |
--- | - `throwError e` throws the error `e`
 -- | - `catchError x f` calls the error handler `f` if an error is thrown during the
 -- |   evaluation of `x`.
 -- |
--- | An implementation is provided for `ErrorT`, and for other monad transformers
+-- | An implementation is provided for `ExceptT`, and for other monad transformers
 -- | defined in this library.
 -- |
 -- | Laws:
 -- |
--- | - Left zero: `throwError e >>= f = throwError e`
 -- | - Catch: `catchError (throwError e) f = f e`
 -- | - Pure: `catchError (pure a) f = pure a`
 -- |
-class Monad m <= MonadError e m | m -> e where
-  throwError :: forall a. e -> m a
+class MonadThrow e m <= MonadError e m | m -> e where
   catchError :: forall a. m a -> (e -> m a) -> m a
 
 -- | This function allows you to provide a predicate for selecting the
@@ -45,13 +55,17 @@ catchJust p act handler = catchError act handle
       Nothing -> throwError e
       Just b -> handler b
 
-instance monadErrorEither :: MonadError e (Either e) where
+instance monadThrowEither :: MonadThrow e (Either e) where
   throwError = Left
+
+instance monadErrorEither :: MonadError e (Either e) where
   catchError (Left e) h = h e
   catchError (Right x) _ = Right x
 
-instance monadErrorMaybe :: MonadError Unit Maybe where
+instance monadThrowMaybe :: MonadThrow Unit Maybe where
   throwError = const Nothing
+
+instance monadErrorMaybe :: MonadError Unit Maybe where
   catchError Nothing f  = f unit
   catchError (Just a) _ = Just a
 

src/Control/Monad/Except/Trans.purs

@@ -12,7 +12,7 @@ import Control.Alt (class Alt)
 import Control.Alternative (class Alternative)
 import Control.Monad.Cont.Class (class MonadCont, callCC)
 import Control.Monad.Eff.Class (class MonadEff, liftEff)
-import Control.Monad.Error.Class (class MonadError, throwError, catchError)
+import Control.Monad.Error.Class (class MonadThrow, class MonadError, throwError, catchError)
 import Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local)
 import Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))
 import Control.Monad.State.Class (class MonadState, state)
@@ -110,8 +110,10 @@ instance monadContExceptT :: MonadCont m => MonadCont (ExceptT e m) where
   callCC f = ExceptT $ callCC \c ->
     case f (\a -> ExceptT $ c (Right a)) of ExceptT b -> b
 
-instance monadErrorExceptT :: Monad m => MonadError e (ExceptT e m) where
+instance monadThrowExceptT :: Monad m => MonadThrow e (ExceptT e m) where
   throwError = ExceptT <<< pure <<< Left
+
+instance monadErrorExceptT :: Monad m => MonadError e (ExceptT e m) where
   catchError (ExceptT m) k =
     ExceptT (m >>= either (\a -> case k a of ExceptT b -> b) (pure <<< Right))
 

src/Control/Monad/Maybe/Trans.purs

@@ -11,7 +11,7 @@ import Control.Alt (class Alt)
 import Control.Alternative (class Alternative)
 import Control.Monad.Cont.Class (class MonadCont, callCC)
 import Control.Monad.Eff.Class (class MonadEff, liftEff)
-import Control.Monad.Error.Class (class MonadError, catchError, throwError)
+import Control.Monad.Error.Class (class MonadThrow, class MonadError, catchError, throwError)
 import Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local)
 import Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))
 import Control.Monad.State.Class (class MonadState, state)
@@ -94,8 +94,10 @@ instance monadContMaybeT :: MonadCont m => MonadCont (MaybeT m) where
   callCC f =
     MaybeT $ callCC \c -> case f (\a -> MaybeT $ c $ Just a) of MaybeT m -> m
 
-instance monadErrorMaybeT :: MonadError e m => MonadError e (MaybeT m) where
+instance monadThrowMaybeT :: MonadThrow e m => MonadThrow e (MaybeT m) where
   throwError e = lift (throwError e)
+
+instance monadErrorMaybeT :: MonadError e m => MonadError e (MaybeT m) where
   catchError (MaybeT m) h =
     MaybeT $ catchError m (\a -> case h a of MaybeT b -> b)
 

src/Control/Monad/RWS/Trans.purs

@@ -12,7 +12,7 @@ import Control.Alt (class Alt, (<|>))
 import Control.Alternative (class Alternative)
 import Control.Lazy (class Lazy)
 import Control.Monad.Eff.Class (class MonadEff, liftEff)
-import Control.Monad.Error.Class (class MonadError, throwError, catchError)
+import Control.Monad.Error.Class (class MonadThrow, class MonadError, throwError, catchError)
 import Control.Monad.Reader.Class (class MonadAsk, class MonadReader)
 import Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))
 import Control.Monad.State.Class (class MonadState)
@@ -110,8 +110,10 @@ instance monadWriterRWST :: (Monad m, Monoid w) => MonadWriter w (RWST r w s m)
       m' r s >>= \(RWSResult s' (Tuple a f) w) ->
         pure $ RWSResult s' a (f w)
 
-instance monadErrorRWST :: (MonadError e m, Monoid w) => MonadError e (RWST r w s m) where
+instance monadThrowRWST :: (MonadThrow e m, Monoid w) => MonadThrow e (RWST r w s m) where
   throwError e = lift (throwError e)
+
+instance monadErrorRWST :: (MonadError e m, Monoid w) => MonadError e (RWST r w s m) where
   catchError m h = RWST $ \r s ->
     catchError
       (case m of RWST m' -> m' r s)

src/Control/Monad/Reader/Trans.purs

@@ -12,7 +12,7 @@ import Control.Alt (class Alt, (<|>))
 import Control.Alternative (class Alternative)
 import Control.Monad.Cont.Class (class MonadCont, callCC)
 import Control.Monad.Eff.Class (class MonadEff, liftEff)
-import Control.Monad.Error.Class (class MonadError, catchError, throwError)
+import Control.Monad.Error.Class (class MonadThrow, class MonadError, catchError, throwError)
 import Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, asks, local)
 import Control.Monad.Rec.Class (class MonadRec, tailRecM)
 import Control.Monad.State.Class (class MonadState, state)
@@ -84,8 +84,10 @@ instance monadContReaderT :: MonadCont m => MonadCont (ReaderT r m) where
   callCC f = ReaderT \r -> callCC \c ->
     case f (ReaderT <<< const <<< c) of ReaderT f' -> f' r
 
-instance monadErrorReaderT :: MonadError e m => MonadError e (ReaderT r m) where
+instance monadThrowReaderT :: MonadThrow e m => MonadThrow e (ReaderT r m) where
   throwError = lift <<< throwError
+
+instance monadErrorReaderT :: MonadError e m => MonadError e (ReaderT r m) where
   catchError (ReaderT m) h =
     ReaderT \r -> catchError (m r) (\e -> case h e of ReaderT f -> f r)
 

src/Control/Monad/State/Trans.purs

@@ -13,7 +13,7 @@ import Control.Alternative (class Alternative)
 import Control.Lazy (class Lazy)
 import Control.Monad.Cont.Class (class MonadCont, callCC)
 import Control.Monad.Eff.Class (class MonadEff, liftEff)
-import Control.Monad.Error.Class (class MonadError, catchError, throwError)
+import Control.Monad.Error.Class (class MonadThrow, class MonadError, catchError, throwError)
 import Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local)
 import Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))
 import Control.Monad.State.Class (class MonadState, get, gets, modify, put, state)
@@ -108,8 +108,10 @@ instance monadContStateT :: MonadCont m => MonadCont (StateT s m) where
   callCC f = StateT \s -> callCC \c ->
     case f (\a -> StateT \s' -> c (Tuple a s')) of StateT f' -> f' s
 
-instance monadErrorStateT :: MonadError e m => MonadError e (StateT s m) where
+instance monadThrowStateT :: MonadThrow e m => MonadThrow e (StateT s m) where
   throwError e = lift (throwError e)
+
+instance monadErrorStateT :: MonadError e m => MonadError e (StateT s m) where
   catchError (StateT m) h =
     StateT \s -> catchError (m s) (\e -> case h e of StateT f -> f s)
 

src/Control/Monad/Writer/Trans.purs

@@ -12,7 +12,7 @@ import Control.Alt (class Alt, (<|>))
 import Control.Alternative (class Alternative)
 import Control.Monad.Cont.Class (class MonadCont, callCC)
 import Control.Monad.Eff.Class (class MonadEff, liftEff)
-import Control.Monad.Error.Class (class MonadError, catchError, throwError)
+import Control.Monad.Error.Class (class MonadThrow, class MonadError, catchError, throwError)
 import Control.Monad.Reader.Class (class MonadAsk, class MonadReader, ask, local)
 import Control.Monad.Rec.Class (class MonadRec, tailRecM, Step(..))
 import Control.Monad.State.Class (class MonadState, state)
@@ -102,8 +102,10 @@ instance monadContWriterT :: (Monoid w, MonadCont m) => MonadCont (WriterT w m)
   callCC f = WriterT $ callCC \c ->
     case f (\a -> WriterT $ c (Tuple a mempty)) of WriterT b -> b
 
-instance monadErrorWriterT :: (Monoid w, MonadError e m) => MonadError e (WriterT w m) where
+instance monadThrowWriterT :: (Monoid w, MonadThrow e m) => MonadThrow e (WriterT w m) where
   throwError e = lift (throwError e)
+
+instance monadErrorWriterT :: (Monoid w, MonadError e m) => MonadError e (WriterT w m) where
   catchError (WriterT m) h = WriterT $ catchError m (\e -> case h e of WriterT a -> a)
 
 instance monadAskWriterT :: (Monoid w, MonadAsk r m) => MonadAsk r (WriterT w m) where