GHC/Handle.hsc

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