ghc/lib/std/PrelHandle.hs

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