1{-# LANGUAGE Trustworthy #-}
2{-# LANGUAGE DeriveGeneric, NoImplicitPrelude, MagicHash,
3             ExistentialQuantification, ImplicitParams #-}
4{-# OPTIONS_GHC -funbox-strict-fields #-}
5{-# OPTIONS_HADDOCK not-home #-}
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
21module GHC.IO.Exception (
22  BlockedIndefinitelyOnMVar(..), blockedIndefinitelyOnMVar,
23  BlockedIndefinitelyOnSTM(..), blockedIndefinitelyOnSTM,
24  Deadlock(..),
25  AllocationLimitExceeded(..), allocationLimitExceeded,
26  AssertionFailed(..),
27  CompactionFailed(..),
28  cannotCompactFunction, cannotCompactPinned, cannotCompactMutable,
29
30  SomeAsyncException(..),
31  asyncExceptionToException, asyncExceptionFromException,
32  AsyncException(..), stackOverflow, heapOverflow,
33
34  ArrayException(..),
35  ExitCode(..),
36  FixIOException (..),
37
38  ioException,
39  ioError,
40  IOError,
41  IOException(..),
42  IOErrorType(..),
43  userError,
44  assertError,
45  unsupportedOperation,
46  untangle,
47 ) where
48
49import GHC.Base
50import GHC.Generics
51import GHC.List
52import GHC.IO
53import GHC.Show
54import GHC.Read
55import GHC.Exception
56import GHC.IO.Handle.Types
57import GHC.OldList ( intercalate )
58import {-# SOURCE #-} GHC.Stack.CCS
59import Foreign.C.Types
60
61import Data.Typeable ( cast )
62
63-- ------------------------------------------------------------------------
64-- Exception datatypes and operations
65
66-- |The thread is blocked on an @MVar@, but there are no other references
67-- to the @MVar@ so it can't ever continue.
68data BlockedIndefinitelyOnMVar = BlockedIndefinitelyOnMVar
69
70-- | @since 4.1.0.0
71instance Exception BlockedIndefinitelyOnMVar
72
73-- | @since 4.1.0.0
74instance Show BlockedIndefinitelyOnMVar where
75    showsPrec _ BlockedIndefinitelyOnMVar = showString "thread blocked indefinitely in an MVar operation"
76
77blockedIndefinitelyOnMVar :: SomeException -- for the RTS
78blockedIndefinitelyOnMVar = toException BlockedIndefinitelyOnMVar
79
80-----
81
82-- |The thread is waiting to retry an STM transaction, but there are no
83-- other references to any @TVar@s involved, so it can't ever continue.
84data BlockedIndefinitelyOnSTM = BlockedIndefinitelyOnSTM
85
86-- | @since 4.1.0.0
87instance Exception BlockedIndefinitelyOnSTM
88
89-- | @since 4.1.0.0
90instance Show BlockedIndefinitelyOnSTM where
91    showsPrec _ BlockedIndefinitelyOnSTM = showString "thread blocked indefinitely in an STM transaction"
92
93blockedIndefinitelyOnSTM :: SomeException -- for the RTS
94blockedIndefinitelyOnSTM = toException BlockedIndefinitelyOnSTM
95
96-----
97
98-- |There are no runnable threads, so the program is deadlocked.
99-- The @Deadlock@ exception is raised in the main thread only.
100data Deadlock = Deadlock
101
102-- | @since 4.1.0.0
103instance Exception Deadlock
104
105-- | @since 4.1.0.0
106instance Show Deadlock where
107    showsPrec _ Deadlock = showString "<<deadlock>>"
108
109-----
110
111-- |This thread has exceeded its allocation limit.  See
112-- 'System.Mem.setAllocationCounter' and
113-- 'System.Mem.enableAllocationLimit'.
114--
115-- @since 4.8.0.0
116data AllocationLimitExceeded = AllocationLimitExceeded
117
118-- | @since 4.8.0.0
119instance Exception AllocationLimitExceeded where
120  toException = asyncExceptionToException
121  fromException = asyncExceptionFromException
122
123-- | @since 4.7.1.0
124instance Show AllocationLimitExceeded where
125    showsPrec _ AllocationLimitExceeded =
126      showString "allocation limit exceeded"
127
128allocationLimitExceeded :: SomeException -- for the RTS
129allocationLimitExceeded = toException AllocationLimitExceeded
130
131-----
132
133-- | Compaction found an object that cannot be compacted.  Functions
134-- cannot be compacted, nor can mutable objects or pinned objects.
135-- See 'GHC.Compact.compact'.
136--
137-- @since 4.10.0.0
138newtype CompactionFailed = CompactionFailed String
139
140-- | @since 4.10.0.0
141instance Exception CompactionFailed where
142
143-- | @since 4.10.0.0
144instance Show CompactionFailed where
145    showsPrec _ (CompactionFailed why) =
146      showString ("compaction failed: " ++ why)
147
148cannotCompactFunction :: SomeException -- for the RTS
149cannotCompactFunction =
150  toException (CompactionFailed "cannot compact functions")
151
152cannotCompactPinned :: SomeException -- for the RTS
153cannotCompactPinned =
154  toException (CompactionFailed "cannot compact pinned objects")
155
156cannotCompactMutable :: SomeException -- for the RTS
157cannotCompactMutable =
158  toException (CompactionFailed "cannot compact mutable objects")
159
160-----
161
162-- |'assert' was applied to 'False'.
163newtype AssertionFailed = AssertionFailed String
164
165-- | @since 4.1.0.0
166instance Exception AssertionFailed
167
168-- | @since 4.1.0.0
169instance Show AssertionFailed where
170    showsPrec _ (AssertionFailed err) = showString err
171
172-----
173
174-- |Superclass for asynchronous exceptions.
175--
176-- @since 4.7.0.0
177data SomeAsyncException = forall e . Exception e => SomeAsyncException e
178
179-- | @since 4.7.0.0
180instance Show SomeAsyncException where
181    showsPrec p (SomeAsyncException e) = showsPrec p e
182
183-- | @since 4.7.0.0
184instance Exception SomeAsyncException
185
186-- |@since 4.7.0.0
187asyncExceptionToException :: Exception e => e -> SomeException
188asyncExceptionToException = toException . SomeAsyncException
189
190-- |@since 4.7.0.0
191asyncExceptionFromException :: Exception e => SomeException -> Maybe e
192asyncExceptionFromException x = do
193    SomeAsyncException a <- fromException x
194    cast a
195
196
197-- |Asynchronous exceptions.
198data AsyncException
199  = StackOverflow
200        -- ^The current thread\'s stack exceeded its limit.
201        -- Since an exception has been raised, the thread\'s stack
202        -- will certainly be below its limit again, but the
203        -- programmer should take remedial action
204        -- immediately.
205  | HeapOverflow
206        -- ^The program\'s heap is reaching its limit, and
207        -- the program should take action to reduce the amount of
208        -- live data it has. Notes:
209        --
210        --   * It is undefined which thread receives this exception.
211        --     GHC currently throws this to the same thread that
212        --     receives 'UserInterrupt', but this may change in the
213        --     future.
214        --
215        --   * The GHC RTS currently can only recover from heap overflow
216        --     if it detects that an explicit memory limit (set via RTS flags).
217        --     has been exceeded.  Currently, failure to allocate memory from
218        --     the operating system results in immediate termination of the
219        --     program.
220  | ThreadKilled
221        -- ^This exception is raised by another thread
222        -- calling 'Control.Concurrent.killThread', or by the system
223        -- if it needs to terminate the thread for some
224        -- reason.
225  | UserInterrupt
226        -- ^This exception is raised by default in the main thread of
227        -- the program when the user requests to terminate the program
228        -- via the usual mechanism(s) (e.g. Control-C in the console).
229  deriving ( Eq  -- ^ @since 4.2.0.0
230           , Ord -- ^ @since 4.2.0.0
231           )
232
233-- | @since 4.7.0.0
234instance Exception AsyncException where
235  toException = asyncExceptionToException
236  fromException = asyncExceptionFromException
237
238-- | Exceptions generated by array operations
239data ArrayException
240  = IndexOutOfBounds    String
241        -- ^An attempt was made to index an array outside
242        -- its declared bounds.
243  | UndefinedElement    String
244        -- ^An attempt was made to evaluate an element of an
245        -- array that had not been initialized.
246  deriving ( Eq  -- ^ @since 4.2.0.0
247           , Ord -- ^ @since 4.2.0.0
248           )
249
250-- | @since 4.1.0.0
251instance Exception ArrayException
252
253-- for the RTS
254stackOverflow, heapOverflow :: SomeException
255stackOverflow = toException StackOverflow
256heapOverflow  = toException HeapOverflow
257
258-- | @since 4.1.0.0
259instance Show AsyncException where
260  showsPrec _ StackOverflow   = showString "stack overflow"
261  showsPrec _ HeapOverflow    = showString "heap overflow"
262  showsPrec _ ThreadKilled    = showString "thread killed"
263  showsPrec _ UserInterrupt   = showString "user interrupt"
264
265-- | @since 4.1.0.0
266instance Show ArrayException where
267  showsPrec _ (IndexOutOfBounds s)
268        = showString "array index out of range"
269        . (if not (null s) then showString ": " . showString s
270                           else id)
271  showsPrec _ (UndefinedElement s)
272        = showString "undefined array element"
273        . (if not (null s) then showString ": " . showString s
274                           else id)
275
276-- | The exception thrown when an infinite cycle is detected in
277-- 'System.IO.fixIO'.
278--
279-- @since 4.11.0.0
280data FixIOException = FixIOException
281
282-- | @since 4.11.0.0
283instance Exception FixIOException
284
285-- | @since 4.11.0.0
286instance Show FixIOException where
287  showsPrec _ FixIOException = showString "cyclic evaluation in fixIO"
288
289-- -----------------------------------------------------------------------------
290-- The ExitCode type
291
292-- We need it here because it is used in ExitException in the
293-- Exception datatype (above).
294
295-- | Defines the exit codes that a program can return.
296data ExitCode
297  = ExitSuccess -- ^ indicates successful termination;
298  | ExitFailure Int
299                -- ^ indicates program failure with an exit code.
300                -- The exact interpretation of the code is
301                -- operating-system dependent.  In particular, some values
302                -- may be prohibited (e.g. 0 on a POSIX-compliant system).
303  deriving (Eq, Ord, Read, Show, Generic)
304
305-- | @since 4.1.0.0
306instance Exception ExitCode
307
308ioException     :: IOException -> IO a
309ioException err = throwIO err
310
311-- | Raise an 'IOError' in the 'IO' monad.
312ioError         :: IOError -> IO a
313ioError         =  ioException
314
315-- ---------------------------------------------------------------------------
316-- IOError type
317
318-- | The Haskell 2010 type for exceptions in the 'IO' monad.
319-- Any I\/O operation may raise an 'IOError' instead of returning a result.
320-- For a more general type of exception, including also those that arise
321-- in pure code, see 'Control.Exception.Exception'.
322--
323-- In Haskell 2010, this is an opaque type.
324type IOError = IOException
325
326-- |Exceptions that occur in the @IO@ monad.
327-- An @IOException@ records a more specific error type, a descriptive
328-- string and maybe the handle that was used when the error was
329-- flagged.
330data IOException
331 = IOError {
332     ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging
333                                     -- the error.
334     ioe_type     :: IOErrorType,    -- what it was.
335     ioe_location :: String,         -- location.
336     ioe_description :: String,      -- error type specific information.
337     ioe_errno    :: Maybe CInt,     -- errno leading to this error, if any.
338     ioe_filename :: Maybe FilePath  -- filename the error is related to.
339   }
340
341-- | @since 4.1.0.0
342instance Exception IOException
343
344-- | @since 4.1.0.0
345instance Eq IOException where
346  (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) =
347    e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2
348
349-- | An abstract type that contains a value for each variant of 'IOError'.
350data IOErrorType
351  -- Haskell 2010:
352  = AlreadyExists
353  | NoSuchThing
354  | ResourceBusy
355  | ResourceExhausted
356  | EOF
357  | IllegalOperation
358  | PermissionDenied
359  | UserError
360  -- GHC only:
361  | UnsatisfiedConstraints
362  | SystemError
363  | ProtocolError
364  | OtherError
365  | InvalidArgument
366  | InappropriateType
367  | HardwareFault
368  | UnsupportedOperation
369  | TimeExpired
370  | ResourceVanished
371  | Interrupted
372
373-- | @since 4.1.0.0
374instance Eq IOErrorType where
375   x == y = isTrue# (getTag x ==# getTag y)
376
377-- | @since 4.1.0.0
378instance Show IOErrorType where
379  showsPrec _ e =
380    showString $
381    case e of
382      AlreadyExists     -> "already exists"
383      NoSuchThing       -> "does not exist"
384      ResourceBusy      -> "resource busy"
385      ResourceExhausted -> "resource exhausted"
386      EOF               -> "end of file"
387      IllegalOperation  -> "illegal operation"
388      PermissionDenied  -> "permission denied"
389      UserError         -> "user error"
390      HardwareFault     -> "hardware fault"
391      InappropriateType -> "inappropriate type"
392      Interrupted       -> "interrupted"
393      InvalidArgument   -> "invalid argument"
394      OtherError        -> "failed"
395      ProtocolError     -> "protocol error"
396      ResourceVanished  -> "resource vanished"
397      SystemError       -> "system error"
398      TimeExpired       -> "timeout"
399      UnsatisfiedConstraints -> "unsatisfied constraints" -- ultra-precise!
400      UnsupportedOperation -> "unsupported operation"
401
402-- | Construct an 'IOError' value with a string describing the error.
403-- The 'fail' method of the 'IO' instance of the 'Monad' class raises a
404-- 'userError', thus:
405--
406-- > instance Monad IO where
407-- >   ...
408-- >   fail s = ioError (userError s)
409--
410userError       :: String  -> IOError
411userError str   =  IOError Nothing UserError "" str Nothing Nothing
412
413-- ---------------------------------------------------------------------------
414-- Showing IOErrors
415
416-- | @since 4.1.0.0
417instance Show IOException where
418    showsPrec p (IOError hdl iot loc s _ fn) =
419      (case fn of
420         Nothing -> case hdl of
421                        Nothing -> id
422                        Just h  -> showsPrec p h . showString ": "
423         Just name -> showString name . showString ": ") .
424      (case loc of
425         "" -> id
426         _  -> showString loc . showString ": ") .
427      showsPrec p iot .
428      (case s of
429         "" -> id
430         _  -> showString " (" . showString s . showString ")")
431
432-- Note the use of "lazy". This means that
433--     assert False (throw e)
434-- will throw the assertion failure rather than e. See trac #5561.
435assertError :: (?callStack :: CallStack) => Bool -> a -> a
436assertError predicate v
437  | predicate = lazy v
438  | otherwise = unsafeDupablePerformIO $ do
439    ccsStack <- currentCallStack
440    let
441      implicitParamCallStack = prettyCallStackLines ?callStack
442      ccsCallStack = showCCSStack ccsStack
443      stack = intercalate "\n" $ implicitParamCallStack ++ ccsCallStack
444    throwIO (AssertionFailed ("Assertion failed\n" ++ stack))
445
446unsupportedOperation :: IOError
447unsupportedOperation =
448   (IOError Nothing UnsupportedOperation ""
449        "Operation is not supported" Nothing Nothing)
450
451{-
452(untangle coded message) expects "coded" to be of the form
453        "location|details"
454It prints
455        location message details
456-}
457untangle :: Addr# -> String -> String
458untangle coded message
459  =  location
460  ++ ": "
461  ++ message
462  ++ details
463  ++ "\n"
464  where
465    coded_str = unpackCStringUtf8# coded
466
467    (location, details)
468      = case (span not_bar coded_str) of { (loc, rest) ->
469        case rest of
470          ('|':det) -> (loc, ' ' : det)
471          _         -> (loc, "")
472        }
473    not_bar c = c /= '|'
474
475