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 (
26 module Control.Monad.Fix,
27 module Control.Monad.Trans,
33 import Control.Monad.Fix
34 import Control.Monad.Trans
35 import Control.Monad.Reader
36 import Control.Monad.Writer
37 import Control.Monad.State
38 import Control.Monad.RWS
39 import Control.Monad.Cont
43 -- ---------------------------------------------------------------------------
46 -- throws an exception inside the monad and thus interrupts
47 -- normal execution order, until an error handler is reached}
49 -- catches an exception inside the monad (that was previously
50 -- thrown by throwError
59 instance Error [Char] where
63 instance Error IOError where
66 class (Monad m) => MonadError e m | m -> e where
67 throwError :: e -> m a
68 catchError :: m a -> (e -> m a) -> m a
70 instance MonadPlus IO where
71 mzero = ioError (userError "mzero")
72 m `mplus` n = m `catch` \_ -> n
74 instance MonadError IOError IO where
78 -- ---------------------------------------------------------------------------
79 -- Our parameterizable error monad
81 instance Functor (Either e) where
82 fmap _ (Left l) = Left l
83 fmap f (Right r) = Right (f r)
85 instance (Error e) => Monad (Either e) where
89 fail msg = Left (strMsg msg)
91 instance (Error e) => MonadPlus (Either e) where
96 instance (Error e) => MonadFix (Either e) where
100 _ -> error "empty mfix argument"
103 instance (Error e) => MonadError e (Either e) where
105 Left l `catchError` h = h l
106 Right r `catchError` _ = Right r
108 -- ---------------------------------------------------------------------------
109 -- Our parameterizable error monad, with an inner monad
111 newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
113 -- The ErrorT Monad structure is parameterized over two things:
114 -- * e - The error type.
115 -- * m - The inner monad.
117 -- Here are some examples of use:
119 -- type ErrorWithIO e a = ErrorT e IO a
120 -- ==> ErrorT (IO (Either e a))
122 -- type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a
123 -- ==> ErrorT (StateT s IO (Either e a))
124 -- ==> ErrorT (StateT (s -> IO (Either e a,s)))
127 instance (Monad m) => Functor (ErrorT e m) where
128 fmap f m = ErrorT $ do
131 Left l -> return (Left l)
132 Right r -> return (Right (f r))
134 instance (Monad m, Error e) => Monad (ErrorT e m) where
135 return a = ErrorT $ return (Right a)
136 m >>= k = ErrorT $ do
139 Left l -> return (Left l)
140 Right r -> runErrorT (k r)
141 fail msg = ErrorT $ return (Left (strMsg msg))
143 instance (Monad m, Error e) => MonadPlus (ErrorT e m) where
144 mzero = ErrorT $ return (Left noMsg)
145 m `mplus` n = ErrorT $ do
148 Left _ -> runErrorT n
149 Right r -> return (Right r)
151 instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where
152 mfix f = ErrorT $ mfix $ \a -> runErrorT $ f $ case a of
154 _ -> error "empty mfix argument"
156 instance (Monad m, Error e) => MonadError e (ErrorT e m) where
157 throwError l = ErrorT $ return (Left l)
158 m `catchError` h = ErrorT $ do
161 Left l -> runErrorT (h l)
162 Right r -> return (Right r)
164 instance (Error e) => MonadTrans (ErrorT e) where
169 instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
170 liftIO = lift . liftIO
172 instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where
174 local f m = ErrorT $ local f (runErrorT m)
176 instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where
178 listen m = ErrorT $ do
179 (a, w) <- listen (runErrorT m)
182 Right r -> Right (r, w)
183 pass m = ErrorT $ pass $ do
186 Left l -> (Left l, id)
187 Right (r, f) -> (Right r, f)
189 instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where
193 instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where
196 runErrorT (f (\a -> ErrorT $ c (Right a)))
198 mapErrorT :: (m (Either e a) -> n (Either e' b)) -> ErrorT e m a -> ErrorT e' n b
199 mapErrorT f m = ErrorT $ f (runErrorT m)
201 -- ---------------------------------------------------------------------------
202 -- MonadError instances for other monad transformers
204 instance (MonadError e m) => MonadError e (ReaderT r m) where
205 throwError = lift . throwError
206 m `catchError` h = ReaderT $ \r -> runReaderT m r
207 `catchError` \e -> runReaderT (h e) r
209 instance (Monoid w, MonadError e m) => MonadError e (WriterT w m) where
210 throwError = lift . throwError
211 m `catchError` h = WriterT $ runWriterT m
212 `catchError` \e -> runWriterT (h e)
214 instance (MonadError e m) => MonadError e (StateT s m) where
215 throwError = lift . throwError
216 m `catchError` h = StateT $ \s -> runStateT m s
217 `catchError` \e -> runStateT (h e) s
219 instance (Monoid w, MonadError e m) => MonadError e (RWST r w s m) where
220 throwError = lift . throwError
221 m `catchError` h = RWST $ \r s -> runRWST m r s
222 `catchError` \e -> runRWST (h e) r s