6df213ea61f7e10d8b019859efff3ec9275c662d
[packages/base.git] / Control / Monad / Error.hs
1 -----------------------------------------------------------------------------
2 -- |
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)
6 --
7 -- Maintainer : libraries@haskell.org
8 -- Stability : experimental
9 -- Portability : non-portable (reqruires multi-param type classes)
10 --
11 -- The Error monad.
12 --
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>)
16 --
17 -----------------------------------------------------------------------------
18
19 module Control.Monad.Error (
20 Error(..),
21 MonadError(..),
22 ErrorT(..),
23 runErrorT,
24 mapErrorT,
25 module Control.Monad,
26 module Control.Monad.Fix,
27 module Control.Monad.Trans,
28 ) where
29
30 import Prelude
31
32 import Control.Monad
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
40
41 import System.IO
42
43 -- ---------------------------------------------------------------------------
44 -- class MonadError
45 --
46 -- throws an exception inside the monad and thus interrupts
47 -- normal execution order, until an error handler is reached}
48 --
49 -- catches an exception inside the monad (that was previously
50 -- thrown by throwError
51
52 class Error a where
53 noMsg :: a
54 strMsg :: String -> a
55
56 noMsg = strMsg ""
57 strMsg _ = noMsg
58
59 instance Error [Char] where
60 noMsg = ""
61 strMsg = id
62
63 instance Error IOError where
64 strMsg = userError
65
66 class (Monad m) => MonadError e m | m -> e where
67 throwError :: e -> m a
68 catchError :: m a -> (e -> m a) -> m a
69
70 instance MonadPlus IO where
71 mzero = ioError (userError "mzero")
72 m `mplus` n = m `catch` \_ -> n
73
74 instance MonadError IOError IO where
75 throwError = ioError
76 catchError = catch
77
78 -- ---------------------------------------------------------------------------
79 -- Our parameterizable error monad
80
81 instance Functor (Either e) where
82 fmap _ (Left l) = Left l
83 fmap f (Right r) = Right (f r)
84
85 instance (Error e) => Monad (Either e) where
86 return = Right
87 Left l >>= _ = Left l
88 Right r >>= k = k r
89 fail msg = Left (strMsg msg)
90
91 instance (Error e) => MonadPlus (Either e) where
92 mzero = Left noMsg
93 Left _ `mplus` n = n
94 m `mplus` _ = m
95
96 instance (Error e) => MonadFix (Either e) where
97 mfix f = let
98 a = f $ case a of
99 Right r -> r
100 _ -> error "empty mfix argument"
101 in a
102
103 instance (Error e) => MonadError e (Either e) where
104 throwError = Left
105 Left l `catchError` h = h l
106 Right r `catchError` _ = Right r
107
108 -- ---------------------------------------------------------------------------
109 -- Our parameterizable error monad, with an inner monad
110
111 newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
112
113 -- The ErrorT Monad structure is parameterized over two things:
114 -- * e - The error type.
115 -- * m - The inner monad.
116
117 -- Here are some examples of use:
118 --
119 -- type ErrorWithIO e a = ErrorT e IO a
120 -- ==> ErrorT (IO (Either e a))
121 --
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)))
125 --
126
127 instance (Monad m) => Functor (ErrorT e m) where
128 fmap f m = ErrorT $ do
129 a <- runErrorT m
130 case a of
131 Left l -> return (Left l)
132 Right r -> return (Right (f r))
133
134 instance (Monad m, Error e) => Monad (ErrorT e m) where
135 return a = ErrorT $ return (Right a)
136 m >>= k = ErrorT $ do
137 a <- runErrorT m
138 case a of
139 Left l -> return (Left l)
140 Right r -> runErrorT (k r)
141 fail msg = ErrorT $ return (Left (strMsg msg))
142
143 instance (Monad m, Error e) => MonadPlus (ErrorT e m) where
144 mzero = ErrorT $ return (Left noMsg)
145 m `mplus` n = ErrorT $ do
146 a <- runErrorT m
147 case a of
148 Left _ -> runErrorT n
149 Right r -> return (Right r)
150
151 instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where
152 mfix f = ErrorT $ mfix $ \a -> runErrorT $ f $ case a of
153 Right r -> r
154 _ -> error "empty mfix argument"
155
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
159 a <- runErrorT m
160 case a of
161 Left l -> runErrorT (h l)
162 Right r -> return (Right r)
163
164 instance (Error e) => MonadTrans (ErrorT e) where
165 lift m = ErrorT $ do
166 a <- m
167 return (Right a)
168
169 instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
170 liftIO = lift . liftIO
171
172 instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where
173 ask = lift ask
174 local f m = ErrorT $ local f (runErrorT m)
175
176 instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where
177 tell = lift . tell
178 listen m = ErrorT $ do
179 (a, w) <- listen (runErrorT m)
180 return $ case a of
181 Left l -> Left l
182 Right r -> Right (r, w)
183 pass m = ErrorT $ pass $ do
184 a <- runErrorT m
185 return $ case a of
186 Left l -> (Left l, id)
187 Right (r, f) -> (Right r, f)
188
189 instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where
190 get = lift get
191 put = lift . put
192
193 instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where
194 callCC f = ErrorT $
195 callCC $ \c ->
196 runErrorT (f (\a -> ErrorT $ c (Right a)))
197
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)
200
201 -- ---------------------------------------------------------------------------
202 -- MonadError instances for other monad transformers
203
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
208
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)
213
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
218
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