b4d88809947cca9fdd259f87fa2871b8e0606b1a
[ghc.git] / libraries / base / GHC / IO / Exception.hs
1 {-# LANGUAGE Trustworthy #-}
2 {-# LANGUAGE NoImplicitPrelude, DeriveDataTypeable, MagicHash,
3 ExistentialQuantification #-}
4 {-# OPTIONS_GHC -funbox-strict-fields #-}
5 {-# OPTIONS_HADDOCK hide #-}
6
7 -----------------------------------------------------------------------------
8 -- |
9 -- Module : GHC.IO.Exception
10 -- Copyright : (c) The University of Glasgow, 2009
11 -- License : see libraries/base/LICENSE
12 --
13 -- Maintainer : libraries@haskell.org
14 -- Stability : internal
15 -- Portability : non-portable
16 --
17 -- IO-related Exception types and functions
18 --
19 -----------------------------------------------------------------------------
20
21 module GHC.IO.Exception (
22 BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
23 BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
24 Deadlock(..),
25 AssertionFailed(..),
26
27 SomeAsyncException(..),
28 asyncExceptionToException, asyncExceptionFromException,
29 AsyncException(..), stackOverflow, heapOverflow,
30
31 ArrayException(..),
32 ExitCode(..),
33
34 ioException,
35 ioError,
36 IOError,
37 IOException(..),
38 IOErrorType(..),
39 userError,
40 assertError,
41 unsupportedOperation,
42 untangle,
43 ) where
44
45 import GHC.Base
46 import GHC.List
47 import GHC.IO
48 import GHC.Show
49 import GHC.Read
50 import GHC.Exception
51 import Data.Maybe
52 import GHC.IO.Handle.Types
53 import Foreign.C.Types
54
55 import Data.Typeable ( Typeable, cast )
56
57 -- ------------------------------------------------------------------------
58 -- Exception datatypes and operations
59
60 -- |The thread is blocked on an @MVar@, but there are no other references
61 -- to the @MVar@ so it can't ever continue.
62 data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
63 deriving Typeable
64
65 instance Exception BlockedIndefinitelyOnMVar
66
67 instance Show BlockedIndefinitelyOnMVar where
68 showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"
69
70 blockedIndefinitelyOnMVar :: SomeException -- for the RTS
71 blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
72
73 -----
74
75 -- |The thread is waiting to retry an STM transaction, but there are no
76 -- other references to any @TVar@s involved, so it can't ever continue.
77 data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
78 deriving Typeable
79
80 instance Exception BlockedIndefinitelyOnSTM
81
82 instance Show BlockedIndefinitelyOnSTM where
83 showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"
84
85 blockedIndefinitelyOnSTM :: SomeException -- for the RTS
86 blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
87
88 -----
89
90 -- |There are no runnable threads, so the program is deadlocked.
91 -- The @Deadlock@ exception is raised in the main thread only.
92 data Deadlock = Deadlock
93 deriving Typeable
94
95 instance Exception Deadlock
96
97 instance Show Deadlock where
98 showsPrec _ Deadlock = showString "<<deadlock>>"
99
100 -----
101
102 -- |'assert' was applied to 'False'.
103 data AssertionFailed = AssertionFailed String
104 deriving Typeable
105
106 instance Exception AssertionFailed
107
108 instance Show AssertionFailed where
109 showsPrec _ (AssertionFailed err) = showString err
110
111 -----
112
113 data SomeAsyncException = forall e . Exception e => SomeAsyncException e
114 deriving Typeable
115
116 instance Show SomeAsyncException where
117 show (SomeAsyncException e) = show e
118
119 instance Exception SomeAsyncException
120
121 asyncExceptionToException :: Exception e => e -> SomeException
122 asyncExceptionToException = toException . SomeAsyncException
123
124 asyncExceptionFromException :: Exception e => SomeException -> Maybe e
125 asyncExceptionFromException x = do
126 SomeAsyncException a <- fromException x
127 cast a
128
129
130 -- |Asynchronous exceptions.
131 data AsyncException
132 = StackOverflow
133 -- ^The current thread\'s stack exceeded its limit.
134 -- Since an exception has been raised, the thread\'s stack
135 -- will certainly be below its limit again, but the
136 -- programmer should take remedial action
137 -- immediately.
138 | HeapOverflow
139 -- ^The program\'s heap is reaching its limit, and
140 -- the program should take action to reduce the amount of
141 -- live data it has. Notes:
142 --
143 -- * It is undefined which thread receives this exception.
144 --
145 -- * GHC currently does not throw 'HeapOverflow' exceptions.
146 | ThreadKilled
147 -- ^This exception is raised by another thread
148 -- calling 'Control.Concurrent.killThread', or by the system
149 -- if it needs to terminate the thread for some
150 -- reason.
151 | UserInterrupt
152 -- ^This exception is raised by default in the main thread of
153 -- the program when the user requests to terminate the program
154 -- via the usual mechanism(s) (e.g. Control-C in the console).
155 deriving (Eq, Ord, Typeable)
156
157 instance Exception AsyncException where
158 toException = asyncExceptionToException
159 fromException = asyncExceptionFromException
160
161 -- | Exceptions generated by array operations
162 data ArrayException
163 = IndexOutOfBounds String
164 -- ^An attempt was made to index an array outside
165 -- its declared bounds.
166 | UndefinedElement String
167 -- ^An attempt was made to evaluate an element of an
168 -- array that had not been initialized.
169 deriving (Eq, Ord, Typeable)
170
171 instance Exception ArrayException
172
173 stackOverflow, heapOverflow :: SomeException -- for the RTS
174 stackOverflow = toException StackOverflow
175 heapOverflow = toException HeapOverflow
176
177 instance Show AsyncException where
178 showsPrec _ StackOverflow = showString "stack overflow"
179 showsPrec _ HeapOverflow = showString "heap overflow"
180 showsPrec _ ThreadKilled = showString "thread killed"
181 showsPrec _ UserInterrupt = showString "user interrupt"
182
183 instance Show ArrayException where
184 showsPrec _ (IndexOutOfBounds s)
185 = showString "array index out of range"
186 . (if not (null s) then showString ": " . showString s
187 else id)
188 showsPrec _ (UndefinedElement s)
189 = showString "undefined array element"
190 . (if not (null s) then showString ": " . showString s
191 else id)
192
193 -- -----------------------------------------------------------------------------
194 -- The ExitCode type
195
196 -- We need it here because it is used in ExitException in the
197 -- Exception datatype (above).
198
199 -- | Defines the exit codes that a program can return.
200 data ExitCode
201 = ExitSuccess -- ^ indicates successful termination;
202 | ExitFailure Int
203 -- ^ indicates program failure with an exit code.
204 -- The exact interpretation of the code is
205 -- operating-system dependent. In particular, some values
206 -- may be prohibited (e.g. 0 on a POSIX-compliant system).
207 deriving (Eq, Ord, Read, Show, Typeable)
208
209 instance Exception ExitCode
210
211 ioException :: IOException -> IO a
212 ioException err = throwIO err
213
214 -- | Raise an 'IOError' in the 'IO' monad.
215 ioError :: IOError -> IO a
216 ioError = ioException
217
218 -- ---------------------------------------------------------------------------
219 -- IOError type
220
221 -- | The Haskell 2010 type for exceptions in the 'IO' monad.
222 -- Any I\/O operation may raise an 'IOError' instead of returning a result.
223 -- For a more general type of exception, including also those that arise
224 -- in pure code, see "Control.Exception.Exception".
225 --
226 -- In Haskell 2010, this is an opaque type.
227 type IOError = IOException
228
229 -- |Exceptions that occur in the @IO@ monad.
230 -- An @IOException@ records a more specific error type, a descriptive
231 -- string and maybe the handle that was used when the error was
232 -- flagged.
233 data IOException
234 = IOError {
235 ioe_handle :: Maybe Handle, -- the handle used by the action flagging
236 -- the error.
237 ioe_type :: IOErrorType, -- what it was.
238 ioe_location :: String, -- location.
239 ioe_description :: String, -- error type specific information.
240 ioe_errno :: Maybe CInt, -- errno leading to this error, if any.
241 ioe_filename :: Maybe FilePath -- filename the error is related to.
242 }
243 deriving Typeable
244
245 instance Exception IOException
246
247 instance Eq IOException where
248 (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) =
249 e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2
250
251 -- | An abstract type that contains a value for each variant of 'IOError'.
252 data IOErrorType
253 -- Haskell 2010:
254 = AlreadyExists
255 | NoSuchThing
256 | ResourceBusy
257 | ResourceExhausted
258 | EOF
259 | IllegalOperation
260 | PermissionDenied
261 | UserError
262 -- GHC only:
263 | UnsatisfiedConstraints
264 | SystemError
265 | ProtocolError
266 | OtherError
267 | InvalidArgument
268 | InappropriateType
269 | HardwareFault
270 | UnsupportedOperation
271 | TimeExpired
272 | ResourceVanished
273 | Interrupted
274
275 instance Eq IOErrorType where
276 x == y = getTag x ==# getTag y
277
278 instance Show IOErrorType where
279 showsPrec _ e =
280 showString $
281 case e of
282 AlreadyExists -> "already exists"
283 NoSuchThing -> "does not exist"
284 ResourceBusy -> "resource busy"
285 ResourceExhausted -> "resource exhausted"
286 EOF -> "end of file"
287 IllegalOperation -> "illegal operation"
288 PermissionDenied -> "permission denied"
289 UserError -> "user error"
290 HardwareFault -> "hardware fault"
291 InappropriateType -> "inappropriate type"
292 Interrupted -> "interrupted"
293 InvalidArgument -> "invalid argument"
294 OtherError -> "failed"
295 ProtocolError -> "protocol error"
296 ResourceVanished -> "resource vanished"
297 SystemError -> "system error"
298 TimeExpired -> "timeout"
299 UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
300 UnsupportedOperation -> "unsupported operation"
301
302 -- | Construct an 'IOError' value with a string describing the error.
303 -- The 'fail' method of the 'IO' instance of the 'Monad' class raises a
304 -- 'userError', thus:
305 --
306 -- > instance Monad IO where
307 -- > ...
308 -- > fail s = ioError (userError s)
309 --
310 userError :: String -> IOError
311 userError str = IOError Nothing UserError "" str Nothing Nothing
312
313 -- ---------------------------------------------------------------------------
314 -- Showing IOErrors
315
316 instance Show IOException where
317 showsPrec p (IOError hdl iot loc s _ fn) =
318 (case fn of
319 Nothing -> case hdl of
320 Nothing -> id
321 Just h -> showsPrec p h . showString ": "
322 Just name -> showString name . showString ": ") .
323 (case loc of
324 "" -> id
325 _ -> showString loc . showString ": ") .
326 showsPrec p iot .
327 (case s of
328 "" -> id
329 _ -> showString " (" . showString s . showString ")")
330
331 -- Note the use of "lazy". This means that
332 -- assert False (throw e)
333 -- will throw the assertion failure rather than e. See trac #5561.
334 assertError :: Addr# -> Bool -> a -> a
335 assertError str predicate v
336 | predicate = lazy v
337 | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
338
339 unsupportedOperation :: IOError
340 unsupportedOperation =
341 (IOError Nothing UnsupportedOperation ""
342 "Operation is not supported" Nothing Nothing)
343
344 {-
345 (untangle coded message) expects "coded" to be of the form
346 "location|details"
347 It prints
348 location message details
349 -}
350 untangle :: Addr# -> String -> String
351 untangle coded message
352 = location
353 ++ ": "
354 ++ message
355 ++ details
356 ++ "\n"
357 where
358 coded_str = unpackCStringUtf8# coded
359
360 (location, details)
361 = case (span not_bar coded_str) of { (loc, rest) ->
362 case rest of
363 ('|':det) -> (loc, ' ' : det)
364 _ -> (loc, "")
365 }
366 not_bar c = c /= '|'
367