Rewrite of the IO library, including Unicode support
[ghc-base.git] / GHC / IO / Exception.hs
1 {-# OPTIONS_GHC -fno-implicit-prelude -funbox-strict-fields #-}
2 {-# OPTIONS_HADDOCK hide #-}
3 -----------------------------------------------------------------------------
4 -- |
5 -- Module      :  GHC.IO.Exception
6 -- Copyright   :  (c) The University of Glasgow, 2009
7 -- License     :  see libraries/base/LICENSE
8 -- 
9 -- Maintainer  :  libraries@haskell.org
10 -- Stability   :  internal
11 -- Portability :  non-portable
12 --
13 -- IO-related Exception types and functions
14 --
15 -----------------------------------------------------------------------------
16
17 module GHC.IO.Exception (
18   BlockedOnDeadMVar(..),   blockedOnDeadMVar,
19   BlockedIndefinitely(..), blockedIndefinitely,
20   Deadlock(..),
21   AssertionFailed(..),
22   AsyncException(..), stackOverflow, heapOverflow,
23   ArrayException(..),
24   ExitCode(..),
25
26   ioException,
27   ioError,
28   IOError,
29   IOException(..),
30   IOErrorType(..),
31   userError,
32   assertError,
33   unsupportedOperation,
34   untangle,
35  ) where
36
37 import GHC.Base
38 import GHC.List
39 import GHC.IO
40 import GHC.Show
41 import GHC.Read
42 import GHC.Exception
43 import Data.Maybe
44 import GHC.IO.Handle.Types
45 import Foreign.C.Types
46
47 import Data.Typeable     ( Typeable )
48
49 -- ------------------------------------------------------------------------
50 -- Exception datatypes and operations
51
52 -- |The thread is blocked on an @MVar@, but there are no other references
53 -- to the @MVar@ so it can't ever continue.
54 data BlockedOnDeadMVar = BlockedOnDeadMVar
55     deriving Typeable
56
57 instance Exception BlockedOnDeadMVar
58
59 instance Show BlockedOnDeadMVar where
60     showsPrec _ BlockedOnDeadMVar = showString "thread blocked indefinitely"
61
62 blockedOnDeadMVar :: SomeException -- for the RTS
63 blockedOnDeadMVar = toException BlockedOnDeadMVar
64
65 -----
66
67 -- |The thread is awiting to retry an STM transaction, but there are no
68 -- other references to any @TVar@s involved, so it can't ever continue.
69 data BlockedIndefinitely = BlockedIndefinitely
70     deriving Typeable
71
72 instance Exception BlockedIndefinitely
73
74 instance Show BlockedIndefinitely where
75     showsPrec _ BlockedIndefinitely = showString "thread blocked indefinitely"
76
77 blockedIndefinitely :: SomeException -- for the RTS
78 blockedIndefinitely = toException BlockedIndefinitely
79
80 -----
81
82 -- |There are no runnable threads, so the program is deadlocked.
83 -- The @Deadlock@ exception is raised in the main thread only.
84 data Deadlock = Deadlock
85     deriving Typeable
86
87 instance Exception Deadlock
88
89 instance Show Deadlock where
90     showsPrec _ Deadlock = showString "<<deadlock>>"
91
92 -----
93
94 -- |There are no runnable threads, so the program is deadlocked.
95 -- The @Deadlock@ exception is raised in the main thread only.
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 data ExitCode
174   = ExitSuccess -- ^ indicates successful termination;
175   | ExitFailure Int
176                 -- ^ indicates program failure with an exit code.
177                 -- The exact interpretation of the code is
178                 -- operating-system dependent.  In particular, some values
179                 -- may be prohibited (e.g. 0 on a POSIX-compliant system).
180   deriving (Eq, Ord, Read, Show, Typeable)
181
182 instance Exception ExitCode
183
184 ioException     :: IOException -> IO a
185 ioException err = throwIO err
186
187 -- | Raise an 'IOError' in the 'IO' monad.
188 ioError         :: IOError -> IO a 
189 ioError         =  ioException
190
191 -- ---------------------------------------------------------------------------
192 -- IOError type
193
194 -- | The Haskell 98 type for exceptions in the 'IO' monad.
195 -- Any I\/O operation may raise an 'IOError' instead of returning a result.
196 -- For a more general type of exception, including also those that arise
197 -- in pure code, see 'Control.Exception.Exception'.
198 --
199 -- In Haskell 98, this is an opaque type.
200 type IOError = IOException
201
202 -- |Exceptions that occur in the @IO@ monad.
203 -- An @IOException@ records a more specific error type, a descriptive
204 -- string and maybe the handle that was used when the error was
205 -- flagged.
206 data IOException
207  = IOError {
208      ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging 
209                                      -- the error.
210      ioe_type     :: IOErrorType,    -- what it was.
211      ioe_location :: String,         -- location.
212      ioe_description :: String,      -- error type specific information.
213      ioe_errno    :: Maybe CInt,     -- errno leading to this error, if any.
214      ioe_filename :: Maybe FilePath  -- filename the error is related to.
215    }
216     deriving Typeable
217
218 instance Exception IOException
219
220 instance Eq IOException where
221   (IOError h1 e1 loc1 str1 en1 fn1) == (IOError h2 e2 loc2 str2 en2 fn2) = 
222     e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && en1==en2 && fn1==fn2
223
224 -- | An abstract type that contains a value for each variant of 'IOError'.
225 data IOErrorType
226   -- Haskell 98:
227   = AlreadyExists
228   | NoSuchThing
229   | ResourceBusy
230   | ResourceExhausted
231   | EOF
232   | IllegalOperation
233   | PermissionDenied
234   | UserError
235   -- GHC only:
236   | UnsatisfiedConstraints
237   | SystemError
238   | ProtocolError
239   | OtherError
240   | InvalidArgument
241   | InappropriateType
242   | HardwareFault
243   | UnsupportedOperation
244   | TimeExpired
245   | ResourceVanished
246   | Interrupted
247
248 instance Eq IOErrorType where
249    x == y = getTag x ==# getTag y
250  
251 instance Show IOErrorType where
252   showsPrec _ e =
253     showString $
254     case e of
255       AlreadyExists     -> "already exists"
256       NoSuchThing       -> "does not exist"
257       ResourceBusy      -> "resource busy"
258       ResourceExhausted -> "resource exhausted"
259       EOF               -> "end of file"
260       IllegalOperation  -> "illegal operation"
261       PermissionDenied  -> "permission denied"
262       UserError         -> "user error"
263       HardwareFault     -> "hardware fault"
264       InappropriateType -> "inappropriate type"
265       Interrupted       -> "interrupted"
266       InvalidArgument   -> "invalid argument"
267       OtherError        -> "failed"
268       ProtocolError     -> "protocol error"
269       ResourceVanished  -> "resource vanished"
270       SystemError       -> "system error"
271       TimeExpired       -> "timeout"
272       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
273       UnsupportedOperation -> "unsupported operation"
274
275 -- | Construct an 'IOError' value with a string describing the error.
276 -- The 'fail' method of the 'IO' instance of the 'Monad' class raises a
277 -- 'userError', thus:
278 --
279 -- > instance Monad IO where 
280 -- >   ...
281 -- >   fail s = ioError (userError s)
282 --
283 userError       :: String  -> IOError
284 userError str   =  IOError Nothing UserError "" str Nothing Nothing
285
286 -- ---------------------------------------------------------------------------
287 -- Showing IOErrors
288
289 instance Show IOException where
290     showsPrec p (IOError hdl iot loc s _ fn) =
291       (case fn of
292          Nothing -> case hdl of
293                         Nothing -> id
294                         Just h  -> showsPrec p h . showString ": "
295          Just name -> showString name . showString ": ") .
296       (case loc of
297          "" -> id
298          _  -> showString loc . showString ": ") .
299       showsPrec p iot . 
300       (case s of
301          "" -> id
302          _  -> showString " (" . showString s . showString ")")
303
304 assertError :: Addr# -> Bool -> a -> a
305 assertError str predicate v
306   | predicate = v
307   | otherwise = throw (AssertionFailed (untangle str "Assertion failed"))
308
309 unsupportedOperation :: IOError
310 unsupportedOperation = 
311    (IOError Nothing UnsupportedOperation ""
312         "Operation is not supported" Nothing Nothing)
313
314 {-
315 (untangle coded message) expects "coded" to be of the form
316         "location|details"
317 It prints
318         location message details
319 -}
320 untangle :: Addr# -> String -> String
321 untangle coded message
322   =  location
323   ++ ": "
324   ++ message
325   ++ details
326   ++ "\n"
327   where
328     coded_str = unpackCStringUtf8# coded
329
330     (location, details)
331       = case (span not_bar coded_str) of { (loc, rest) ->
332         case rest of
333           ('|':det) -> (loc, ' ' : det)
334           _         -> (loc, "")
335         }
336     not_bar c = c /= '|'