ghc/lib/std/PrelHandle.hsc

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2
   3 #undef DEBUG_DUMP
   4 #undef DEBUG
   5
   6 -- -----------------------------------------------------------------------------
   7 -- $Id: PrelHandle.hsc,v 1.8 2001/06/01 13:06:01 sewardj Exp $
   8 --
   9 -- (c) The University of Glasgow, 1994-2001
  10 --
  11 -- This module defines the basic operations on I/O "handles".
  12
  13 module PrelHandle (
  14   withHandle, withHandle', withHandle_,
  15   wantWritableHandle, wantReadableHandle, wantSeekableHandle,
  16
  17   newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
  18   flushWriteBufferOnly, flushWriteBuffer, flushReadBuffer, fillReadBuffer,
  19   read_off,
  20
  21   ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
  22
  23   stdin, stdout, stderr,
  24   IOMode(..), IOModeEx(..), openFile, openFileEx, openFd,
  25   hClose, hFileSize, hIsEOF, isEOF, hLookAhead, hSetBuffering, hSetBinaryMode,
  26   hFlush,
  27
  28   HandlePosn(..), hGetPosn, hSetPosn,
  29   SeekMode(..), hSeek,
  30
  31   hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
  32   hSetEcho, hGetEcho, hIsTerminalDevice,
  33   ioeGetFileName, ioeGetErrorString, ioeGetHandle,
  34
  35 #ifdef DEBUG_DUMP
  36   puts,
  37 #endif
  38
  39  ) where
  40
  41 #include "HsStd.h"
  42
  43 import Monad
  44
  45 import PrelBits
  46 import PrelPosix
  47 import PrelMarshalUtils
  48 import PrelCString
  49 import PrelCTypes
  50 import PrelCError
  51 import PrelReal
  52
  53 import PrelArr
  54 import PrelBase
  55 import PrelPtr
  56 import PrelRead         ( Read )
  57 import PrelList
  58 import PrelIOBase
  59 import PrelMaybe        ( Maybe(..) )
  60 import PrelException
  61 import PrelEnum
  62 import PrelNum          ( Integer(..), Num(..) )
  63 import PrelShow
  64 import PrelReal         ( toInteger )
  65
  66 import PrelConc
  67
  68 -- -----------------------------------------------------------------------------
  69 -- TODO:
  70
  71 -- hWaitForInput blocks (should use a timeout)
  72
  73 -- unbuffered hGetLine is a bit dodgy
  74
  75 -- hSetBuffering: can't change buffering on a stream,
  76 --      when the read buffer is non-empty? (no way to flush the buffer)
  77
  78 -- ---------------------------------------------------------------------------
  79 -- Are files opened by default in text or binary mode, if the user doesn't
  80 -- specify?
  81 dEFAULT_OPEN_IN_BINARY_MODE :: Bool
  82 dEFAULT_OPEN_IN_BINARY_MODE = False
  83
  84 -- ---------------------------------------------------------------------------
  85 -- Creating a new handle
  86
  87 newFileHandle     :: (MVar Handle__ -> IO ()) -> Handle__ -> IO Handle
  88 newFileHandle finalizer hc = do
  89   m <- newMVar hc
  90   addMVarFinalizer m (finalizer m)
  91   return (FileHandle m)
  92
  93 -- ---------------------------------------------------------------------------
  94 -- Working with Handles
  95
  96 {-
  97 In the concurrent world, handles are locked during use.  This is done
  98 by wrapping an MVar around the handle which acts as a mutex over
  99 operations on the handle.
 100
 101 To avoid races, we use the following bracketing operations.  The idea
 102 is to obtain the lock, do some operation and replace the lock again,
 103 whether the operation succeeded or failed.  We also want to handle the
 104 case where the thread receives an exception while processing the IO
 105 operation: in these cases we also want to relinquish the lock.
 106
 107 There are three versions of @withHandle@: corresponding to the three
 108 possible combinations of:
 109
 110         - the operation may side-effect the handle
 111         - the operation may return a result
 112
 113 If the operation generates an error or an exception is raised, the
 114 original handle is always replaced [ this is the case at the moment,
 115 but we might want to revisit this in the future --SDM ].
 116 -}
 117
 118 {-# INLINE withHandle #-}
 119 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
 120 withHandle fun h@(FileHandle m)     act = withHandle' fun h m act
 121 withHandle fun h@(DuplexHandle r w) act = do
 122   withHandle' fun h r act
 123   withHandle' fun h w act
 124
 125 withHandle' fun h m act =
 126    block $ do
 127    h_ <- takeMVar m
 128    checkBufferInvariants h_
 129    (h',v)  <- catchException (act h_)
 130                 (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
 131    checkBufferInvariants h'
 132    putMVar m h'
 133    return v
 134
 135 {-# INLINE withHandle_ #-}
 136 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
 137 withHandle_ fun h@(FileHandle m)     act = withHandle_' fun h m act
 138 withHandle_ fun h@(DuplexHandle m _) act = withHandle_' fun h m act
 139
 140 withHandle_' fun h m act =
 141    block $ do
 142    h_ <- takeMVar m
 143    checkBufferInvariants h_
 144    v  <- catchException (act h_)
 145             (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
 146    checkBufferInvariants h_
 147    putMVar m h_
 148    return v
 149
 150 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
 151 withAllHandles__ fun h@(FileHandle m)     act = withHandle__' fun h m act
 152 withAllHandles__ fun h@(DuplexHandle r w) act = do
 153   withHandle__' fun h r act
 154   withHandle__' fun h w act
 155
 156 withHandle__' fun h m act =
 157    block $ do
 158    h_ <- takeMVar m
 159    checkBufferInvariants h_
 160    h'  <- catchException (act h_)
 161             (\ ex -> putMVar m h_ >> throw (augmentIOError ex fun h h_))
 162    checkBufferInvariants h'
 163    putMVar m h'
 164    return ()
 165
 166 augmentIOError (IOException (IOError _ iot _ str fp)) fun h h_
 167   = IOException (IOError (Just h) iot fun str filepath)
 168   where filepath | Just _ <- fp = fp
 169                  | otherwise    = Just (haFilePath h_)
 170 augmentIOError other_exception _ _ _
 171   = other_exception
 172
 173 -- ---------------------------------------------------------------------------
 174 -- Wrapper for write operations.
 175
 176 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 177 wantWritableHandle fun h@(FileHandle m) act
 178   = wantWritableHandle' fun h m act
 179 wantWritableHandle fun h@(DuplexHandle _ m) act
 180   = wantWritableHandle' fun h m act
 181   -- ToDo: in the Duplex case, we don't need to checkWritableHandle
 182
 183 wantWritableHandle'
 184         :: String -> Handle -> MVar Handle__
 185         -> (Handle__ -> IO a) -> IO a
 186 wantWritableHandle' fun h m act
 187    = withHandle_' fun h m (checkWritableHandle act)
 188
 189 checkWritableHandle act handle_
 190   = case haType handle_ of
 191       ClosedHandle         -> ioe_closedHandle
 192       SemiClosedHandle     -> ioe_closedHandle
 193       ReadHandle           -> ioe_notWritable
 194       ReadWriteHandle      -> do
 195                 let ref = haBuffer handle_
 196                 buf <- readIORef ref
 197                 new_buf <-
 198                   if not (bufferIsWritable buf)
 199                      then do b <- flushReadBuffer (haFD handle_) buf
 200                              return b{ bufState=WriteBuffer }
 201                      else return buf
 202                 writeIORef ref new_buf
 203                 act handle_
 204       _other               -> act handle_
 205
 206 -- ---------------------------------------------------------------------------
 207 -- Wrapper for read operations.
 208
 209 wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 210 wantReadableHandle fun h@(FileHandle   m)   act
 211   = wantReadableHandle' fun h m act
 212 wantReadableHandle fun h@(DuplexHandle m _) act
 213   = wantReadableHandle' fun h m act
 214   -- ToDo: in the Duplex case, we don't need to checkReadableHandle
 215
 216 wantReadableHandle'
 217         :: String -> Handle -> MVar Handle__
 218         -> (Handle__ -> IO a) -> IO a
 219 wantReadableHandle' fun h m act
 220   = withHandle_' fun h m (checkReadableHandle act)
 221
 222 checkReadableHandle act handle_ =
 223     case haType handle_ of
 224       ClosedHandle         -> ioe_closedHandle
 225       SemiClosedHandle     -> ioe_closedHandle
 226       AppendHandle         -> ioe_notReadable
 227       WriteHandle          -> ioe_notReadable
 228       ReadWriteHandle      -> do
 229         let ref = haBuffer handle_
 230         buf <- readIORef ref
 231         when (bufferIsWritable buf) $ do
 232            new_buf <- flushWriteBuffer (haFD handle_) buf
 233            writeIORef ref new_buf{ bufState=ReadBuffer }
 234         act handle_
 235       _other               -> act handle_
 236
 237 -- ---------------------------------------------------------------------------
 238 -- Wrapper for seek operations.
 239
 240 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
 241 wantSeekableHandle fun h@(DuplexHandle _ _) _act =
 242   ioException (IOError (Just h) IllegalOperation fun
 243                    "handle is not seekable" Nothing)
 244 wantSeekableHandle fun h@(FileHandle m) act =
 245   withHandle_' fun h m (checkSeekableHandle act)
 246
 247 checkSeekableHandle act handle_ =
 248     case haType handle_ of
 249       ClosedHandle      -> ioe_closedHandle
 250       SemiClosedHandle  -> ioe_closedHandle
 251       AppendHandle      -> ioe_notSeekable
 252       _                 | haIsBin handle_ -> act handle_
 253                         | otherwise       -> ioe_notSeekable_notBin
 254
 255 -- -----------------------------------------------------------------------------
 256 -- Handy IOErrors
 257
 258 ioe_closedHandle, ioe_EOF,
 259   ioe_notReadable, ioe_notWritable,
 260   ioe_notSeekable, ioe_notSeekable_notBin :: IO a
 261
 262 ioe_closedHandle = ioException
 263    (IOError Nothing IllegalOperation ""
 264         "handle is closed" Nothing)
 265 ioe_EOF = ioException
 266    (IOError Nothing EOF "" "" Nothing)
 267 ioe_notReadable = ioException
 268    (IOError Nothing IllegalOperation ""
 269         "handle is not open for reading" Nothing)
 270 ioe_notWritable = ioException
 271    (IOError Nothing IllegalOperation ""
 272         "handle is not open for writing" Nothing)
 273 ioe_notSeekable = ioException
 274    (IOError Nothing IllegalOperation ""
 275         "handle is not seekable" Nothing)
 276 ioe_notSeekable_notBin = ioException
 277    (IOError Nothing IllegalOperation ""
 278         "seek operations are only allowed on binary-mode handles" Nothing)
 279
 280 ioe_bufsiz :: Int -> IO a
 281 ioe_bufsiz n = ioException
 282    (IOError Nothing InvalidArgument "hSetBuffering"
 283         ("illegal buffer size " ++ showsPrec 9 n []) Nothing)
 284                                 -- 9 => should be parens'ified.
 285
 286 -- -----------------------------------------------------------------------------
 287 -- Handle Finalizers
 288
 289 -- For a duplex handle, we arrange that the read side points to the write side
 290 -- (and hence keeps it alive if the read side is alive).  This is done by
 291 -- having the haType field of the read side be ReadSideHandle with a pointer
 292 -- to the write side.  The finalizer is then placed on the write side, and
 293 -- the handle only gets finalized once, when both sides are no longer
 294 -- required.
 295
 296 addFinalizer :: Handle -> IO ()
 297 addFinalizer (FileHandle m)     = addMVarFinalizer m (handleFinalizer m)
 298 addFinalizer (DuplexHandle _ w) = addMVarFinalizer w (handleFinalizer w)
 299
 300 stdHandleFinalizer :: MVar Handle__ -> IO ()
 301 stdHandleFinalizer m = do
 302   h_ <- takeMVar m
 303   flushWriteBufferOnly h_
 304
 305 handleFinalizer :: MVar Handle__ -> IO ()
 306 handleFinalizer m = do
 307   h_ <- takeMVar m
 308   flushWriteBufferOnly h_
 309   let fd = fromIntegral (haFD h_)
 310   unlockFile fd
 311   -- ToDo: closesocket() for a WINSOCK socket?
 312   when (fd /= -1) (c_close fd >> return ())
 313   return ()
 314
 315 -- ---------------------------------------------------------------------------
 316 -- Grimy buffer operations
 317
 318 #ifdef DEBUG
 319 checkBufferInvariants h_ = do
 320  let ref = haBuffer h_
 321  Buffer{ bufWPtr=w, bufRPtr=r, bufSize=size, bufState=state } <- readIORef ref
 322  if not (
 323         size > 0
 324         && r <= w
 325         && w <= size
 326         && ( r /= w || (r == 0 && w == 0) )
 327         && ( state /= WriteBuffer || r == 0 )
 328         && ( state /= WriteBuffer || w < size ) -- write buffer is never full
 329      )
 330    then error "buffer invariant violation"
 331    else return ()
 332 #else
 333 checkBufferInvariants h_ = return ()
 334 #endif
 335
 336 newEmptyBuffer :: RawBuffer -> BufferState -> Int -> Buffer
 337 newEmptyBuffer b state size
 338   = Buffer{ bufBuf=b, bufRPtr=0, bufWPtr=0, bufSize=size, bufState=state }
 339
 340 allocateBuffer :: Int -> BufferState -> IO Buffer
 341 allocateBuffer sz@(I## size) state = IO $ \s ->
 342   case newByteArray## size s of { (## s, b ##) ->
 343   (## s, newEmptyBuffer b state sz ##) }
 344
 345 writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
 346 writeCharIntoBuffer slab (I## off) (C## c)
 347   = IO $ \s -> case writeCharArray## slab off c s of
 348                  s -> (## s, I## (off +## 1##) ##)
 349
 350 readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
 351 readCharFromBuffer slab (I## off)
 352   = IO $ \s -> case readCharArray## slab off s of
 353                  (## s, c ##) -> (## s, (C## c, I## (off +## 1##)) ##)
 354
 355 dEFAULT_BUFFER_SIZE = (#const BUFSIZ) :: Int
 356
 357 getBuffer :: FD -> BufferState -> IO (IORef Buffer, BufferMode)
 358 getBuffer fd state = do
 359   buffer <- allocateBuffer dEFAULT_BUFFER_SIZE state
 360   ioref  <- newIORef buffer
 361   is_tty <- fdIsTTY fd
 362
 363   let buffer_mode
 364          | is_tty    = LineBuffering
 365          | otherwise = BlockBuffering Nothing
 366
 367   return (ioref, buffer_mode)
 368
 369 mkUnBuffer :: IO (IORef Buffer)
 370 mkUnBuffer = do
 371   buffer <- allocateBuffer 1 ReadBuffer
 372   newIORef buffer
 373
 374 -- flushWriteBufferOnly flushes the buffer iff it contains pending write data.
 375 flushWriteBufferOnly :: Handle__ -> IO ()
 376 flushWriteBufferOnly h_ = do
 377   let fd = haFD h_
 378       ref = haBuffer h_
 379   buf <- readIORef ref
 380   new_buf <- if bufferIsWritable buf
 381                 then flushWriteBuffer fd buf
 382                 else return buf
 383   writeIORef ref new_buf
 384
 385 -- flushBuffer syncs the file with the buffer, including moving the
 386 -- file pointer backwards in the case of a read buffer.
 387 flushBuffer :: Handle__ -> IO ()
 388 flushBuffer h_ = do
 389   let ref = haBuffer h_
 390   buf <- readIORef ref
 391
 392   flushed_buf <-
 393     case bufState buf of
 394       ReadBuffer  -> flushReadBuffer  (haFD h_) buf
 395       WriteBuffer -> flushWriteBuffer (haFD h_) buf
 396
 397   writeIORef ref flushed_buf
 398
 399 -- When flushing a read buffer, we seek backwards by the number of
 400 -- characters in the buffer.  The file descriptor must therefore be
 401 -- seekable: attempting to flush the read buffer on an unseekable
 402 -- handle is not allowed.
 403
 404 flushReadBuffer :: FD -> Buffer -> IO Buffer
 405 flushReadBuffer fd buf
 406   | bufferEmpty buf = return buf
 407   | otherwise = do
 408      let off = negate (bufWPtr buf - bufRPtr buf)
 409 #    ifdef DEBUG_DUMP
 410      puts ("flushReadBuffer: new file offset = " ++ show off ++ "\n")
 411 #    endif
 412      throwErrnoIfMinus1Retry "flushReadBuffer"
 413          (c_lseek (fromIntegral fd) (fromIntegral off) (#const SEEK_CUR))
 414      return buf{ bufWPtr=0, bufRPtr=0 }
 415
 416 flushWriteBuffer :: FD -> Buffer -> IO Buffer
 417 flushWriteBuffer fd buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w }  = do
 418   let bytes = w - r
 419 #ifdef DEBUG_DUMP
 420   puts ("flushWriteBuffer, fd=" ++ show fd ++ ", bytes=" ++ show bytes ++ "\n")
 421 #endif
 422   if bytes == 0
 423      then return (buf{ bufRPtr=0, bufWPtr=0 })
 424      else do
 425   res <- throwErrnoIfMinus1RetryMayBlock "flushWriteBuffer"
 426                 (write_off (fromIntegral fd) b (fromIntegral r)
 427                         (fromIntegral bytes))
 428                 (threadWaitWrite fd)
 429   let res' = fromIntegral res
 430   if res' < bytes
 431      then flushWriteBuffer fd (buf{ bufRPtr = r + res' })
 432      else return buf{ bufRPtr=0, bufWPtr=0 }
 433
 434 foreign import "write_wrap" unsafe
 435    write_off :: CInt -> RawBuffer -> Int -> CInt -> IO CInt
 436 #def inline \
 437 int write_wrap(int fd, void *ptr, HsInt off, int size) \
 438 { return write(fd, ptr + off, size); }
 439
 440
 441 fillReadBuffer :: FD -> Bool -> Buffer -> IO Buffer
 442 fillReadBuffer fd is_line
 443       buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
 444   -- buffer better be empty:
 445   assert (r == 0 && w == 0) $ do
 446   fillReadBufferLoop fd is_line buf b w size
 447
 448 -- For a line buffer, we just get the first chunk of data to arrive,
 449 -- and don't wait for the whole buffer to be full (but we *do* wait
 450 -- until some data arrives).  This isn't really line buffering, but it
 451 -- appears to be what GHC has done for a long time, and I suspect it
 452 -- is more useful than line buffering in most cases.
 453
 454 fillReadBufferLoop fd is_line buf b w size = do
 455   let bytes = size - w
 456   if bytes == 0  -- buffer full?
 457      then return buf{ bufRPtr=0, bufWPtr=w }
 458      else do
 459 #ifdef DEBUG_DUMP
 460   puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
 461 #endif
 462   res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
 463             (read_off fd b (fromIntegral w) (fromIntegral bytes))
 464             (threadWaitRead fd)
 465   let res' = fromIntegral res
 466 #ifdef DEBUG_DUMP
 467   puts ("fillReadBufferLoop:  res' = " ++ show res' ++ "\n")
 468 #endif
 469   if res' == 0
 470      then if w == 0
 471              then ioe_EOF
 472              else return buf{ bufRPtr=0, bufWPtr=w }
 473      else if res' < bytes && not is_line
 474              then fillReadBufferLoop fd is_line buf b (w+res') size
 475              else return buf{ bufRPtr=0, bufWPtr=w+res' }
 476
 477 foreign import "read_wrap" unsafe
 478    read_off :: FD -> RawBuffer -> Int -> CInt -> IO CInt
 479 #def inline \
 480 int read_wrap(int fd, void *ptr, HsInt off, int size) \
 481 { return read(fd, ptr + off, size); }
 482
 483 -- ---------------------------------------------------------------------------
 484 -- Standard Handles
 485
 486 -- Three handles are allocated during program initialisation.  The first
 487 -- two manage input or output from the Haskell program's standard input
 488 -- or output channel respectively.  The third manages output to the
 489 -- standard error channel. These handles are initially open.
 490
 491 fd_stdin  = 0 :: FD
 492 fd_stdout = 1 :: FD
 493 fd_stderr = 2 :: FD
 494
 495 stdin :: Handle
 496 stdin = unsafePerformIO $ do
 497    -- ToDo: acquire lock
 498    setNonBlockingFD fd_stdin
 499    (buf, bmode) <- getBuffer fd_stdin ReadBuffer
 500    spares <- newIORef BufferListNil
 501    newFileHandle stdHandleFinalizer
 502             (Handle__ { haFD = fd_stdin,
 503                         haType = ReadHandle,
 504                         haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
 505                         haBufferMode = bmode,
 506                         haFilePath = "<stdin>",
 507                         haBuffer = buf,
 508                         haBuffers = spares
 509                       })
 510
 511 stdout :: Handle
 512 stdout = unsafePerformIO $ do
 513    -- ToDo: acquire lock
 514    -- We don't set non-blocking mode on stdout or sterr, because
 515    -- some shells don't recover properly.
 516    -- setNonBlockingFD fd_stdout
 517    (buf, bmode) <- getBuffer fd_stdout WriteBuffer
 518    spares <- newIORef BufferListNil
 519    newFileHandle stdHandleFinalizer
 520             (Handle__ { haFD = fd_stdout,
 521                         haType = WriteHandle,
 522                         haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
 523                         haBufferMode = bmode,
 524                         haFilePath = "<stdout>",
 525                         haBuffer = buf,
 526                         haBuffers = spares
 527                       })
 528
 529 stderr :: Handle
 530 stderr = unsafePerformIO $ do
 531     -- ToDo: acquire lock
 532    -- We don't set non-blocking mode on stdout or sterr, because
 533    -- some shells don't recover properly.
 534    -- setNonBlockingFD fd_stderr
 535    buffer <- mkUnBuffer
 536    spares <- newIORef BufferListNil
 537    newFileHandle stdHandleFinalizer
 538             (Handle__ { haFD = fd_stderr,
 539                         haType = WriteHandle,
 540                         haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
 541                         haBufferMode = NoBuffering,
 542                         haFilePath = "<stderr>",
 543                         haBuffer = buffer,
 544                         haBuffers = spares
 545                       })
 546
 547 -- ---------------------------------------------------------------------------
 548 -- Opening and Closing Files
 549
 550 {-
 551 Computation `openFile file mode' allocates and returns a new, open
 552 handle to manage the file `file'.  It manages input if `mode'
 553 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
 554 and both input and output if mode is `ReadWriteMode'.
 555
 556 If the file does not exist and it is opened for output, it should be
 557 created as a new file.  If `mode' is `WriteMode' and the file
 558 already exists, then it should be truncated to zero length.  The
 559 handle is positioned at the end of the file if `mode' is
 560 `AppendMode', and otherwise at the beginning (in which case its
 561 internal position is 0).
 562
 563 Implementations should enforce, locally to the Haskell process,
 564 multiple-reader single-writer locking on files, which is to say that
 565 there may either be many handles on the same file which manage input,
 566 or just one handle on the file which manages output.  If any open or
 567 semi-closed handle is managing a file for output, no new handle can be
 568 allocated for that file.  If any open or semi-closed handle is
 569 managing a file for input, new handles can only be allocated if they
 570 do not manage output.
 571
 572 Two files are the same if they have the same absolute name.  An
 573 implementation is free to impose stricter conditions.
 574 -}
 575
 576 data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
 577                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 578
 579 data IOModeEx
 580  = BinaryMode IOMode
 581  | TextMode   IOMode
 582    deriving (Eq, Read, Show)
 583
 584 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
 585   = IOException (IOError h iot fun str (Just fp))
 586 addFilePathToIOError _   _  other_exception
 587   = other_exception
 588
 589 openFile :: FilePath -> IOMode -> IO Handle
 590 openFile fp im =
 591   catch
 592     (openFile' fp (if   dEFAULT_OPEN_IN_BINARY_MODE
 593                    then BinaryMode im
 594                    else TextMode im))
 595     (\e -> throw (addFilePathToIOError "openFile" fp e))
 596
 597 openFileEx :: FilePath -> IOModeEx -> IO Handle
 598 openFileEx fp m =
 599   catch
 600     (openFile' fp m)
 601     (\e -> throw (addFilePathToIOError "openFileEx" fp e))
 602
 603
 604 openFile' filepath ex_mode =
 605   withCString filepath $ \ f ->
 606
 607     let
 608       (mode, binary) =
 609         case ex_mode of
 610            BinaryMode bmo -> (bmo, True)
 611            TextMode   tmo -> (tmo, False)
 612
 613       oflags1 = case mode of
 614                   ReadMode      -> read_flags
 615                   WriteMode     -> write_flags
 616                   ReadWriteMode -> rw_flags
 617                   AppendMode    -> append_flags
 618
 619       binary_flags
 620 #ifdef HAVE_O_BINARY
 621           | binary    = o_BINARY
 622 #endif
 623           | otherwise = 0
 624
 625       oflags = oflags1 .|. binary_flags
 626     in do
 627
 628     -- the old implementation had a complicated series of three opens,
 629     -- which is perhaps because we have to be careful not to open
 630     -- directories.  However, the man pages I've read say that open()
 631     -- always returns EISDIR if the file is a directory and was opened
 632     -- for writing, so I think we're ok with a single open() here...
 633     fd <- fromIntegral `liftM`
 634               throwErrnoIfMinus1Retry "openFile"
 635                 (c_open f (fromIntegral oflags) 0o666)
 636
 637     openFd fd filepath mode binary
 638
 639
 640 std_flags    = o_NONBLOCK   .|. o_NOCTTY
 641 output_flags = std_flags    .|. o_CREAT
 642 read_flags   = std_flags    .|. o_RDONLY
 643 write_flags  = output_flags .|. o_WRONLY .|. o_TRUNC
 644 rw_flags     = output_flags .|. o_RDWR
 645 append_flags = output_flags .|. o_WRONLY .|. o_APPEND
 646
 647 -- ---------------------------------------------------------------------------
 648 -- openFd
 649
 650 openFd :: FD -> FilePath -> IOMode -> Bool -> IO Handle
 651 openFd fd filepath mode binary = do
 652     -- turn on non-blocking mode
 653     setNonBlockingFD fd
 654
 655     let (ha_type, write) =
 656           case mode of
 657             ReadMode      -> ( ReadHandle,      False )
 658             WriteMode     -> ( WriteHandle,     True )
 659             ReadWriteMode -> ( ReadWriteHandle, True )
 660             AppendMode    -> ( AppendHandle,    True )
 661
 662     -- open() won't tell us if it was a directory if we only opened for
 663     -- reading, so check again.
 664     fd_type <- fdType fd
 665     case fd_type of
 666         Directory ->
 667            ioException (IOError Nothing InappropriateType "openFile"
 668                            "is a directory" Nothing)
 669
 670         Stream
 671            | ReadWriteHandle <- ha_type -> mkDuplexHandle fd filepath binary
 672            | otherwise                  -> mkFileHandle fd filepath ha_type binary
 673
 674         -- regular files need to be locked
 675         RegularFile -> do
 676            r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
 677            when (r == -1)  $
 678                 ioException (IOError Nothing ResourceBusy "openFile"
 679                                    "file is locked" Nothing)
 680            mkFileHandle fd filepath ha_type binary
 681
 682
 683 foreign import "lockFile" unsafe
 684   lockFile :: CInt -> CInt -> CInt -> IO CInt
 685
 686 foreign import "unlockFile" unsafe
 687   unlockFile :: CInt -> IO CInt
 688
 689 mkFileHandle :: FD -> FilePath -> HandleType -> Bool -> IO Handle
 690 mkFileHandle fd filepath ha_type binary = do
 691   (buf, bmode) <- getBuffer fd (initBufferState ha_type)
 692   spares <- newIORef BufferListNil
 693   newFileHandle handleFinalizer
 694             (Handle__ { haFD = fd,
 695                         haType = ha_type,
 696                         haIsBin = binary,
 697                         haBufferMode = bmode,
 698                         haFilePath = filepath,
 699                         haBuffer = buf,
 700                         haBuffers = spares
 701                       })
 702
 703 mkDuplexHandle :: FD -> FilePath -> Bool -> IO Handle
 704 mkDuplexHandle fd filepath binary = do
 705   (w_buf, w_bmode) <- getBuffer fd WriteBuffer
 706   w_spares <- newIORef BufferListNil
 707   let w_handle_ =
 708              Handle__ { haFD = fd,
 709                         haType = WriteHandle,
 710                         haIsBin = binary,
 711                         haBufferMode = w_bmode,
 712                         haFilePath = filepath,
 713                         haBuffer = w_buf,
 714                         haBuffers = w_spares
 715                       }
 716   write_side <- newMVar w_handle_
 717
 718   (r_buf, r_bmode) <- getBuffer fd ReadBuffer
 719   r_spares <- newIORef BufferListNil
 720   let r_handle_ =
 721              Handle__ { haFD = fd,
 722                         haType = ReadSideHandle write_side,
 723                         haIsBin = binary,
 724                         haBufferMode = r_bmode,
 725                         haFilePath = filepath,
 726                         haBuffer = r_buf,
 727                         haBuffers = r_spares
 728                       }
 729   read_side <- newMVar r_handle_
 730
 731   addMVarFinalizer write_side (handleFinalizer write_side)
 732   return (DuplexHandle read_side write_side)
 733
 734
 735 initBufferState ReadHandle = ReadBuffer
 736 initBufferState _          = WriteBuffer
 737
 738 -- ---------------------------------------------------------------------------
 739 -- Closing a handle
 740
 741 -- Computation `hClose hdl' makes handle `hdl' closed.  Before the
 742 -- computation finishes, any items buffered for output and not already
 743 -- sent to the operating system are flushed as for `hFlush'.
 744
 745 -- For a duplex handle, we close&flush the write side, and just close
 746 -- the read side.
 747
 748 hClose :: Handle -> IO ()
 749 hClose h@(FileHandle m)     = hClose' h m
 750 hClose h@(DuplexHandle r w) = do
 751   hClose' h w
 752   withHandle__' "hClose" h r $ \ handle_ -> do
 753   return handle_{ haFD   = -1,
 754                   haType = ClosedHandle
 755                  }
 756
 757 hClose' h m =
 758   withHandle__' "hClose" h m $ \ handle_ -> do
 759   case haType handle_ of
 760       ClosedHandle -> return handle_
 761       _ -> do
 762           let fd = fromIntegral (haFD handle_)
 763           flushWriteBufferOnly handle_
 764           throwErrnoIfMinus1Retry_ "hClose" (c_close fd)
 765
 766           -- free the spare buffers
 767           writeIORef (haBuffers handle_) BufferListNil
 768
 769           -- unlock it
 770           unlockFile fd
 771
 772           -- we must set the fd to -1, because the finalizer is going
 773           -- to run eventually and try to close/unlock it.
 774           return (handle_{ haFD        = -1,
 775                            haType      = ClosedHandle
 776                          })
 777
 778 -----------------------------------------------------------------------------
 779 -- Detecting the size of a file
 780
 781 -- For a handle `hdl' which attached to a physical file, `hFileSize
 782 -- hdl' returns the size of `hdl' in terms of the number of items
 783 -- which can be read from `hdl'.
 784
 785 hFileSize :: Handle -> IO Integer
 786 hFileSize handle =
 787     withHandle_ "hFileSize" handle $ \ handle_ -> do
 788     case haType handle_ of
 789       ClosedHandle              -> ioe_closedHandle
 790       SemiClosedHandle          -> ioe_closedHandle
 791       _ -> do flushWriteBufferOnly handle_
 792               r <- fdFileSize (haFD handle_)
 793               if r /= -1
 794                  then return r
 795                  else ioException (IOError Nothing InappropriateType "hFileSize"
 796                                    "not a regular file" Nothing)
 797
 798 -- ---------------------------------------------------------------------------
 799 -- Detecting the End of Input
 800
 801 -- For a readable handle `hdl', `hIsEOF hdl' returns
 802 -- `True' if no further input can be taken from `hdl' or for a
 803 -- physical file, if the current I/O position is equal to the length of
 804 -- the file.  Otherwise, it returns `False'.
 805
 806 hIsEOF :: Handle -> IO Bool
 807 hIsEOF handle =
 808   catch
 809      (do hLookAhead handle; return False)
 810      (\e -> if isEOFError e then return True else throw e)
 811
 812 isEOF :: IO Bool
 813 isEOF = hIsEOF stdin
 814
 815 -- ---------------------------------------------------------------------------
 816 -- Looking ahead
 817
 818 -- hLookahead returns the next character from the handle without
 819 -- removing it from the input buffer, blocking until a character is
 820 -- available.
 821
 822 hLookAhead :: Handle -> IO Char
 823 hLookAhead handle = do
 824   wantReadableHandle "hLookAhead"  handle $ \handle_ -> do
 825   let ref     = haBuffer handle_
 826       fd      = haFD handle_
 827       is_line = haBufferMode handle_ == LineBuffering
 828   buf <- readIORef ref
 829
 830   -- fill up the read buffer if necessary
 831   new_buf <- if bufferEmpty buf
 832                 then fillReadBuffer fd is_line buf
 833                 else return buf
 834
 835   writeIORef ref new_buf
 836
 837   (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
 838   return c
 839
 840 -- ---------------------------------------------------------------------------
 841 -- Buffering Operations
 842
 843 -- Three kinds of buffering are supported: line-buffering,
 844 -- block-buffering or no-buffering.  See PrelIOBase for definition and
 845 -- further explanation of what the type represent.
 846
 847 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
 848 -- handle hdl on subsequent reads and writes.
 849 --
 850 --   * If mode is LineBuffering, line-buffering should be enabled if possible.
 851 --
 852 --   * If mode is `BlockBuffering size', then block-buffering
 853 --     should be enabled if possible.  The size of the buffer is n items
 854 --     if size is `Just n' and is otherwise implementation-dependent.
 855 --
 856 --   * If mode is NoBuffering, then buffering is disabled if possible.
 857
 858 -- If the buffer mode is changed from BlockBuffering or
 859 -- LineBuffering to NoBuffering, then any items in the output
 860 -- buffer are written to the device, and any items in the input buffer
 861 -- are discarded.  The default buffering mode when a handle is opened
 862 -- is implementation-dependent and may depend on the object which is
 863 -- attached to that handle.
 864
 865 hSetBuffering :: Handle -> BufferMode -> IO ()
 866 hSetBuffering handle mode =
 867   withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
 868   case haType handle_ of
 869     ClosedHandle -> ioe_closedHandle
 870     _ -> do
 871          {- Note:
 872             - we flush the old buffer regardless of whether
 873               the new buffer could fit the contents of the old buffer
 874               or not.
 875             - allow a handle's buffering to change even if IO has
 876               occurred (ANSI C spec. does not allow this, nor did
 877               the previous implementation of IO.hSetBuffering).
 878             - a non-standard extension is to allow the buffering
 879               of semi-closed handles to change [sof 6/98]
 880           -}
 881           flushBuffer handle_
 882
 883           let state = initBufferState (haType handle_)
 884           new_buf <-
 885             case mode of
 886                 -- we always have a 1-character read buffer for
 887                 -- unbuffered  handles: it's needed to
 888                 -- support hLookAhead.
 889               NoBuffering            -> allocateBuffer 1 ReadBuffer
 890               LineBuffering          -> allocateBuffer dEFAULT_BUFFER_SIZE state
 891               BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
 892               BlockBuffering (Just n) | n <= 0    -> ioe_bufsiz n
 893                                       | otherwise -> allocateBuffer n state
 894           writeIORef (haBuffer handle_) new_buf
 895
 896           -- for input terminals we need to put the terminal into
 897           -- cooked or raw mode depending on the type of buffering.
 898           is_tty <- fdIsTTY (haFD handle_)
 899           when (is_tty && isReadableHandleType (haType handle_)) $
 900                 case mode of
 901                   NoBuffering -> setCooked (haFD handle_) False
 902                   _           -> setCooked (haFD handle_) True
 903
 904           -- throw away spare buffers, they might be the wrong size
 905           writeIORef (haBuffers handle_) BufferListNil
 906
 907           return (handle_{ haBufferMode = mode })
 908
 909 -- -----------------------------------------------------------------------------
 910 -- hFlush
 911
 912 -- The action `hFlush hdl' causes any items buffered for output
 913 -- in handle `hdl' to be sent immediately to the operating
 914 -- system.
 915
 916 hFlush :: Handle -> IO ()
 917 hFlush handle =
 918    wantWritableHandle "hFlush" handle $ \ handle_ -> do
 919    buf <- readIORef (haBuffer handle_)
 920    if bufferIsWritable buf && not (bufferEmpty buf)
 921         then do flushed_buf <- flushWriteBuffer (haFD handle_) buf
 922                 writeIORef (haBuffer handle_) flushed_buf
 923         else return ()
 924
 925
 926 -- -----------------------------------------------------------------------------
 927 -- Repositioning Handles
 928
 929 data HandlePosn = HandlePosn Handle HandlePosition
 930
 931 instance Eq HandlePosn where
 932     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 933
 934   -- HandlePosition is the Haskell equivalent of POSIX' off_t.
 935   -- We represent it as an Integer on the Haskell side, but
 936   -- cheat slightly in that hGetPosn calls upon a C helper
 937   -- that reports the position back via (merely) an Int.
 938 type HandlePosition = Integer
 939
 940 -- Computation `hGetPosn hdl' returns the current I/O position of
 941 -- `hdl' as an abstract position.  Computation `hSetPosn p' sets the
 942 -- position of `hdl' to a previously obtained position `p'.
 943
 944 hGetPosn :: Handle -> IO HandlePosn
 945 hGetPosn handle =
 946     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
 947
 948 #if defined(_WIN32)
 949         -- urgh, on Windows we have to worry about \n -> \r\n translation,
 950         -- so we can't easily calculate the file position using the
 951         -- current buffer size.  Just flush instead.
 952       flushBuffer handle_
 953 #endif
 954       let fd = fromIntegral (haFD handle_)
 955       posn <- fromIntegral `liftM`
 956                 throwErrnoIfMinus1Retry "hGetPosn"
 957                    (c_lseek fd 0 (#const SEEK_CUR))
 958
 959       let ref = haBuffer handle_
 960       buf <- readIORef ref
 961
 962       let real_posn
 963            | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
 964            | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
 965 #     ifdef DEBUG_DUMP
 966       puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
 967       puts ("   (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
 968 #     endif
 969       return (HandlePosn handle real_posn)
 970
 971
 972 hSetPosn :: HandlePosn -> IO ()
 973 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
 974
 975 -- ---------------------------------------------------------------------------
 976 -- hSeek
 977
 978 {-
 979 The action `hSeek hdl mode i' sets the position of handle
 980 `hdl' depending on `mode'.  If `mode' is
 981
 982  * AbsoluteSeek - The position of `hdl' is set to `i'.
 983  * RelativeSeek - The position of `hdl' is set to offset `i' from
 984                   the current position.
 985  * SeekFromEnd  - The position of `hdl' is set to offset `i' from
 986                   the end of the file.
 987
 988 Some handles may not be seekable (see `hIsSeekable'), or only
 989 support a subset of the possible positioning operations (e.g. it may
 990 only be possible to seek to the end of a tape, or to a positive
 991 offset from the beginning or current position).
 992
 993 It is not possible to set a negative I/O position, or for a physical
 994 file, an I/O position beyond the current end-of-file.
 995
 996 Note:
 997  - when seeking using `SeekFromEnd', positive offsets (>=0) means
 998    seeking at or past EOF.
 999
1000  - we possibly deviate from the report on the issue of seeking within
1001    the buffer and whether to flush it or not.  The report isn't exactly
1002    clear here.
1003 -}
1004
1005 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
1006                     deriving (Eq, Ord, Ix, Enum, Read, Show)
1007
1008 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1009 hSeek handle mode offset =
1010     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1011 #   ifdef DEBUG_DUMP
1012     puts ("hSeek " ++ show (mode,offset) ++ "\n")
1013 #   endif
1014     let ref = haBuffer handle_
1015     buf <- readIORef ref
1016     let r = bufRPtr buf
1017         w = bufWPtr buf
1018         fd = haFD handle_
1019
1020     let do_seek =
1021           throwErrnoIfMinus1Retry_ "hSeek"
1022             (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1023
1024         whence :: CInt
1025         whence = case mode of
1026                    AbsoluteSeek -> (#const SEEK_SET)
1027                    RelativeSeek -> (#const SEEK_CUR)
1028                    SeekFromEnd  -> (#const SEEK_END)
1029
1030     if bufferIsWritable buf
1031         then do new_buf <- flushWriteBuffer fd buf
1032                 writeIORef ref new_buf
1033                 do_seek
1034         else do
1035
1036     if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1037         then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1038         else do
1039
1040     new_buf <- flushReadBuffer (haFD handle_) buf
1041     writeIORef ref new_buf
1042     do_seek
1043
1044 -- -----------------------------------------------------------------------------
1045 -- Handle Properties
1046
1047 -- A number of operations return information about the properties of a
1048 -- handle.  Each of these operations returns `True' if the handle has
1049 -- the specified property, and `False' otherwise.
1050
1051 hIsOpen :: Handle -> IO Bool
1052 hIsOpen handle =
1053     withHandle_ "hIsOpen" handle $ \ handle_ -> do
1054     case haType handle_ of
1055       ClosedHandle         -> return False
1056       SemiClosedHandle     -> return False
1057       _                    -> return True
1058
1059 hIsClosed :: Handle -> IO Bool
1060 hIsClosed handle =
1061     withHandle_ "hIsClosed" handle $ \ handle_ -> do
1062     case haType handle_ of
1063       ClosedHandle         -> return True
1064       _                    -> return False
1065
1066 {- not defined, nor exported, but mentioned
1067    here for documentation purposes:
1068
1069     hSemiClosed :: Handle -> IO Bool
1070     hSemiClosed h = do
1071        ho <- hIsOpen h
1072        hc <- hIsClosed h
1073        return (not (ho || hc))
1074 -}
1075
1076 hIsReadable :: Handle -> IO Bool
1077 hIsReadable (DuplexHandle _ _) = return True
1078 hIsReadable handle =
1079     withHandle_ "hIsReadable" handle $ \ handle_ -> do
1080     case haType handle_ of
1081       ClosedHandle         -> ioe_closedHandle
1082       SemiClosedHandle     -> ioe_closedHandle
1083       htype                -> return (isReadableHandleType htype)
1084
1085 hIsWritable :: Handle -> IO Bool
1086 hIsWritable (DuplexHandle _ _) = return False
1087 hIsWritable handle =
1088     withHandle_ "hIsWritable" handle $ \ handle_ -> do
1089     case haType handle_ of
1090       ClosedHandle         -> ioe_closedHandle
1091       SemiClosedHandle     -> ioe_closedHandle
1092       htype                -> return (isWritableHandleType htype)
1093
1094 -- Querying how a handle buffers its data:
1095
1096 hGetBuffering :: Handle -> IO BufferMode
1097 hGetBuffering handle =
1098     withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1099     case haType handle_ of
1100       ClosedHandle         -> ioe_closedHandle
1101       _ ->
1102            -- We're being non-standard here, and allow the buffering
1103            -- of a semi-closed handle to be queried.   -- sof 6/98
1104           return (haBufferMode handle_)  -- could be stricter..
1105
1106 hIsSeekable :: Handle -> IO Bool
1107 hIsSeekable handle =
1108     withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1109     case haType handle_ of
1110       ClosedHandle         -> ioe_closedHandle
1111       SemiClosedHandle     -> ioe_closedHandle
1112       AppendHandle         -> return False
1113       _                    -> do t <- fdType (haFD handle_)
1114                                  return (t == RegularFile && haIsBin handle_)
1115
1116 -- -----------------------------------------------------------------------------
1117 -- Changing echo status
1118
1119 -- Non-standard GHC extension is to allow the echoing status
1120 -- of a handles connected to terminals to be reconfigured:
1121
1122 hSetEcho :: Handle -> Bool -> IO ()
1123 hSetEcho handle on = do
1124     isT   <- hIsTerminalDevice handle
1125     if not isT
1126      then return ()
1127      else
1128       withHandle_ "hSetEcho" handle $ \ handle_ -> do
1129       case haType handle_ of
1130          ClosedHandle -> ioe_closedHandle
1131          _            -> setEcho (haFD handle_) on
1132
1133 hGetEcho :: Handle -> IO Bool
1134 hGetEcho handle = do
1135     isT   <- hIsTerminalDevice handle
1136     if not isT
1137      then return False
1138      else
1139        withHandle_ "hGetEcho" handle $ \ handle_ -> do
1140        case haType handle_ of
1141          ClosedHandle -> ioe_closedHandle
1142          _            -> getEcho (haFD handle_)
1143
1144 hIsTerminalDevice :: Handle -> IO Bool
1145 hIsTerminalDevice handle = do
1146     withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1147      case haType handle_ of
1148        ClosedHandle -> ioe_closedHandle
1149        _            -> fdIsTTY (haFD handle_)
1150
1151 -- -----------------------------------------------------------------------------
1152 -- hSetBinaryMode
1153
1154 #ifdef _WIN32
1155 hSetBinaryMode handle bin =
1156   withHandle "hSetBinaryMode" handle $ \ handle_ ->
1157     do let flg | bin       = (#const O_BINARY)
1158                | otherwise = (#const O_TEXT)
1159        throwErrnoIfMinus1_ "hSetBinaryMode"
1160           (setmode (fromIntegral (haFD handle_)) flg)
1161        return (handle_{haIsBin=bin}, ())
1162
1163 foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
1164 #else
1165 hSetBinaryMode handle bin =
1166   withHandle "hSetBinaryMode" handle $ \ handle_ ->
1167     return (handle_{haIsBin=bin}, ())
1168 #endif
1169
1170 -- -----------------------------------------------------------------------------
1171 -- Miscellaneous
1172
1173 -- These three functions are meant to get things out of an IOError.
1174
1175 ioeGetFileName        :: IOError -> Maybe FilePath
1176 ioeGetErrorString     :: IOError -> String
1177 ioeGetHandle          :: IOError -> Maybe Handle
1178
1179 ioeGetHandle (IOException (IOError h _ _ _ _)) = h
1180 ioeGetHandle (UserError _) = Nothing
1181 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
1182
1183 ioeGetErrorString (IOException (IOError _ iot _ _ _)) = show iot
1184 ioeGetErrorString (UserError str) = str
1185 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
1186
1187 ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
1188 ioeGetFileName (UserError _) = Nothing
1189 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
1190
1191 -- ---------------------------------------------------------------------------
1192 -- debugging
1193
1194 #ifdef DEBUG_DUMP
1195 puts :: String -> IO ()
1196 puts s = withCString s $ \cstr -> do c_write 1 cstr (fromIntegral (length s))
1197                                      return ()
1198 #endif