Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add MonadThrow class #91

Merged
merged 2 commits into from Mar 26, 2017
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Jump to
Jump to file
Failed to load files.
Diff view
Diff view
30 changes: 22 additions & 8 deletions src/Control/Monad/Error/Class.purs
Expand Up @@ -7,10 +7,22 @@ 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 `ErrorT`, and for other monad transformers
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This should say ExceptT now.

-- | 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`.
-- |
Expand All @@ -19,12 +31,10 @@ import Data.Either (Either(..), either)
-- |
-- | 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
Expand All @@ -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

Expand Down
6 changes: 4 additions & 2 deletions src/Control/Monad/Except/Trans.purs
Expand Up @@ -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)
Expand Down Expand Up @@ -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))

Expand Down
6 changes: 4 additions & 2 deletions src/Control/Monad/Maybe/Trans.purs
Expand Up @@ -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)
Expand Down Expand Up @@ -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)

Expand Down
6 changes: 4 additions & 2 deletions src/Control/Monad/RWS/Trans.purs
Expand Up @@ -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)
Expand Down Expand Up @@ -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)
Expand Down
6 changes: 4 additions & 2 deletions src/Control/Monad/Reader/Trans.purs
Expand Up @@ -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)
Expand Down Expand Up @@ -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)

Expand Down
6 changes: 4 additions & 2 deletions src/Control/Monad/State/Trans.purs
Expand Up @@ -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)
Expand Down Expand Up @@ -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)

Expand Down
6 changes: 4 additions & 2 deletions src/Control/Monad/Writer/Trans.purs
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand Down