GHC/Handle.hs

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