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/core/LICENSE)
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (reqruires multi-param type classes)
11 -- $Id: Error.hs,v 1.1 2001/06/28 14:15:02 simonmar Exp $
15 -- Rendered by Michael Weber <michael.weber@post.rwth-aachen.de>,
16 -- inspired by the Haskell Monad Template Library from
17 -- \A[HREF="http://www.cse.ogi.edu/~andy"]{Andy Gill}}
19 -----------------------------------------------------------------------------
21 module Control.Monad.Error (
28 module Control.Monad.Fix,
29 module Control.Monad.Trans,
35 import Control.Monad.Fix
36 import Control.Monad.Trans
37 import Control.Monad.Reader
38 import Control.Monad.Writer
39 import Control.Monad.State
40 import Control.Monad.RWS
41 import Control.Monad.Cont
45 -- ---------------------------------------------------------------------------
48 -- throws an exception inside the monad and thus interrupts
49 -- normal execution order, until an error handler is reached}
51 -- catches an exception inside the monad (that was previously
52 -- thrown by throwError
61 instance Error [Char] where
65 instance Error IOError where
68 class (Monad m) => MonadError e m | m -> e where
69 throwError :: e -> m a
70 catchError :: m a -> (e -> m a) -> m a
72 instance MonadPlus IO where
73 mzero = ioError (userError "mzero")
74 m `mplus` n = m `catch` \_ -> n
76 instance MonadError IOError IO where
80 -- ---------------------------------------------------------------------------
81 -- Our parameterizable error monad
83 instance Functor (Either e) where
84 fmap _ (Left l) = Left l
85 fmap f (Right r) = Right (f r)
87 instance (Error e) => Monad (Either e) where
91 fail msg = Left (strMsg msg)
93 instance (Error e) => MonadPlus (Either e) where
98 instance (Error e) => MonadFix (Either e) where
102 _ -> error "empty mfix argument"
105 instance (Error e) => MonadError e (Either e) where
107 Left l `catchError` h = h l
108 Right r `catchError` _ = Right r
110 -- ---------------------------------------------------------------------------
111 -- Our parameterizable error monad, with an inner monad
113 newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
115 -- The ErrorT Monad structure is parameterized over two things:
116 -- * e - The error type.
117 -- * m - The inner monad.
119 -- Here are some examples of use:
121 -- type ErrorWithIO e a = ErrorT e IO a
122 -- ==> ErrorT (IO (Either e a))
124 -- type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a
125 -- ==> ErrorT (StateT s IO (Either e a))
126 -- ==> ErrorT (StateT (s -> IO (Either e a,s)))
129 instance (Monad m) => Functor (ErrorT e m) where
130 fmap f m = ErrorT $ do
133 Left l -> return (Left l)
134 Right r -> return (Right (f r))
136 instance (Monad m, Error e) => Monad (ErrorT e m) where
137 return a = ErrorT $ return (Right a)
138 m >>= k = ErrorT $ do
141 Left l -> return (Left l)
142 Right r -> runErrorT (k r)
143 fail msg = ErrorT $ return (Left (strMsg msg))
145 instance (Monad m, Error e) => MonadPlus (ErrorT e m) where
146 mzero = ErrorT $ return (Left noMsg)
147 m `mplus` n = ErrorT $ do
150 Left _ -> runErrorT n
151 Right r -> return (Right r)
153 instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where
154 mfix f = ErrorT $ mfix $ \a -> runErrorT $ f $ case a of
156 _ -> error "empty mfix argument"
158 instance (Monad m, Error e) => MonadError e (ErrorT e m) where
159 throwError l = ErrorT $ return (Left l)
160 m `catchError` h = ErrorT $ do
163 Left l -> runErrorT (h l)
164 Right r -> return (Right r)
166 instance (Error e) => MonadTrans (ErrorT e) where
171 instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
172 liftIO = lift . liftIO
174 instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where
176 local f m = ErrorT $ local f (runErrorT m)
178 instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where
180 listen m = ErrorT $ do
181 (a, w) <- listen (runErrorT m)
184 Right r -> Right (r, w)
185 pass m = ErrorT $ pass $ do
188 Left l -> (Left l, id)
189 Right (r, f) -> (Right r, f)
191 instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where
195 instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where
198 runErrorT (f (\a -> ErrorT $ c (Right a)))
200 mapErrorT :: (m (Either e a) -> n (Either e' b)) -> ErrorT e m a -> ErrorT e' n b
201 mapErrorT f m = ErrorT $ f (runErrorT m)
203 -- ---------------------------------------------------------------------------
204 -- MonadError instances for other monad transformers
206 instance (MonadError e m) => MonadError e (ReaderT r m) where
207 throwError = lift . throwError
208 m `catchError` h = ReaderT $ \r -> runReaderT m r
209 `catchError` \e -> runReaderT (h e) r
211 instance (Monoid w, MonadError e m) => MonadError e (WriterT w m) where
212 throwError = lift . throwError
213 m `catchError` h = WriterT $ runWriterT m
214 `catchError` \e -> runWriterT (h e)
216 instance (MonadError e m) => MonadError e (StateT s m) where
217 throwError = lift . throwError
218 m `catchError` h = StateT $ \s -> runStateT m s
219 `catchError` \e -> runStateT (h e) s
221 instance (Monoid w, MonadError e m) => MonadError e (RWST r w s m) where
222 throwError = lift . throwError
223 m `catchError` h = RWST $ \r s -> runRWST m r s
224 `catchError` \e -> runRWST (h e) r s