1 -----------------------------------------------------------------------------
3 -- Module : Control.Monad.Error
4 -- Copyright : (c) Michael Weber <michael.weber@post.rwth-aachen.de>, 2001
5 -- License : BSD-style (see the file libraries/base/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (reqruires multi-param type classes)
13 -- Rendered by Michael Weber <mailto:michael.weber@post.rwth-aachen.de>,
14 -- inspired by the Haskell Monad Template Library from
15 -- Andy Gill (<http://www.cse.ogi.edu/~andy>)
17 -----------------------------------------------------------------------------
19 module Control.Monad.Error (
25 module Control.Monad.Fix,
26 module Control.Monad.Trans,
32 import Control.Monad.Fix
33 import Control.Monad.Trans
34 import Control.Monad.Reader
35 import Control.Monad.Writer
36 import Control.Monad.State
37 import Control.Monad.RWS
38 import Control.Monad.Cont
42 -- ---------------------------------------------------------------------------
45 -- throws an exception inside the monad and thus interrupts
46 -- normal execution order, until an error handler is reached}
48 -- catches an exception inside the monad (that was previously
49 -- thrown by throwError
58 instance Error [Char] where
62 instance Error IOError where
65 class (Monad m) => MonadError e m | m -> e where
66 throwError :: e -> m a
67 catchError :: m a -> (e -> m a) -> m a
69 instance MonadPlus IO where
70 mzero = ioError (userError "mzero")
71 m `mplus` n = m `catch` \_ -> n
73 instance MonadError IOError IO where
77 -- ---------------------------------------------------------------------------
78 -- Our parameterizable error monad
80 instance Functor (Either e) where
81 fmap _ (Left l) = Left l
82 fmap f (Right r) = Right (f r)
84 instance (Error e) => Monad (Either e) where
88 fail msg = Left (strMsg msg)
90 instance (Error e) => MonadPlus (Either e) where
95 instance (Error e) => MonadFix (Either e) where
99 _ -> error "empty mfix argument"
102 instance (Error e) => MonadError e (Either e) where
104 Left l `catchError` h = h l
105 Right r `catchError` _ = Right r
107 -- ---------------------------------------------------------------------------
108 -- Our parameterizable error monad, with an inner monad
110 newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
112 -- The ErrorT Monad structure is parameterized over two things:
113 -- * e - The error type.
114 -- * m - The inner monad.
116 -- Here are some examples of use:
118 -- type ErrorWithIO e a = ErrorT e IO a
119 -- ==> ErrorT (IO (Either e a))
121 -- type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a
122 -- ==> ErrorT (StateT s IO (Either e a))
123 -- ==> ErrorT (StateT (s -> IO (Either e a,s)))
126 instance (Monad m) => Functor (ErrorT e m) where
127 fmap f m = ErrorT $ do
130 Left l -> return (Left l)
131 Right r -> return (Right (f r))
133 instance (Monad m, Error e) => Monad (ErrorT e m) where
134 return a = ErrorT $ return (Right a)
135 m >>= k = ErrorT $ do
138 Left l -> return (Left l)
139 Right r -> runErrorT (k r)
140 fail msg = ErrorT $ return (Left (strMsg msg))
142 instance (Monad m, Error e) => MonadPlus (ErrorT e m) where
143 mzero = ErrorT $ return (Left noMsg)
144 m `mplus` n = ErrorT $ do
147 Left _ -> runErrorT n
148 Right r -> return (Right r)
150 instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where
151 mfix f = ErrorT $ mfix $ \a -> runErrorT $ f $ case a of
153 _ -> error "empty mfix argument"
155 instance (Monad m, Error e) => MonadError e (ErrorT e m) where
156 throwError l = ErrorT $ return (Left l)
157 m `catchError` h = ErrorT $ do
160 Left l -> runErrorT (h l)
161 Right r -> return (Right r)
163 instance (Error e) => MonadTrans (ErrorT e) where
168 instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
169 liftIO = lift . liftIO
171 instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where
173 local f m = ErrorT $ local f (runErrorT m)
175 instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where
177 listen m = ErrorT $ do
178 (a, w) <- listen (runErrorT m)
181 Right r -> Right (r, w)
182 pass m = ErrorT $ pass $ do
185 Left l -> (Left l, id)
186 Right (r, f) -> (Right r, f)
188 instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where
192 instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where
195 runErrorT (f (\a -> ErrorT $ c (Right a)))
197 mapErrorT :: (m (Either e a) -> n (Either e' b)) -> ErrorT e m a -> ErrorT e' n b
198 mapErrorT f m = ErrorT $ f (runErrorT m)
200 -- ---------------------------------------------------------------------------
201 -- MonadError instances for other monad transformers
203 instance (MonadError e m) => MonadError e (ReaderT r m) where
204 throwError = lift . throwError
205 m `catchError` h = ReaderT $ \r -> runReaderT m r
206 `catchError` \e -> runReaderT (h e) r
208 instance (Monoid w, MonadError e m) => MonadError e (WriterT w m) where
209 throwError = lift . throwError
210 m `catchError` h = WriterT $ runWriterT m
211 `catchError` \e -> runWriterT (h e)
213 instance (MonadError e m) => MonadError e (StateT s m) where
214 throwError = lift . throwError
215 m `catchError` h = StateT $ \s -> runStateT m s
216 `catchError` \e -> runStateT (h e) s
218 instance (Monoid w, MonadError e m) => MonadError e (RWST r w s m) where
219 throwError = lift . throwError
220 m `catchError` h = RWST $ \r s -> runRWST m r s
221 `catchError` \e -> runRWST (h e) r s