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