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