GHC/IOBase.lhs

   1 \begin{code}
   2 {-# OPTIONS -fno-implicit-prelude #-}
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  GHC.IOBase
   6 -- Copyright   :  (c) The University of Glasgow 1994-2002
   7 -- License     :  see libraries/base/LICENSE
   8 --
   9 -- Maintainer  :  cvs-ghc@haskell.org
  10 -- Stability   :  internal
  11 -- Portability :  non-portable (GHC Extensions)
  12 --
  13 -- Definitions for the 'IO' monad and its friends.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module GHC.IOBase where
  18
  19 import GHC.ST
  20 import GHC.STRef
  21 import GHC.Base
  22 import GHC.Num  -- To get fromInteger etc, needed because of -fno-implicit-prelude
  23 import Data.Maybe  ( Maybe(..) )
  24 import GHC.Show
  25 import GHC.List
  26 import GHC.Read
  27
  28 #ifndef __HADDOCK__
  29 import {-# SOURCE #-} Data.Dynamic
  30 #endif
  31
  32 -- ---------------------------------------------------------------------------
  33 -- The IO Monad
  34
  35 {-
  36 The IO Monad is just an instance of the ST monad, where the state is
  37 the real world.  We use the exception mechanism (in GHC.Exception) to
  38 implement IO exceptions.
  39
  40 NOTE: The IO representation is deeply wired in to various parts of the
  41 system.  The following list may or may not be exhaustive:
  42
  43 Compiler  - types of various primitives in PrimOp.lhs
  44
  45 RTS       - forceIO (StgMiscClosures.hc)
  46           - catchzh_fast, (un)?blockAsyncExceptionszh_fast, raisezh_fast
  47             (Exceptions.hc)
  48           - raiseAsync (Schedule.c)
  49
  50 Prelude   - GHC.IOBase.lhs, and several other places including
  51             GHC.Exception.lhs.
  52
  53 Libraries - parts of hslibs/lang.
  54
  55 --SDM
  56 -}
  57
  58 newtype IO a = IO (State# RealWorld -> (# State# RealWorld, a #))
  59
  60 unIO :: IO a -> (State# RealWorld -> (# State# RealWorld, a #))
  61 unIO (IO a) = a
  62
  63 instance  Functor IO where
  64    fmap f x = x >>= (return . f)
  65
  66 instance  Monad IO  where
  67     {-# INLINE return #-}
  68     {-# INLINE (>>)   #-}
  69     {-# INLINE (>>=)  #-}
  70     m >> k      =  m >>= \ _ -> k
  71     return x    = returnIO x
  72
  73     m >>= k     = bindIO m k
  74     fail s      = failIO s
  75
  76 failIO :: String -> IO a
  77 failIO s = ioError (userError s)
  78
  79 liftIO :: IO a -> State# RealWorld -> STret RealWorld a
  80 liftIO (IO m) = \s -> case m s of (# s', r #) -> STret s' r
  81
  82 bindIO :: IO a -> (a -> IO b) -> IO b
  83 bindIO (IO m) k = IO ( \ s ->
  84   case m s of
  85     (# new_s, a #) -> unIO (k a) new_s
  86   )
  87
  88 thenIO :: IO a -> IO b -> IO b
  89 thenIO (IO m) k = IO ( \ s ->
  90   case m s of
  91     (# new_s, a #) -> unIO k new_s
  92   )
  93
  94 returnIO :: a -> IO a
  95 returnIO x = IO (\ s -> (# s, x #))
  96
  97 -- ---------------------------------------------------------------------------
  98 -- Coercions between IO and ST
  99
 100 --stToIO        :: (forall s. ST s a) -> IO a
 101 stToIO        :: ST RealWorld a -> IO a
 102 stToIO (ST m) = IO m
 103
 104 ioToST        :: IO a -> ST RealWorld a
 105 ioToST (IO m) = (ST m)
 106
 107 -- ---------------------------------------------------------------------------
 108 -- Unsafe IO operations
 109
 110 {-# NOINLINE unsafePerformIO #-}
 111 unsafePerformIO :: IO a -> a
 112 unsafePerformIO (IO m) = case m realWorld# of (# _, r #)   -> r
 113
 114 {-# NOINLINE unsafeInterleaveIO #-}
 115 unsafeInterleaveIO :: IO a -> IO a
 116 unsafeInterleaveIO (IO m)
 117   = IO ( \ s -> let
 118                    r = case m s of (# _, res #) -> res
 119                 in
 120                 (# s, r #))
 121
 122 -- ---------------------------------------------------------------------------
 123 -- Handle type
 124
 125 data MVar a = MVar (MVar# RealWorld a)
 126
 127 -- pull in Eq (Mvar a) too, to avoid GHC.Conc being an orphan-instance module
 128 instance Eq (MVar a) where
 129         (MVar mvar1#) == (MVar mvar2#) = sameMVar# mvar1# mvar2#
 130
 131 --  A Handle is represented by (a reference to) a record
 132 --  containing the state of the I/O port/device. We record
 133 --  the following pieces of info:
 134
 135 --    * type (read,write,closed etc.)
 136 --    * the underlying file descriptor
 137 --    * buffering mode
 138 --    * buffer, and spare buffers
 139 --    * user-friendly name (usually the
 140 --      FilePath used when IO.openFile was called)
 141
 142 -- Note: when a Handle is garbage collected, we want to flush its buffer
 143 -- and close the OS file handle, so as to free up a (precious) resource.
 144
 145 data Handle
 146   = FileHandle                          -- A normal handle to a file
 147         !(MVar Handle__)
 148
 149   | DuplexHandle                        -- A handle to a read/write stream
 150         !(MVar Handle__)                -- The read side
 151         !(MVar Handle__)                -- The write side
 152
 153 -- NOTES:
 154 --    * A 'FileHandle' is seekable.  A 'DuplexHandle' may or may not be
 155 --      seekable.
 156
 157 instance Eq Handle where
 158  (FileHandle h1)     == (FileHandle h2)     = h1 == h2
 159  (DuplexHandle h1 _) == (DuplexHandle h2 _) = h1 == h2
 160  _ == _ = False
 161
 162 type FD = Int -- XXX ToDo: should be CInt
 163
 164 data Handle__
 165   = Handle__ {
 166       haFD          :: !FD,                  -- file descriptor
 167       haType        :: HandleType,           -- type (read/write/append etc.)
 168       haIsBin       :: Bool,                 -- binary mode?
 169       haIsStream    :: Bool,                 -- is this a stream handle?
 170       haBufferMode  :: BufferMode,           -- buffer contains read/write data?
 171       haFilePath    :: FilePath,             -- file name, possibly
 172       haBuffer      :: !(IORef Buffer),      -- the current buffer
 173       haBuffers     :: !(IORef BufferList),  -- spare buffers
 174       haOtherSide   :: Maybe (MVar Handle__) -- ptr to the write side of a
 175                                              -- duplex handle.
 176     }
 177
 178 -- ---------------------------------------------------------------------------
 179 -- Buffers
 180
 181 -- The buffer is represented by a mutable variable containing a
 182 -- record, where the record contains the raw buffer and the start/end
 183 -- points of the filled portion.  We use a mutable variable so that
 184 -- the common operation of writing (or reading) some data from (to)
 185 -- the buffer doesn't need to modify, and hence copy, the handle
 186 -- itself, it just updates the buffer.
 187
 188 -- There will be some allocation involved in a simple hPutChar in
 189 -- order to create the new Buffer structure (below), but this is
 190 -- relatively small, and this only has to be done once per write
 191 -- operation.
 192
 193 -- The buffer contains its size - we could also get the size by
 194 -- calling sizeOfMutableByteArray# on the raw buffer, but that tends
 195 -- to be rounded up to the nearest Word.
 196
 197 type RawBuffer = MutableByteArray# RealWorld
 198
 199 -- INVARIANTS on a Buffer:
 200 --
 201 --   * A handle *always* has a buffer, even if it is only 1 character long
 202 --     (an unbuffered handle needs a 1 character buffer in order to support
 203 --      hLookAhead and hIsEOF).
 204 --   * r <= w
 205 --   * if r == w, then r == 0 && w == 0
 206 --   * if state == WriteBuffer, then r == 0
 207 --   * a write buffer is never full.  If an operation
 208 --     fills up the buffer, it will always flush it before
 209 --     returning.
 210 --   * a read buffer may be full as a result of hLookAhead.  In normal
 211 --     operation, a read buffer always has at least one character of space.
 212
 213 data Buffer
 214   = Buffer {
 215         bufBuf   :: RawBuffer,
 216         bufRPtr  :: !Int,
 217         bufWPtr  :: !Int,
 218         bufSize  :: !Int,
 219         bufState :: BufferState
 220   }
 221
 222 data BufferState = ReadBuffer | WriteBuffer deriving (Eq)
 223
 224 -- we keep a few spare buffers around in a handle to avoid allocating
 225 -- a new one for each hPutStr.  These buffers are *guaranteed* to be the
 226 -- same size as the main buffer.
 227 data BufferList
 228   = BufferListNil
 229   | BufferListCons RawBuffer BufferList
 230
 231
 232 bufferIsWritable :: Buffer -> Bool
 233 bufferIsWritable Buffer{ bufState=WriteBuffer } = True
 234 bufferIsWritable _other = False
 235
 236 bufferEmpty :: Buffer -> Bool
 237 bufferEmpty Buffer{ bufRPtr=r, bufWPtr=w } = r == w
 238
 239 -- only makes sense for a write buffer
 240 bufferFull :: Buffer -> Bool
 241 bufferFull b@Buffer{ bufWPtr=w } = w >= bufSize b
 242
 243 --  Internally, we classify handles as being one
 244 --  of the following:
 245
 246 data HandleType
 247  = ClosedHandle
 248  | SemiClosedHandle
 249  | ReadHandle
 250  | WriteHandle
 251  | AppendHandle
 252  | ReadWriteHandle
 253
 254 isReadableHandleType ReadHandle         = True
 255 isReadableHandleType ReadWriteHandle    = True
 256 isReadableHandleType _                  = False
 257
 258 isWritableHandleType AppendHandle    = True
 259 isWritableHandleType WriteHandle     = True
 260 isWritableHandleType ReadWriteHandle = True
 261 isWritableHandleType _               = False
 262
 263 -- File names are specified using @FilePath@, a OS-dependent
 264 -- string that (hopefully, I guess) maps to an accessible file/object.
 265
 266 type FilePath = String
 267
 268 -- ---------------------------------------------------------------------------
 269 -- Buffering modes
 270
 271 -- Three kinds of buffering are supported: line-buffering,
 272 -- block-buffering or no-buffering.  These modes have the following
 273 -- effects. For output, items are written out from the internal
 274 -- buffer according to the buffer mode:
 275 --
 276 -- o line-buffering  the entire output buffer is written
 277 --   out whenever a newline is output, the output buffer overflows,
 278 --   a flush is issued, or the handle is closed.
 279 --
 280 -- o block-buffering the entire output buffer is written out whenever
 281 --   it overflows, a flush is issued, or the handle
 282 --   is closed.
 283 --
 284 -- o no-buffering output is written immediately, and never stored
 285 --   in the output buffer.
 286 --
 287 -- The output buffer is emptied as soon as it has been written out.
 288
 289 -- Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 290
 291 -- o line-buffering when the input buffer for the handle is not empty,
 292 --   the next item is obtained from the buffer;
 293 --   otherwise, when the input buffer is empty,
 294 --   characters up to and including the next newline
 295 --   character are read into the buffer.  No characters
 296 --   are available until the newline character is
 297 --   available.
 298 --
 299 -- o block-buffering when the input buffer for the handle becomes empty,
 300 --   the next block of data is read into this buffer.
 301 --
 302 -- o no-buffering the next input item is read and returned.
 303
 304 -- For most implementations, physical files will normally be block-buffered
 305 -- and terminals will normally be line-buffered. (the IO interface provides
 306 -- operations for changing the default buffering of a handle tho.)
 307
 308 data BufferMode
 309  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 310    deriving (Eq, Ord, Read, Show)
 311
 312 -- ---------------------------------------------------------------------------
 313 -- IORefs
 314
 315 newtype IORef a = IORef (STRef RealWorld a) deriving Eq
 316
 317 newIORef    :: a -> IO (IORef a)
 318 newIORef v = stToIO (newSTRef v) >>= \ var -> return (IORef var)
 319
 320 readIORef   :: IORef a -> IO a
 321 readIORef  (IORef var) = stToIO (readSTRef var)
 322
 323 writeIORef  :: IORef a -> a -> IO ()
 324 writeIORef (IORef var) v = stToIO (writeSTRef var v)
 325
 326 -- ---------------------------------------------------------------------------
 327 -- Show instance for Handles
 328
 329 -- handle types are 'show'n when printing error msgs, so
 330 -- we provide a more user-friendly Show instance for it
 331 -- than the derived one.
 332
 333 instance Show HandleType where
 334   showsPrec p t =
 335     case t of
 336       ClosedHandle      -> showString "closed"
 337       SemiClosedHandle  -> showString "semi-closed"
 338       ReadHandle        -> showString "readable"
 339       WriteHandle       -> showString "writable"
 340       AppendHandle      -> showString "writable (append)"
 341       ReadWriteHandle   -> showString "read-writable"
 342
 343 instance Show Handle where
 344   showsPrec p (FileHandle   h)   = showHandle p h False
 345   showsPrec p (DuplexHandle _ h) = showHandle p h True
 346
 347 showHandle p h duplex =
 348     let
 349      -- (Big) SIGH: unfolded defn of takeMVar to avoid
 350      -- an (oh-so) unfortunate module loop with GHC.Conc.
 351      hdl_ = unsafePerformIO (IO $ \ s# ->
 352              case h                 of { MVar h# ->
 353              case takeMVar# h# s#   of { (# s2# , r #) ->
 354              case putMVar# h# r s2# of { s3# ->
 355              (# s3#, r #) }}})
 356
 357      showType | duplex = showString "duplex (read-write)"
 358               | otherwise = showsPrec p (haType hdl_)
 359     in
 360     showChar '{' .
 361     showHdl (haType hdl_)
 362             (showString "loc=" . showString (haFilePath hdl_) . showChar ',' .
 363              showString "type=" . showType . showChar ',' .
 364              showString "binary=" . showsPrec p (haIsBin hdl_) . showChar ',' .
 365              showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
 366    where
 367
 368     showHdl :: HandleType -> ShowS -> ShowS
 369     showHdl ht cont =
 370        case ht of
 371         ClosedHandle  -> showsPrec p ht . showString "}"
 372         _ -> cont
 373
 374     showBufMode :: Buffer -> BufferMode -> ShowS
 375     showBufMode buf bmo =
 376       case bmo of
 377         NoBuffering   -> showString "none"
 378         LineBuffering -> showString "line"
 379         BlockBuffering (Just n) -> showString "block " . showParen True (showsPrec p n)
 380         BlockBuffering Nothing  -> showString "block " . showParen True (showsPrec p def)
 381       where
 382        def :: Int
 383        def = bufSize buf
 384
 385 -- ------------------------------------------------------------------------
 386 -- Exception datatype and operations
 387
 388 data Exception
 389   = IOException         IOException     -- IO exceptions
 390   | ArithException      ArithException  -- Arithmetic exceptions
 391   | ArrayException      ArrayException  -- Array-related exceptions
 392   | ErrorCall           String          -- Calls to 'error'
 393   | ExitException       ExitCode        -- Call to System.exitWith
 394   | NoMethodError       String          -- A non-existent method was invoked
 395   | PatternMatchFail    String          -- A pattern match / guard failure
 396   | RecSelError         String          -- Selecting a non-existent field
 397   | RecConError         String          -- Field missing in record construction
 398   | RecUpdError         String          -- Record doesn't contain updated field
 399   | AssertionFailed     String          -- Assertions
 400   | DynException        Dynamic         -- Dynamic exceptions
 401   | AsyncException      AsyncException  -- Externally generated errors
 402   | BlockedOnDeadMVar                   -- Blocking on a dead MVar
 403   | Deadlock                            -- no threads can run (raised in main thread)
 404   | NonTermination
 405
 406 data ArithException
 407   = Overflow
 408   | Underflow
 409   | LossOfPrecision
 410   | DivideByZero
 411   | Denormal
 412   deriving (Eq, Ord)
 413
 414 data AsyncException
 415   = StackOverflow
 416   | HeapOverflow
 417   | ThreadKilled
 418   deriving (Eq, Ord)
 419
 420 data ArrayException
 421   = IndexOutOfBounds    String          -- out-of-range array access
 422   | UndefinedElement    String          -- evaluating an undefined element
 423   deriving (Eq, Ord)
 424
 425 stackOverflow, heapOverflow :: Exception -- for the RTS
 426 stackOverflow = AsyncException StackOverflow
 427 heapOverflow  = AsyncException HeapOverflow
 428
 429 instance Show ArithException where
 430   showsPrec _ Overflow        = showString "arithmetic overflow"
 431   showsPrec _ Underflow       = showString "arithmetic underflow"
 432   showsPrec _ LossOfPrecision = showString "loss of precision"
 433   showsPrec _ DivideByZero    = showString "divide by zero"
 434   showsPrec _ Denormal        = showString "denormal"
 435
 436 instance Show AsyncException where
 437   showsPrec _ StackOverflow   = showString "stack overflow"
 438   showsPrec _ HeapOverflow    = showString "heap overflow"
 439   showsPrec _ ThreadKilled    = showString "thread killed"
 440
 441 instance Show ArrayException where
 442   showsPrec _ (IndexOutOfBounds s)
 443         = showString "array index out of range"
 444         . (if not (null s) then showString ": " . showString s
 445                            else id)
 446   showsPrec _ (UndefinedElement s)
 447         = showString "undefined array element"
 448         . (if not (null s) then showString ": " . showString s
 449                            else id)
 450
 451 instance Show Exception where
 452   showsPrec _ (IOException err)          = shows err
 453   showsPrec _ (ArithException err)       = shows err
 454   showsPrec _ (ArrayException err)       = shows err
 455   showsPrec _ (ErrorCall err)            = showString err
 456   showsPrec _ (ExitException err)        = showString "exit: " . shows err
 457   showsPrec _ (NoMethodError err)        = showString err
 458   showsPrec _ (PatternMatchFail err)     = showString err
 459   showsPrec _ (RecSelError err)          = showString err
 460   showsPrec _ (RecConError err)          = showString err
 461   showsPrec _ (RecUpdError err)          = showString err
 462   showsPrec _ (AssertionFailed err)      = showString err
 463   showsPrec _ (DynException _err)        = showString "unknown exception"
 464   showsPrec _ (AsyncException e)         = shows e
 465   showsPrec _ (BlockedOnDeadMVar)        = showString "thread blocked indefinitely"
 466   showsPrec _ (NonTermination)           = showString "<<loop>>"
 467   showsPrec _ (Deadlock)                 = showString "<<deadlock>>"
 468
 469 instance Eq Exception where
 470   IOException e1      == IOException e2      = e1 == e2
 471   ArithException e1   == ArithException e2   = e1 == e2
 472   ArrayException e1   == ArrayException e2   = e1 == e2
 473   ErrorCall e1        == ErrorCall e2        = e1 == e2
 474   ExitException e1    == ExitException e2    = e1 == e2
 475   NoMethodError e1    == NoMethodError e2    = e1 == e2
 476   PatternMatchFail e1 == PatternMatchFail e2 = e1 == e2
 477   RecSelError e1      == RecSelError e2      = e1 == e2
 478   RecConError e1      == RecConError e2      = e1 == e2
 479   RecUpdError e1      == RecUpdError e2      = e1 == e2
 480   AssertionFailed e1  == AssertionFailed e2  = e1 == e2
 481   DynException _      == DynException _      = False -- incomparable
 482   AsyncException e1   == AsyncException e2   = e1 == e2
 483   BlockedOnDeadMVar   == BlockedOnDeadMVar   = True
 484   NonTermination      == NonTermination      = True
 485   Deadlock            == Deadlock            = True
 486
 487 -- -----------------------------------------------------------------------------
 488 -- The ExitCode type
 489
 490 -- The `ExitCode' type defines the exit codes that a program
 491 -- can return.  `ExitSuccess' indicates successful termination;
 492 -- and `ExitFailure code' indicates program failure
 493 -- with value `code'.  The exact interpretation of `code'
 494 -- is operating-system dependent.  In particular, some values of
 495 -- `code' may be prohibited (e.g. 0 on a POSIX-compliant system).
 496
 497 -- We need it here because it is used in ExitException in the
 498 -- Exception datatype (above).
 499
 500 data ExitCode = ExitSuccess | ExitFailure Int
 501                 deriving (Eq, Ord, Read, Show)
 502
 503 -- --------------------------------------------------------------------------
 504 -- Primitive throw
 505
 506 throw :: Exception -> a
 507 throw exception = raise# exception
 508
 509 ioError         :: Exception -> IO a
 510 ioError err     =  IO $ \s -> throw err s
 511
 512 ioException     :: IOException -> IO a
 513 ioException err =  IO $ \s -> throw (IOException err) s
 514
 515 -- ---------------------------------------------------------------------------
 516 -- IOError type
 517
 518 -- A value @IOError@ encode errors occurred in the @IO@ monad.
 519 -- An @IOError@ records a more specific error type, a descriptive
 520 -- string and maybe the handle that was used when the error was
 521 -- flagged.
 522
 523 type IOError = Exception
 524
 525 data IOException
 526  = IOError {
 527      ioe_handle   :: Maybe Handle,   -- the handle used by the action flagging
 528                                      -- the error.
 529      ioe_type     :: IOErrorType,    -- what it was.
 530      ioe_location :: String,         -- location.
 531      ioe_descr    :: String,         -- error type specific information.
 532      ioe_filename :: Maybe FilePath  -- filename the error is related to.
 533    }
 534
 535 instance Eq IOException where
 536   (IOError h1 e1 loc1 str1 fn1) == (IOError h2 e2 loc2 str2 fn2) =
 537     e1==e2 && str1==str2 && h1==h2 && loc1==loc2 && fn1==fn2
 538
 539 data IOErrorType
 540   -- Haskell 98:
 541   = AlreadyExists
 542   | NoSuchThing
 543   | ResourceBusy
 544   | ResourceExhausted
 545   | EOF
 546   | IllegalOperation
 547   | PermissionDenied
 548   | UserError
 549   -- GHC only:
 550   | UnsatisfiedConstraints
 551   | SystemError
 552   | ProtocolError
 553   | OtherError
 554   | InvalidArgument
 555   | InappropriateType
 556   | HardwareFault
 557   | UnsupportedOperation
 558   | TimeExpired
 559   | ResourceVanished
 560   | Interrupted
 561   | DynIOError Dynamic -- cheap&cheerful extensible IO error type.
 562
 563 instance Eq IOErrorType where
 564    x == y =
 565      case x of
 566        DynIOError{} -> False -- from a strictness POV, compatible with a derived Eq inst?
 567        _ -> getTag# x ==# getTag# y
 568
 569 instance Show IOErrorType where
 570   showsPrec _ e =
 571     showString $
 572     case e of
 573       AlreadyExists     -> "already exists"
 574       NoSuchThing       -> "does not exist"
 575       ResourceBusy      -> "resource busy"
 576       ResourceExhausted -> "resource exhausted"
 577       EOF               -> "end of file"
 578       IllegalOperation  -> "illegal operation"
 579       PermissionDenied  -> "permission denied"
 580       UserError         -> "user error"
 581       HardwareFault     -> "hardware fault"
 582       InappropriateType -> "inappropriate type"
 583       Interrupted       -> "interrupted"
 584       InvalidArgument   -> "invalid argument"
 585       OtherError        -> "failed"
 586       ProtocolError     -> "protocol error"
 587       ResourceVanished  -> "resource vanished"
 588       SystemError       -> "system error"
 589       TimeExpired       -> "timeout"
 590       UnsatisfiedConstraints -> "unsatisified constraints" -- ultra-precise!
 591       UnsupportedOperation -> "unsupported operation"
 592       DynIOError{}      -> "unknown IO error"
 593
 594 userError       :: String  -> IOError
 595 userError str   =  IOException (IOError Nothing UserError "" str Nothing)
 596
 597 -- ---------------------------------------------------------------------------
 598 -- Showing IOErrors
 599
 600 instance Show IOException where
 601     showsPrec p (IOError hdl iot loc s fn) =
 602       showsPrec p iot .
 603       (case loc of
 604          "" -> id
 605          _  -> showString "\nAction: " . showString loc) .
 606       (case hdl of
 607         Nothing -> id
 608         Just h  -> showString "\nHandle: " . showsPrec p h) .
 609       (case s of
 610          "" -> id
 611          _  -> showString "\nReason: " . showString s) .
 612       (case fn of
 613          Nothing -> id
 614          Just name -> showString "\nFile: " . showString name)
 615 \end{code}