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