GHC/Handle.hsc

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2
   3 #undef DEBUG_DUMP
   4 #undef DEBUG
   5
   6 -- -----------------------------------------------------------------------------
   7 -- $Id: Handle.hsc,v 1.6 2001/09/14 11:25:24 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
 430
 431 fillReadBuffer :: FD -> Bool -> Buffer -> IO Buffer
 432 fillReadBuffer fd is_line
 433       buf@Buffer{ bufBuf=b, bufRPtr=r, bufWPtr=w, bufSize=size } =
 434   -- buffer better be empty:
 435   assert (r == 0 && w == 0) $ do
 436   fillReadBufferLoop fd is_line buf b w size
 437
 438 -- For a line buffer, we just get the first chunk of data to arrive,
 439 -- and don't wait for the whole buffer to be full (but we *do* wait
 440 -- until some data arrives).  This isn't really line buffering, but it
 441 -- appears to be what GHC has done for a long time, and I suspect it
 442 -- is more useful than line buffering in most cases.
 443
 444 fillReadBufferLoop fd is_line buf b w size = do
 445   let bytes = size - w
 446   if bytes == 0  -- buffer full?
 447      then return buf{ bufRPtr=0, bufWPtr=w }
 448      else do
 449 #ifdef DEBUG_DUMP
 450   puts ("fillReadBufferLoop: bytes = " ++ show bytes ++ "\n")
 451 #endif
 452   res <- throwErrnoIfMinus1RetryMayBlock "fillReadBuffer"
 453             (read_off fd b (fromIntegral w) (fromIntegral bytes))
 454             (threadWaitRead fd)
 455   let res' = fromIntegral res
 456 #ifdef DEBUG_DUMP
 457   puts ("fillReadBufferLoop:  res' = " ++ show res' ++ "\n")
 458 #endif
 459   if res' == 0
 460      then if w == 0
 461              then ioe_EOF
 462              else return buf{ bufRPtr=0, bufWPtr=w }
 463      else if res' < bytes && not is_line
 464              then fillReadBufferLoop fd is_line buf b (w+res') size
 465              else return buf{ bufRPtr=0, bufWPtr=w+res' }
 466
 467 foreign import "read_wrap" unsafe
 468    read_off :: FD -> RawBuffer -> Int -> CInt -> IO CInt
 469
 470 -- ---------------------------------------------------------------------------
 471 -- Standard Handles
 472
 473 -- Three handles are allocated during program initialisation.  The first
 474 -- two manage input or output from the Haskell program's standard input
 475 -- or output channel respectively.  The third manages output to the
 476 -- standard error channel. These handles are initially open.
 477
 478 fd_stdin  = 0 :: FD
 479 fd_stdout = 1 :: FD
 480 fd_stderr = 2 :: FD
 481
 482 stdin :: Handle
 483 stdin = unsafePerformIO $ do
 484    -- ToDo: acquire lock
 485    setNonBlockingFD fd_stdin
 486    (buf, bmode) <- getBuffer fd_stdin ReadBuffer
 487    spares <- newIORef BufferListNil
 488    newFileHandle stdHandleFinalizer
 489             (Handle__ { haFD = fd_stdin,
 490                         haType = ReadHandle,
 491                         haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
 492                         haBufferMode = bmode,
 493                         haFilePath = "<stdin>",
 494                         haBuffer = buf,
 495                         haBuffers = spares
 496                       })
 497
 498 stdout :: Handle
 499 stdout = unsafePerformIO $ do
 500    -- ToDo: acquire lock
 501    -- We don't set non-blocking mode on stdout or sterr, because
 502    -- some shells don't recover properly.
 503    -- setNonBlockingFD fd_stdout
 504    (buf, bmode) <- getBuffer fd_stdout WriteBuffer
 505    spares <- newIORef BufferListNil
 506    newFileHandle stdHandleFinalizer
 507             (Handle__ { haFD = fd_stdout,
 508                         haType = WriteHandle,
 509                         haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
 510                         haBufferMode = bmode,
 511                         haFilePath = "<stdout>",
 512                         haBuffer = buf,
 513                         haBuffers = spares
 514                       })
 515
 516 stderr :: Handle
 517 stderr = unsafePerformIO $ do
 518     -- ToDo: acquire lock
 519    -- We don't set non-blocking mode on stdout or sterr, because
 520    -- some shells don't recover properly.
 521    -- setNonBlockingFD fd_stderr
 522    buffer <- mkUnBuffer
 523    spares <- newIORef BufferListNil
 524    newFileHandle stdHandleFinalizer
 525             (Handle__ { haFD = fd_stderr,
 526                         haType = WriteHandle,
 527                         haIsBin = dEFAULT_OPEN_IN_BINARY_MODE,
 528                         haBufferMode = NoBuffering,
 529                         haFilePath = "<stderr>",
 530                         haBuffer = buffer,
 531                         haBuffers = spares
 532                       })
 533
 534 -- ---------------------------------------------------------------------------
 535 -- Opening and Closing Files
 536
 537 {-
 538 Computation `openFile file mode' allocates and returns a new, open
 539 handle to manage the file `file'.  It manages input if `mode'
 540 is `ReadMode', output if `mode' is `WriteMode' or `AppendMode',
 541 and both input and output if mode is `ReadWriteMode'.
 542
 543 If the file does not exist and it is opened for output, it should be
 544 created as a new file.  If `mode' is `WriteMode' and the file
 545 already exists, then it should be truncated to zero length.  The
 546 handle is positioned at the end of the file if `mode' is
 547 `AppendMode', and otherwise at the beginning (in which case its
 548 internal position is 0).
 549
 550 Implementations should enforce, locally to the Haskell process,
 551 multiple-reader single-writer locking on files, which is to say that
 552 there may either be many handles on the same file which manage input,
 553 or just one handle on the file which manages output.  If any open or
 554 semi-closed handle is managing a file for output, no new handle can be
 555 allocated for that file.  If any open or semi-closed handle is
 556 managing a file for input, new handles can only be allocated if they
 557 do not manage output.
 558
 559 Two files are the same if they have the same absolute name.  An
 560 implementation is free to impose stricter conditions.
 561 -}
 562
 563 data IOMode      =  ReadMode | WriteMode | AppendMode | ReadWriteMode
 564                     deriving (Eq, Ord, Ix, Enum, Read, Show)
 565
 566 data IOModeEx
 567  = BinaryMode IOMode
 568  | TextMode   IOMode
 569    deriving (Eq, Read, Show)
 570
 571 addFilePathToIOError fun fp (IOException (IOError h iot _ str _))
 572   = IOException (IOError h iot fun str (Just fp))
 573 addFilePathToIOError _   _  other_exception
 574   = other_exception
 575
 576 openFile :: FilePath -> IOMode -> IO Handle
 577 openFile fp im =
 578   catch
 579     (openFile' fp (if   dEFAULT_OPEN_IN_BINARY_MODE
 580                    then BinaryMode im
 581                    else TextMode im))
 582     (\e -> throw (addFilePathToIOError "openFile" fp e))
 583
 584 openFileEx :: FilePath -> IOModeEx -> IO Handle
 585 openFileEx fp m =
 586   catch
 587     (openFile' fp m)
 588     (\e -> throw (addFilePathToIOError "openFileEx" fp e))
 589
 590
 591 openFile' filepath ex_mode =
 592   withCString filepath $ \ f ->
 593
 594     let
 595       (mode, binary) =
 596         case ex_mode of
 597            BinaryMode bmo -> (bmo, True)
 598            TextMode   tmo -> (tmo, False)
 599
 600       oflags1 = case mode of
 601                   ReadMode      -> read_flags
 602                   WriteMode     -> write_flags
 603                   ReadWriteMode -> rw_flags
 604                   AppendMode    -> append_flags
 605
 606       truncate | WriteMode <- mode = True
 607                | otherwise         = False
 608
 609       binary_flags
 610 #ifdef HAVE_O_BINARY
 611           | binary    = o_BINARY
 612 #endif
 613           | otherwise = 0
 614
 615       oflags = oflags1 .|. binary_flags
 616     in do
 617
 618     -- the old implementation had a complicated series of three opens,
 619     -- which is perhaps because we have to be careful not to open
 620     -- directories.  However, the man pages I've read say that open()
 621     -- always returns EISDIR if the file is a directory and was opened
 622     -- for writing, so I think we're ok with a single open() here...
 623     fd <- fromIntegral `liftM`
 624               throwErrnoIfMinus1Retry "openFile"
 625                 (c_open f (fromIntegral oflags) 0o666)
 626
 627     openFd fd filepath mode binary truncate
 628         -- ASSERT: if we just created the file, then openFd won't fail
 629         -- (so we don't need to worry about removing the newly created file
 630         --  in the event of an error).
 631
 632
 633 std_flags    = o_NONBLOCK   .|. o_NOCTTY
 634 output_flags = std_flags    .|. o_CREAT
 635 read_flags   = std_flags    .|. o_RDONLY
 636 write_flags  = output_flags .|. o_WRONLY
 637 rw_flags     = output_flags .|. o_RDWR
 638 append_flags = write_flags  .|. o_APPEND
 639
 640 -- ---------------------------------------------------------------------------
 641 -- openFd
 642
 643 openFd :: FD -> FilePath -> IOMode -> Bool -> Bool -> IO Handle
 644 openFd fd filepath mode binary truncate = do
 645     -- turn on non-blocking mode
 646     setNonBlockingFD fd
 647
 648     let (ha_type, write) =
 649           case mode of
 650             ReadMode      -> ( ReadHandle,      False )
 651             WriteMode     -> ( WriteHandle,     True )
 652             ReadWriteMode -> ( ReadWriteHandle, True )
 653             AppendMode    -> ( AppendHandle,    True )
 654
 655     -- open() won't tell us if it was a directory if we only opened for
 656     -- reading, so check again.
 657     fd_type <- fdType fd
 658     case fd_type of
 659         Directory ->
 660            ioException (IOError Nothing InappropriateType "openFile"
 661                            "is a directory" Nothing)
 662
 663         Stream
 664            | ReadWriteHandle <- ha_type -> mkDuplexHandle fd filepath binary
 665            | otherwise                  -> mkFileHandle fd filepath ha_type binary
 666
 667         -- regular files need to be locked
 668         RegularFile -> do
 669            r <- lockFile (fromIntegral fd) (fromBool write) 1{-exclusive-}
 670            when (r == -1)  $
 671                 ioException (IOError Nothing ResourceBusy "openFile"
 672                                    "file is locked" Nothing)
 673
 674            -- truncate the file if necessary
 675            when truncate (fileTruncate filepath)
 676
 677            mkFileHandle fd filepath ha_type binary
 678
 679
 680 foreign import "lockFile" unsafe
 681   lockFile :: CInt -> CInt -> CInt -> IO CInt
 682
 683 foreign import "unlockFile" unsafe
 684   unlockFile :: CInt -> IO CInt
 685
 686 mkFileHandle :: FD -> FilePath -> HandleType -> Bool -> IO Handle
 687 mkFileHandle fd filepath ha_type binary = do
 688   (buf, bmode) <- getBuffer fd (initBufferState ha_type)
 689   spares <- newIORef BufferListNil
 690   newFileHandle handleFinalizer
 691             (Handle__ { haFD = fd,
 692                         haType = ha_type,
 693                         haIsBin = binary,
 694                         haBufferMode = bmode,
 695                         haFilePath = filepath,
 696                         haBuffer = buf,
 697                         haBuffers = spares
 698                       })
 699
 700 mkDuplexHandle :: FD -> FilePath -> Bool -> IO Handle
 701 mkDuplexHandle fd filepath binary = do
 702   (w_buf, w_bmode) <- getBuffer fd WriteBuffer
 703   w_spares <- newIORef BufferListNil
 704   let w_handle_ =
 705              Handle__ { haFD = fd,
 706                         haType = WriteHandle,
 707                         haIsBin = binary,
 708                         haBufferMode = w_bmode,
 709                         haFilePath = filepath,
 710                         haBuffer = w_buf,
 711                         haBuffers = w_spares
 712                       }
 713   write_side <- newMVar w_handle_
 714
 715   (r_buf, r_bmode) <- getBuffer fd ReadBuffer
 716   r_spares <- newIORef BufferListNil
 717   let r_handle_ =
 718              Handle__ { haFD = fd,
 719                         haType = ReadSideHandle write_side,
 720                         haIsBin = binary,
 721                         haBufferMode = r_bmode,
 722                         haFilePath = filepath,
 723                         haBuffer = r_buf,
 724                         haBuffers = r_spares
 725                       }
 726   read_side <- newMVar r_handle_
 727
 728   addMVarFinalizer write_side (handleFinalizer write_side)
 729   return (DuplexHandle read_side write_side)
 730
 731
 732 initBufferState ReadHandle = ReadBuffer
 733 initBufferState _          = WriteBuffer
 734
 735 -- ---------------------------------------------------------------------------
 736 -- Closing a handle
 737
 738 -- Computation `hClose hdl' makes handle `hdl' closed.  Before the
 739 -- computation finishes, any items buffered for output and not already
 740 -- sent to the operating system are flushed as for `hFlush'.
 741
 742 -- For a duplex handle, we close&flush the write side, and just close
 743 -- the read side.
 744
 745 hClose :: Handle -> IO ()
 746 hClose h@(FileHandle m)     = hClose' h m
 747 hClose h@(DuplexHandle r w) = do
 748   hClose' h w
 749   withHandle__' "hClose" h r $ \ handle_ -> do
 750   return handle_{ haFD   = -1,
 751                   haType = ClosedHandle
 752                  }
 753
 754 hClose' h m = withHandle__' "hClose" h m $ hClose_help
 755
 756 hClose_help handle_ =
 757   case haType handle_ of
 758       ClosedHandle -> return handle_
 759       _ -> do
 760           let fd = fromIntegral (haFD handle_)
 761           flushWriteBufferOnly handle_
 762           throwErrnoIfMinus1Retry_ "hClose" (c_close fd)
 763
 764           -- free the spare buffers
 765           writeIORef (haBuffers handle_) BufferListNil
 766
 767           -- unlock it
 768           unlockFile fd
 769
 770           -- we must set the fd to -1, because the finalizer is going
 771           -- to run eventually and try to close/unlock it.
 772           return (handle_{ haFD        = -1,
 773                            haType      = ClosedHandle
 774                          })
 775
 776 -----------------------------------------------------------------------------
 777 -- Detecting the size of a file
 778
 779 -- For a handle `hdl' which attached to a physical file, `hFileSize
 780 -- hdl' returns the size of `hdl' in terms of the number of items
 781 -- which can be read from `hdl'.
 782
 783 hFileSize :: Handle -> IO Integer
 784 hFileSize handle =
 785     withHandle_ "hFileSize" handle $ \ handle_ -> do
 786     case haType handle_ of
 787       ClosedHandle              -> ioe_closedHandle
 788       SemiClosedHandle          -> ioe_closedHandle
 789       _ -> do flushWriteBufferOnly handle_
 790               r <- fdFileSize (haFD handle_)
 791               if r /= -1
 792                  then return r
 793                  else ioException (IOError Nothing InappropriateType "hFileSize"
 794                                    "not a regular file" Nothing)
 795
 796 -- ---------------------------------------------------------------------------
 797 -- Detecting the End of Input
 798
 799 -- For a readable handle `hdl', `hIsEOF hdl' returns
 800 -- `True' if no further input can be taken from `hdl' or for a
 801 -- physical file, if the current I/O position is equal to the length of
 802 -- the file.  Otherwise, it returns `False'.
 803
 804 hIsEOF :: Handle -> IO Bool
 805 hIsEOF handle =
 806   catch
 807      (do hLookAhead handle; return False)
 808      (\e -> if isEOFError e then return True else throw e)
 809
 810 isEOF :: IO Bool
 811 isEOF = hIsEOF stdin
 812
 813 -- ---------------------------------------------------------------------------
 814 -- Looking ahead
 815
 816 -- hLookahead returns the next character from the handle without
 817 -- removing it from the input buffer, blocking until a character is
 818 -- available.
 819
 820 hLookAhead :: Handle -> IO Char
 821 hLookAhead handle = do
 822   wantReadableHandle "hLookAhead"  handle $ \handle_ -> do
 823   let ref     = haBuffer handle_
 824       fd      = haFD handle_
 825       is_line = haBufferMode handle_ == LineBuffering
 826   buf <- readIORef ref
 827
 828   -- fill up the read buffer if necessary
 829   new_buf <- if bufferEmpty buf
 830                 then fillReadBuffer fd is_line buf
 831                 else return buf
 832
 833   writeIORef ref new_buf
 834
 835   (c,_) <- readCharFromBuffer (bufBuf buf) (bufRPtr buf)
 836   return c
 837
 838 -- ---------------------------------------------------------------------------
 839 -- Buffering Operations
 840
 841 -- Three kinds of buffering are supported: line-buffering,
 842 -- block-buffering or no-buffering.  See GHC.IOBase for definition and
 843 -- further explanation of what the type represent.
 844
 845 -- Computation `hSetBuffering hdl mode' sets the mode of buffering for
 846 -- handle hdl on subsequent reads and writes.
 847 --
 848 --   * If mode is LineBuffering, line-buffering should be enabled if possible.
 849 --
 850 --   * If mode is `BlockBuffering size', then block-buffering
 851 --     should be enabled if possible.  The size of the buffer is n items
 852 --     if size is `Just n' and is otherwise implementation-dependent.
 853 --
 854 --   * If mode is NoBuffering, then buffering is disabled if possible.
 855
 856 -- If the buffer mode is changed from BlockBuffering or
 857 -- LineBuffering to NoBuffering, then any items in the output
 858 -- buffer are written to the device, and any items in the input buffer
 859 -- are discarded.  The default buffering mode when a handle is opened
 860 -- is implementation-dependent and may depend on the object which is
 861 -- attached to that handle.
 862
 863 hSetBuffering :: Handle -> BufferMode -> IO ()
 864 hSetBuffering handle mode =
 865   withAllHandles__ "hSetBuffering" handle $ \ handle_ -> do
 866   case haType handle_ of
 867     ClosedHandle -> ioe_closedHandle
 868     _ -> do
 869          {- Note:
 870             - we flush the old buffer regardless of whether
 871               the new buffer could fit the contents of the old buffer
 872               or not.
 873             - allow a handle's buffering to change even if IO has
 874               occurred (ANSI C spec. does not allow this, nor did
 875               the previous implementation of IO.hSetBuffering).
 876             - a non-standard extension is to allow the buffering
 877               of semi-closed handles to change [sof 6/98]
 878           -}
 879           flushBuffer handle_
 880
 881           let state = initBufferState (haType handle_)
 882           new_buf <-
 883             case mode of
 884                 -- we always have a 1-character read buffer for
 885                 -- unbuffered  handles: it's needed to
 886                 -- support hLookAhead.
 887               NoBuffering            -> allocateBuffer 1 ReadBuffer
 888               LineBuffering          -> allocateBuffer dEFAULT_BUFFER_SIZE state
 889               BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
 890               BlockBuffering (Just n) | n <= 0    -> ioe_bufsiz n
 891                                       | otherwise -> allocateBuffer n state
 892           writeIORef (haBuffer handle_) new_buf
 893
 894           -- for input terminals we need to put the terminal into
 895           -- cooked or raw mode depending on the type of buffering.
 896           is_tty <- fdIsTTY (haFD handle_)
 897           when (is_tty && isReadableHandleType (haType handle_)) $
 898                 case mode of
 899                   NoBuffering -> setCooked (haFD handle_) False
 900                   _           -> setCooked (haFD handle_) True
 901
 902           -- throw away spare buffers, they might be the wrong size
 903           writeIORef (haBuffers handle_) BufferListNil
 904
 905           return (handle_{ haBufferMode = mode })
 906
 907 -- -----------------------------------------------------------------------------
 908 -- hFlush
 909
 910 -- The action `hFlush hdl' causes any items buffered for output
 911 -- in handle `hdl' to be sent immediately to the operating
 912 -- system.
 913
 914 hFlush :: Handle -> IO ()
 915 hFlush handle =
 916    wantWritableHandle "hFlush" handle $ \ handle_ -> do
 917    buf <- readIORef (haBuffer handle_)
 918    if bufferIsWritable buf && not (bufferEmpty buf)
 919         then do flushed_buf <- flushWriteBuffer (haFD handle_) buf
 920                 writeIORef (haBuffer handle_) flushed_buf
 921         else return ()
 922
 923
 924 -- -----------------------------------------------------------------------------
 925 -- Repositioning Handles
 926
 927 data HandlePosn = HandlePosn Handle HandlePosition
 928
 929 instance Eq HandlePosn where
 930     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 931
 932   -- HandlePosition is the Haskell equivalent of POSIX' off_t.
 933   -- We represent it as an Integer on the Haskell side, but
 934   -- cheat slightly in that hGetPosn calls upon a C helper
 935   -- that reports the position back via (merely) an Int.
 936 type HandlePosition = Integer
 937
 938 -- Computation `hGetPosn hdl' returns the current I/O position of
 939 -- `hdl' as an abstract position.  Computation `hSetPosn p' sets the
 940 -- position of `hdl' to a previously obtained position `p'.
 941
 942 hGetPosn :: Handle -> IO HandlePosn
 943 hGetPosn handle =
 944     wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
 945
 946 #if defined(_WIN32)
 947         -- urgh, on Windows we have to worry about \n -> \r\n translation,
 948         -- so we can't easily calculate the file position using the
 949         -- current buffer size.  Just flush instead.
 950       flushBuffer handle_
 951 #endif
 952       let fd = fromIntegral (haFD handle_)
 953       posn <- fromIntegral `liftM`
 954                 throwErrnoIfMinus1Retry "hGetPosn"
 955                    (c_lseek fd 0 (#const SEEK_CUR))
 956
 957       let ref = haBuffer handle_
 958       buf <- readIORef ref
 959
 960       let real_posn
 961            | bufferIsWritable buf = posn + fromIntegral (bufWPtr buf)
 962            | otherwise = posn - fromIntegral (bufWPtr buf - bufRPtr buf)
 963 #     ifdef DEBUG_DUMP
 964       puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
 965       puts ("   (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
 966 #     endif
 967       return (HandlePosn handle real_posn)
 968
 969
 970 hSetPosn :: HandlePosn -> IO ()
 971 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
 972
 973 -- ---------------------------------------------------------------------------
 974 -- hSeek
 975
 976 {-
 977 The action `hSeek hdl mode i' sets the position of handle
 978 `hdl' depending on `mode'.  If `mode' is
 979
 980  * AbsoluteSeek - The position of `hdl' is set to `i'.
 981  * RelativeSeek - The position of `hdl' is set to offset `i' from
 982                   the current position.
 983  * SeekFromEnd  - The position of `hdl' is set to offset `i' from
 984                   the end of the file.
 985
 986 Some handles may not be seekable (see `hIsSeekable'), or only
 987 support a subset of the possible positioning operations (e.g. it may
 988 only be possible to seek to the end of a tape, or to a positive
 989 offset from the beginning or current position).
 990
 991 It is not possible to set a negative I/O position, or for a physical
 992 file, an I/O position beyond the current end-of-file.
 993
 994 Note:
 995  - when seeking using `SeekFromEnd', positive offsets (>=0) means
 996    seeking at or past EOF.
 997
 998  - we possibly deviate from the report on the issue of seeking within
 999    the buffer and whether to flush it or not.  The report isn't exactly
1000    clear here.
1001 -}
1002
1003 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
1004                     deriving (Eq, Ord, Ix, Enum, Read, Show)
1005
1006 hSeek :: Handle -> SeekMode -> Integer -> IO ()
1007 hSeek handle mode offset =
1008     wantSeekableHandle "hSeek" handle $ \ handle_ -> do
1009 #   ifdef DEBUG_DUMP
1010     puts ("hSeek " ++ show (mode,offset) ++ "\n")
1011 #   endif
1012     let ref = haBuffer handle_
1013     buf <- readIORef ref
1014     let r = bufRPtr buf
1015         w = bufWPtr buf
1016         fd = haFD handle_
1017
1018     let do_seek =
1019           throwErrnoIfMinus1Retry_ "hSeek"
1020             (c_lseek (fromIntegral (haFD handle_)) (fromIntegral offset) whence)
1021
1022         whence :: CInt
1023         whence = case mode of
1024                    AbsoluteSeek -> (#const SEEK_SET)
1025                    RelativeSeek -> (#const SEEK_CUR)
1026                    SeekFromEnd  -> (#const SEEK_END)
1027
1028     if bufferIsWritable buf
1029         then do new_buf <- flushWriteBuffer fd buf
1030                 writeIORef ref new_buf
1031                 do_seek
1032         else do
1033
1034     if mode == RelativeSeek && offset >= 0 && offset < fromIntegral (w - r)
1035         then writeIORef ref buf{ bufRPtr = r + fromIntegral offset }
1036         else do
1037
1038     new_buf <- flushReadBuffer (haFD handle_) buf
1039     writeIORef ref new_buf
1040     do_seek
1041
1042 -- -----------------------------------------------------------------------------
1043 -- Handle Properties
1044
1045 -- A number of operations return information about the properties of a
1046 -- handle.  Each of these operations returns `True' if the handle has
1047 -- the specified property, and `False' otherwise.
1048
1049 hIsOpen :: Handle -> IO Bool
1050 hIsOpen handle =
1051     withHandle_ "hIsOpen" handle $ \ handle_ -> do
1052     case haType handle_ of
1053       ClosedHandle         -> return False
1054       SemiClosedHandle     -> return False
1055       _                    -> return True
1056
1057 hIsClosed :: Handle -> IO Bool
1058 hIsClosed handle =
1059     withHandle_ "hIsClosed" handle $ \ handle_ -> do
1060     case haType handle_ of
1061       ClosedHandle         -> return True
1062       _                    -> return False
1063
1064 {- not defined, nor exported, but mentioned
1065    here for documentation purposes:
1066
1067     hSemiClosed :: Handle -> IO Bool
1068     hSemiClosed h = do
1069        ho <- hIsOpen h
1070        hc <- hIsClosed h
1071        return (not (ho || hc))
1072 -}
1073
1074 hIsReadable :: Handle -> IO Bool
1075 hIsReadable (DuplexHandle _ _) = return True
1076 hIsReadable handle =
1077     withHandle_ "hIsReadable" handle $ \ handle_ -> do
1078     case haType handle_ of
1079       ClosedHandle         -> ioe_closedHandle
1080       SemiClosedHandle     -> ioe_closedHandle
1081       htype                -> return (isReadableHandleType htype)
1082
1083 hIsWritable :: Handle -> IO Bool
1084 hIsWritable (DuplexHandle _ _) = return False
1085 hIsWritable handle =
1086     withHandle_ "hIsWritable" handle $ \ handle_ -> do
1087     case haType handle_ of
1088       ClosedHandle         -> ioe_closedHandle
1089       SemiClosedHandle     -> ioe_closedHandle
1090       htype                -> return (isWritableHandleType htype)
1091
1092 -- Querying how a handle buffers its data:
1093
1094 hGetBuffering :: Handle -> IO BufferMode
1095 hGetBuffering handle =
1096     withHandle_ "hGetBuffering" handle $ \ handle_ -> do
1097     case haType handle_ of
1098       ClosedHandle         -> ioe_closedHandle
1099       _ ->
1100            -- We're being non-standard here, and allow the buffering
1101            -- of a semi-closed handle to be queried.   -- sof 6/98
1102           return (haBufferMode handle_)  -- could be stricter..
1103
1104 hIsSeekable :: Handle -> IO Bool
1105 hIsSeekable handle =
1106     withHandle_ "hIsSeekable" handle $ \ handle_ -> do
1107     case haType handle_ of
1108       ClosedHandle         -> ioe_closedHandle
1109       SemiClosedHandle     -> ioe_closedHandle
1110       AppendHandle         -> return False
1111       _                    -> do t <- fdType (haFD handle_)
1112                                  return (t == RegularFile && haIsBin handle_)
1113
1114 -- -----------------------------------------------------------------------------
1115 -- Changing echo status
1116
1117 -- Non-standard GHC extension is to allow the echoing status
1118 -- of a handles connected to terminals to be reconfigured:
1119
1120 hSetEcho :: Handle -> Bool -> IO ()
1121 hSetEcho handle on = do
1122     isT   <- hIsTerminalDevice handle
1123     if not isT
1124      then return ()
1125      else
1126       withHandle_ "hSetEcho" handle $ \ handle_ -> do
1127       case haType handle_ of
1128          ClosedHandle -> ioe_closedHandle
1129          _            -> setEcho (haFD handle_) on
1130
1131 hGetEcho :: Handle -> IO Bool
1132 hGetEcho handle = do
1133     isT   <- hIsTerminalDevice handle
1134     if not isT
1135      then return False
1136      else
1137        withHandle_ "hGetEcho" handle $ \ handle_ -> do
1138        case haType handle_ of
1139          ClosedHandle -> ioe_closedHandle
1140          _            -> getEcho (haFD handle_)
1141
1142 hIsTerminalDevice :: Handle -> IO Bool
1143 hIsTerminalDevice handle = do
1144     withHandle_ "hIsTerminalDevice" handle $ \ handle_ -> do
1145      case haType handle_ of
1146        ClosedHandle -> ioe_closedHandle
1147        _            -> fdIsTTY (haFD handle_)
1148
1149 -- -----------------------------------------------------------------------------
1150 -- hSetBinaryMode
1151
1152 #ifdef _WIN32
1153 hSetBinaryMode handle bin =
1154   withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1155     do let flg | bin       = (#const O_BINARY)
1156                | otherwise = (#const O_TEXT)
1157        throwErrnoIfMinus1_ "hSetBinaryMode"
1158           (setmode (fromIntegral (haFD handle_)) flg)
1159        return handle_{haIsBin=bin}
1160
1161 foreign import "setmode" setmode :: CInt -> CInt -> IO CInt
1162 #else
1163 hSetBinaryMode handle bin =
1164   withAllHandles__ "hSetBinaryMode" handle $ \ handle_ ->
1165     return handle_{haIsBin=bin}
1166 #endif
1167
1168 -- -----------------------------------------------------------------------------
1169 -- Miscellaneous
1170
1171 -- These three functions are meant to get things out of an IOError.
1172
1173 ioeGetFileName        :: IOError -> Maybe FilePath
1174 ioeGetErrorString     :: IOError -> String
1175 ioeGetHandle          :: IOError -> Maybe Handle
1176
1177 ioeGetHandle (IOException (IOError h _ _ _ _)) = h
1178 ioeGetHandle (UserError _) = Nothing
1179 ioeGetHandle _ = error "IO.ioeGetHandle: not an IO error"
1180
1181 ioeGetErrorString (IOException (IOError _ iot _ _ _)) = show iot
1182 ioeGetErrorString (UserError str) = str
1183 ioeGetErrorString _ = error "IO.ioeGetErrorString: not an IO error"
1184
1185 ioeGetFileName (IOException (IOError _ _ _ _ fn)) = fn
1186 ioeGetFileName (UserError _) = Nothing
1187 ioeGetFileName _ = error "IO.ioeGetFileName: not an IO error"
1188
1189 -- ---------------------------------------------------------------------------
1190 -- debugging
1191
1192 #ifdef DEBUG_DUMP
1193 puts :: String -> IO ()
1194 puts s = withCString s $ \cstr -> do c_write 1 cstr (fromIntegral (length s))
1195                                      return ()
1196 #endif