Ticket #1059: Error.hs

File Error.hs, 11.4 KB (added by Andriy, 7 years ago)

Version 2 of Control.Monad.Error source

Line 
1{-# OPTIONS -fallow-undecidable-instances #-}
2-- Needed for the same reasons as in Reader, State etc
3
4{- |
5Module      :  Control.Monad.Error
6Copyright   :  (c) Michael Weber <michael.weber@post.rwth-aachen.de> 2001,
7      (c) Jeff Newbern 2003-2006,
8      (c) Andriy Palamarchuk 2006
9License     :  BSD-style (see the file libraries/base/LICENSE)
10 
11Maintainer  :  libraries@haskell.org
12Stability   :  experimental
13Portability :  non-portable (multi-parameter type classes)
14
15[Computation type:] Computations which may fail or throw exceptions.
16
17[Binding strategy:] Failure records information about the cause\/location
18of the failure. Failure values bypass the bound function,
19other values are used as inputs to the bound function.
20
21[Useful for:] Building computations from sequences of functions that may fail
22or using exception handling to structure error handling.
23
24[Zero and plus:] Zero is represented by an empty error and the plus operation
25executes its second argument if the first fails.
26
27[Example type:] @'Data.Either' String a@
28
29The Error monad (also called the Exception monad).
30-}
31
32{-
33  Rendered by Michael Weber <mailto:michael.weber@post.rwth-aachen.de>,
34  inspired by the Haskell Monad Template Library from
35    Andy Gill (<http://www.cse.ogi.edu/~andy/>)
36-}
37module Control.Monad.Error (
38        Error(..),
39        MonadError(..),
40        ErrorT(..),
41        mapErrorT,
42        module Control.Monad,
43        module Control.Monad.Fix,
44        module Control.Monad.Trans,
45  -- * Example 1: Custom Error Data Type
46  -- $customErrorExample
47
48  -- * Example 2: Using ErrorT Monad Transformer
49  -- $ErrorTExample
50  ) where
51
52import Prelude
53
54import Control.Monad
55import Control.Monad.Fix
56import Control.Monad.Trans
57import Control.Monad.Reader
58import Control.Monad.Writer
59import Control.Monad.State
60import Control.Monad.RWS
61import Control.Monad.Cont
62
63import Control.Monad.Instances ()
64import System.IO
65
66-- | An exception to be thrown.
67-- An instance must redefine at least one of 'noMsg', 'strMsg'.
68class Error a where
69  -- | Creates an exception without a message.
70  -- Default implementation is @'strMsg' \"\"@.
71        noMsg  :: a
72  -- | Creates an exception with a message.
73  -- Default implementation is 'noMsg'.
74        strMsg :: String -> a
75
76noMsg    = strMsg ""
77strMsg _ = noMsg
78
79-- | A string can be thrown as an error.
80instance Error String where
81        noMsg  = ""
82        strMsg = id
83
84instance Error IOError where
85        strMsg = userError
86
87{- |
88The strategy of combining computations that can throw exceptions
89by bypassing bound functions
90from the point an exception is thrown to the point that it is handled.
91
92Is parameterized over the type of error information and
93the monad type constructor.
94It is common to use @'Data.Either' String@ as the monad type constructor
95for an error monad in which error descriptions take the form of strings.
96In that case and many other common cases the resulting monad is already defined
97as an instance of the 'MonadError' class.
98You can also define your own error type and\/or use a monad type constructor
99other than @'Data.Either' String@ or @'Data.Either' IOError@.
100In these cases you will have to explicitly define instances of the 'Error'
101and\/or 'MonadError' classes.
102-}
103class (Monad m) => MonadError e m | m -> e where
104  -- | Is used within a monadic computation to begin exception processing.
105        throwError :: e -> m a
106
107  {- |
108  A handler function to handle previous errors and return to normal execution.
109  A common idiom is:
110
111  > do { action1; action2; action3 } `catchError` handler
112
113  where the @action@ functions can call 'throwError'.
114  Note that @handler@ and the do-block must have the same return type.
115  -}
116  catchError :: m a -> (e -> m a) -> m a
117
118instance MonadPlus IO where
119        mzero       = ioError (userError "mzero")
120        m `mplus` n = m `catch` \_ -> n
121
122instance MonadError IOError IO where
123        throwError = ioError
124        catchError = catch
125
126-- ---------------------------------------------------------------------------
127-- Our parameterizable error monad
128
129instance (Error e) => Monad (Either e) where
130        return        = Right
131        Left  l >>= _ = Left l
132        Right r >>= k = k r
133        fail msg      = Left (strMsg msg)
134
135instance (Error e) => MonadPlus (Either e) where
136        mzero            = Left noMsg
137        Left _ `mplus` n = n
138        m      `mplus` _ = m
139
140instance (Error e) => MonadFix (Either e) where
141        mfix f = let
142                a = f $ case a of
143                        Right r -> r
144                        _       -> error "empty mfix argument"
145                in a
146
147instance (Error e) => MonadError e (Either e) where
148        throwError             = Left
149        Left  l `catchError` h = h l
150        Right r `catchError` _ = Right r
151
152{- |
153The error monad transformer. It can be used to add error handling to other
154monads.
155
156The @ErrorT@ Monad structure is parameterized over two things:
157
158 * e - The error type.
159
160 * m - The inner monad.
161
162Here are some examples of use:
163
164> -- wraps IO action that can throw an error e
165> type ErrorWithIO e a = ErrorT e IO a
166> ==> ErrorT (IO (Either e a))
167>
168> -- IO monad wrapped in StateT inside of ErrorT
169> type ErrorAndStateWithIO e s a = ErrorT e (StateT s IO) a
170> ==> ErrorT (StateT s IO (Either e a))
171> ==> ErrorT (StateT (s -> IO (Either e a,s)))
172-}
173
174newtype ErrorT e m a = ErrorT { runErrorT :: m (Either e a) }
175
176
177instance (Monad m) => Functor (ErrorT e m) where
178        fmap f m = ErrorT $ do
179                a <- runErrorT m
180                case a of
181                        Left  l -> return (Left  l)
182                        Right r -> return (Right (f r))
183
184instance (Monad m, Error e) => Monad (ErrorT e m) where
185        return a = ErrorT $ return (Right a)
186        m >>= k  = ErrorT $ do
187                a <- runErrorT m
188                case a of
189                        Left  l -> return (Left l)
190                        Right r -> runErrorT (k r)
191        fail msg = ErrorT $ return (Left (strMsg msg))
192
193instance (Monad m, Error e) => MonadPlus (ErrorT e m) where
194        mzero       = ErrorT $ return (Left noMsg)
195        m `mplus` n = ErrorT $ do
196                a <- runErrorT m
197                case a of
198                        Left  _ -> runErrorT n
199                        Right r -> return (Right r)
200
201instance (MonadFix m, Error e) => MonadFix (ErrorT e m) where
202        mfix f = ErrorT $ mfix $ \a -> runErrorT $ f $ case a of
203                Right r -> r
204                _       -> error "empty mfix argument"
205
206instance (Monad m, Error e) => MonadError e (ErrorT e m) where
207        throwError l     = ErrorT $ return (Left l)
208        m `catchError` h = ErrorT $ do
209                a <- runErrorT m
210                case a of
211                        Left  l -> runErrorT (h l)
212                        Right r -> return (Right r)
213
214instance (Error e) => MonadTrans (ErrorT e) where
215        lift m = ErrorT $ do
216                a <- m
217                return (Right a)
218
219instance (Error e, MonadIO m) => MonadIO (ErrorT e m) where
220        liftIO = lift . liftIO
221
222instance (Error e, MonadReader r m) => MonadReader r (ErrorT e m) where
223        ask       = lift ask
224        local f m = ErrorT $ local f (runErrorT m)
225
226instance (Error e, MonadWriter w m) => MonadWriter w (ErrorT e m) where
227        tell     = lift . tell
228        listen m = ErrorT $ do
229                (a, w) <- listen (runErrorT m)
230                return $ case a of
231                        Left  l -> Left  l
232                        Right r -> Right (r, w)
233        pass   m = ErrorT $ pass $ do
234                a <- runErrorT m
235                return $ case a of
236                        Left  l      -> (Left  l, id)
237                        Right (r, f) -> (Right r, f)
238
239instance (Error e, MonadState s m) => MonadState s (ErrorT e m) where
240        get = lift get
241        put = lift . put
242
243instance (Error e, MonadCont m) => MonadCont (ErrorT e m) where
244        callCC f = ErrorT $
245                callCC $ \c ->
246                runErrorT (f (\a -> ErrorT $ c (Right a)))
247
248mapErrorT :: (m (Either e a) -> n (Either e' b)) -> ErrorT e m a -> ErrorT e' n b
249mapErrorT f m = ErrorT $ f (runErrorT m)
250
251-- ---------------------------------------------------------------------------
252-- MonadError instances for other monad transformers
253
254instance (MonadError e m) => MonadError e (ReaderT r m) where
255        throwError       = lift . throwError
256        m `catchError` h = ReaderT $ \r -> runReaderT m r
257                `catchError` \e -> runReaderT (h e) r
258
259instance (Monoid w, MonadError e m) => MonadError e (WriterT w m) where
260        throwError       = lift . throwError
261        m `catchError` h = WriterT $ runWriterT m
262                `catchError` \e -> runWriterT (h e)
263
264instance (MonadError e m) => MonadError e (StateT s m) where
265        throwError       = lift . throwError
266        m `catchError` h = StateT $ \s -> runStateT m s
267                `catchError` \e -> runStateT (h e) s
268
269instance (Monoid w, MonadError e m) => MonadError e (RWST r w s m) where
270        throwError       = lift . throwError
271        m `catchError` h = RWST $ \r s -> runRWST m r s
272                `catchError` \e -> runRWST (h e) r s
273
274{- $customErrorExample
275Here is an example that demonstrates the use of a custom 'Error' data type with
276the 'ErrorMonad'\'s 'throwError' and 'catchError' exception mechanism.
277The example throws an exception if the user enters an empty string
278or a string longer than 5 characters. Otherwise it prints length of the string.
279
280>-- This is the type to represent length calculation error.
281>data LengthError = EmptyString  -- Entered string was empty.
282>          | StringTooLong Int   -- A string is longer than 5 characters.
283>                                -- Records a length of the string.
284>          | OtherError String   -- Other error, stores the problem description.
285>
286>-- We make LengthError an instance of the Error class
287>-- to be able to throw it as an exception.
288>instance Error LengthError where
289>  noMsg    = OtherError "A String Error!"
290>  strMsg s = OtherError s
291>
292>-- Converts LengthError to a readable message.
293>instance Show LengthError where
294>  show EmptyString = "The string was empty!"
295>  show (StringTooLong len) =
296>      "The length of the string (" ++ (show len) ++ ") is bigger than 5!"
297>  show (OtherError msg) = msg
298>
299>-- For our monad type constructor, we use Either LengthError
300>-- which represents failure using Left LengthError
301>-- or a successful result of type a using Right a.
302>type LengthMonad = Either LengthError
303>
304>main = do
305>  putStrLn "Please enter a string:"
306>  s <- getLine
307>  reportResult (calculateLength s)
308>
309>-- Wraps length calculation to catch the errors.
310>-- Returns either length of the string or an error.
311>calculateLength :: String -> LengthMonad Int
312>calculateLength s = (calculateLengthOrFail s) `catchError` Left
313>
314>-- Attempts to calculate length and throws an error if the provided string is
315>-- empty or longer than 5 characters.
316>-- The processing is done in Either monad.
317>calculateLengthOrFail :: String -> LengthMonad Int
318>calculateLengthOrFail [] = throwError EmptyString
319>calculateLengthOrFail s | len > 5 = throwError (StringTooLong len)
320>                        | otherwise = return len
321>  where len = length s
322>
323>-- Prints result of the string length calculation.
324>reportResult :: LengthMonad Int -> IO ()
325>reportResult (Right len) = putStrLn ("The length of the string is " ++ (show len))
326>reportResult (Left e) = putStrLn ("Length calculation failed with error: " ++ (show e))
327-}
328
329{- $ErrorTExample
330@'ErrorT'@ monad transformer can be used to add error handling to another monad.
331Here is an example how to combine it with an @IO@ monad:
332
333>import Control.Monad.Error
334>
335>-- An IO monad which can return String failure.
336>-- It is convenient to define the monad type of the combined monad,
337>-- especially if we combine more monad transformers.
338>type LengthMonad = ErrorT String IO
339>
340>main = do
341>  -- runErrorT removes the ErrorT wrapper
342>  r <- runErrorT calculateLength
343>  reportResult r
344>
345>-- Asks user for a non-empty string and returns its length.
346>-- Throws an error if user enters an empty string.
347>calculateLength :: LengthMonad Int
348>calculateLength = do
349>  -- all the IO operations have to be lifted to the IO monad in the monad stack
350>  liftIO $ putStrLn "Please enter a non-empty string: "
351>  s <- liftIO getLine
352>  if null s
353>    then throwError "The string was empty!"
354>    else return $ length s
355>
356>-- Prints result of the string length calculation.
357>reportResult :: Either String Int -> IO ()
358>reportResult (Right len) = putStrLn ("The length of the string is " ++ (show len))
359>reportResult (Left e) = putStrLn ("Length calculation failed with error: " ++ (show e))
360-}