GHC/IO/Handle.hs

   1 {-# OPTIONS_GHC -XNoImplicitPrelude -XRecordWildCards #-}
   2 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  GHC.IO.Handle
   6 -- Copyright   :  (c) The University of Glasgow, 1994-2009
   7 -- License     :  see libraries/base/LICENSE
   8 --
   9 -- Maintainer  :  libraries@haskell.org
  10 -- Stability   :  provisional
  11 -- Portability :  non-portable
  12 --
  13 -- External API for GHC's Handle implementation
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module GHC.IO.Handle (
  18    Handle,
  19    BufferMode(..),
  20
  21    mkFileHandle, mkDuplexHandle,
  22
  23    hFileSize, hSetFileSize, hIsEOF, hLookAhead,
  24    hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding,
  25    hFlush, hFlushAll, hDuplicate, hDuplicateTo,
  26
  27    hClose, hClose_help,
  28
  29    HandlePosition, HandlePosn(..), hGetPosn, hSetPosn,
  30    SeekMode(..), hSeek, hTell,
  31
  32    hIsOpen, hIsClosed, hIsReadable, hIsWritable, hGetBuffering, hIsSeekable,
  33    hSetEcho, hGetEcho, hIsTerminalDevice,
  34
  35    hSetNewlineMode, Newline(..), NewlineMode(..), nativeNewline,
  36    noNewlineTranslation, universalNewlineMode, nativeNewlineMode,
  37
  38    hShow,
  39
  40    hWaitForInput, hGetChar, hGetLine, hGetContents, hPutChar, hPutStr,
  41
  42    hGetBuf, hGetBufNonBlocking, hPutBuf, hPutBufNonBlocking
  43  ) where
  44
  45 import GHC.IO
  46 import GHC.IO.Exception
  47 import GHC.IO.Encoding
  48 import GHC.IO.Buffer
  49 import GHC.IO.BufferedIO ( BufferedIO )
  50 import GHC.IO.Device as IODevice
  51 import GHC.IO.Handle.Types
  52 import GHC.IO.Handle.Internals
  53 import GHC.IO.Handle.Text
  54 import qualified GHC.IO.BufferedIO as Buffered
  55
  56 import GHC.Base
  57 import GHC.Exception
  58 import GHC.MVar
  59 import GHC.IORef
  60 import GHC.Show
  61 import GHC.Num
  62 import GHC.Real
  63 import Data.Maybe
  64 import Data.Typeable
  65 import Control.Monad
  66
  67 -- ---------------------------------------------------------------------------
  68 -- Closing a handle
  69
  70 -- | Computation 'hClose' @hdl@ makes handle @hdl@ closed.  Before the
  71 -- computation finishes, if @hdl@ is writable its buffer is flushed as
  72 -- for 'hFlush'.
  73 -- Performing 'hClose' on a handle that has already been closed has no effect;
  74 -- doing so is not an error.  All other operations on a closed handle will fail.
  75 -- If 'hClose' fails for any reason, any further operations (apart from
  76 -- 'hClose') on the handle will still fail as if @hdl@ had been successfully
  77 -- closed.
  78
  79 hClose :: Handle -> IO ()
  80 hClose h@(FileHandle _ m)     = do
  81   mb_exc <- hClose' h m
  82   hClose_maybethrow mb_exc h
  83 hClose h@(DuplexHandle _ r w) = do
  84   mb_exc1 <- hClose' h w
  85   mb_exc2 <- hClose' h r
  86   case mb_exc1 of
  87     Nothing -> return ()
  88     Just e  -> hClose_maybethrow mb_exc2 h
  89
  90 hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()
  91 hClose_maybethrow Nothing  h  = return ()
  92 hClose_maybethrow (Just e) h = hClose_rethrow e h
  93
  94 hClose_rethrow :: SomeException -> Handle -> IO ()
  95 hClose_rethrow e h =
  96   case fromException e of
  97     Just ioe -> ioError (augmentIOError ioe "hClose" h)
  98     Nothing  -> throwIO e
  99
 100 hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
 101 hClose' h m = withHandle' "hClose" h m $ hClose_help
 102
 103 -----------------------------------------------------------------------------
 104 -- Detecting and changing the size of a file
 105
 106 -- | For a handle @hdl@ which attached to a physical file,
 107 -- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
 108
 109 hFileSize :: Handle -> IO Integer
 110 hFileSize handle =
 111     withHandle_ "hFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do
 112     case haType handle_ of
 113       ClosedHandle              -> ioe_closedHandle
 114       SemiClosedHandle          -> ioe_closedHandle
 115       _ -> do flushWriteBuffer handle_
 116               r <- IODevice.getSize dev
 117               if r /= -1
 118                  then return r
 119                  else ioException (IOError Nothing InappropriateType "hFileSize"
 120                                    "not a regular file" Nothing Nothing)
 121
 122
 123 -- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
 124
 125 hSetFileSize :: Handle -> Integer -> IO ()
 126 hSetFileSize handle size =
 127     withHandle_ "hSetFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do
 128     case haType handle_ of
 129       ClosedHandle              -> ioe_closedHandle
 130       SemiClosedHandle          -> ioe_closedHandle
 131       _ -> do flushWriteBuffer handle_
 132               IODevice.setSize dev size
 133               return ()
 134
 135 -- ---------------------------------------------------------------------------
 136 -- Detecting the End of Input
 137
 138 -- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
 139 -- 'True' if no further input can be taken from @hdl@ or for a
 140 -- physical file, if the current I\/O position is equal to the length of
 141 -- the file.  Otherwise, it returns 'False'.
 142 --
 143 -- NOTE: 'hIsEOF' may block, because it has to attempt to read from
 144 -- the stream to determine whether there is any more data to be read.
 145
 146 hIsEOF :: Handle -> IO Bool
 147 hIsEOF handle = wantReadableHandle_ "hIsEOF" handle $ \Handle__{..} -> do
 148
 149   cbuf <- readIORef haCharBuffer
 150   if not (isEmptyBuffer cbuf) then return False else do
 151
 152   bbuf <- readIORef haByteBuffer
 153   if not (isEmptyBuffer bbuf) then return False else do
 154
 155   -- NB. do no decoding, just fill the byte buffer; see #3808
 156   (r,bbuf') <- Buffered.fillReadBuffer haDevice bbuf
 157   if r == 0
 158      then return True
 159      else do writeIORef haByteBuffer bbuf'
 160              return False
 161
 162 -- ---------------------------------------------------------------------------
 163 -- Looking ahead
 164
 165 -- | Computation 'hLookAhead' returns the next character from the handle
 166 -- without removing it from the input buffer, blocking until a character
 167 -- is available.
 168 --
 169 -- This operation may fail with:
 170 --
 171 --  * 'isEOFError' if the end of file has been reached.
 172
 173 hLookAhead :: Handle -> IO Char
 174 hLookAhead handle =
 175   wantReadableHandle_ "hLookAhead"  handle hLookAhead_
 176
 177 -- ---------------------------------------------------------------------------
 178 -- Buffering Operations
 179
 180 -- Three kinds of buffering are supported: line-buffering,
 181 -- block-buffering or no-buffering.  See GHC.IO.Handle for definition and
 182 -- further explanation of what the type represent.
 183
 184 -- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
 185 -- handle @hdl@ on subsequent reads and writes.
 186 --
 187 -- If the buffer mode is changed from 'BlockBuffering' or
 188 -- 'LineBuffering' to 'NoBuffering', then
 189 --
 190 --  * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
 191 --
 192 --  * if @hdl@ is not writable, the contents of the buffer is discarded.
 193 --
 194 -- This operation may fail with:
 195 --
 196 --  * 'isPermissionError' if the handle has already been used for reading
 197 --    or writing and the implementation does not allow the buffering mode
 198 --    to be changed.
 199
 200 hSetBuffering :: Handle -> BufferMode -> IO ()
 201 hSetBuffering handle mode =
 202   withAllHandles__ "hSetBuffering" handle $ \ handle_@Handle__{..} -> do
 203   case haType of
 204     ClosedHandle -> ioe_closedHandle
 205     _ -> do
 206          if mode == haBufferMode then return handle_ else do
 207
 208          {- Note:
 209             - we flush the old buffer regardless of whether
 210               the new buffer could fit the contents of the old buffer
 211               or not.
 212             - allow a handle's buffering to change even if IO has
 213               occurred (ANSI C spec. does not allow this, nor did
 214               the previous implementation of IO.hSetBuffering).
 215             - a non-standard extension is to allow the buffering
 216               of semi-closed handles to change [sof 6/98]
 217           -}
 218           flushCharBuffer handle_
 219
 220           let state = initBufferState haType
 221               reading = not (isWritableHandleType haType)
 222
 223           new_buf <-
 224             case mode of
 225                 --  See [note Buffer Sizing], GHC.IO.Handle.Types
 226               NoBuffering | reading   -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
 227                           | otherwise -> newCharBuffer 1 state
 228               LineBuffering          -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
 229               BlockBuffering Nothing -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
 230               BlockBuffering (Just n) | n <= 0    -> ioe_bufsiz n
 231                                       | otherwise -> newCharBuffer n state
 232
 233           writeIORef haCharBuffer new_buf
 234
 235           -- for input terminals we need to put the terminal into
 236           -- cooked or raw mode depending on the type of buffering.
 237           is_tty <- IODevice.isTerminal haDevice
 238           when (is_tty && isReadableHandleType haType) $
 239                 case mode of
 240 #ifndef mingw32_HOST_OS
 241         -- 'raw' mode under win32 is a bit too specialised (and troublesome
 242         -- for most common uses), so simply disable its use here.
 243                   NoBuffering -> IODevice.setRaw haDevice True
 244 #else
 245                   NoBuffering -> return ()
 246 #endif
 247                   _           -> IODevice.setRaw haDevice False
 248
 249           -- throw away spare buffers, they might be the wrong size
 250           writeIORef haBuffers BufferListNil
 251
 252           return Handle__{ haBufferMode = mode,.. }
 253
 254 -- -----------------------------------------------------------------------------
 255 -- hSetEncoding
 256
 257 -- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding
 258 -- for the handle @hdl@ to @encoding@.  The default encoding when a 'Handle' is
 259 -- created is 'localeEncoding', namely the default encoding for the current
 260 -- locale.
 261 --
 262 -- To create a 'Handle' with no encoding at all, use 'openBinaryFile'.  To
 263 -- stop further encoding or decoding on an existing 'Handle', use
 264 -- 'hSetBinaryMode'.
 265 --
 266 -- 'hSetEncoding' may need to flush buffered data in order to change
 267 -- the encoding.
 268 --
 269 hSetEncoding :: Handle -> TextEncoding -> IO ()
 270 hSetEncoding hdl encoding = do
 271   withAllHandles__ "hSetEncoding" hdl $ \h_@Handle__{..} -> do
 272     flushCharBuffer h_
 273     closeTextCodecs h_
 274     openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do
 275     bbuf <- readIORef haByteBuffer
 276     ref <- newIORef (error "last_decode")
 277     return (Handle__{ haLastDecode = ref,
 278                       haDecoder = mb_decoder,
 279                       haEncoder = mb_encoder,
 280                       haCodec   = Just encoding, .. })
 281
 282 -- | Return the current 'TextEncoding' for the specified 'Handle', or
 283 -- 'Nothing' if the 'Handle' is in binary mode.
 284 --
 285 -- Note that the 'TextEncoding' remembers nothing about the state of
 286 -- the encoder/decoder in use on this 'Handle'.  For example, if the
 287 -- encoding in use is UTF-16, then using 'hGetEncoding' and
 288 -- 'hSetEncoding' to save and restore the encoding may result in an
 289 -- extra byte-order-mark being written to the file.
 290 --
 291 hGetEncoding :: Handle -> IO (Maybe TextEncoding)
 292 hGetEncoding hdl =
 293   withHandle_ "hGetEncoding" hdl $ \h_@Handle__{..} -> return haCodec
 294
 295 -- -----------------------------------------------------------------------------
 296 -- hFlush
 297
 298 -- | The action 'hFlush' @hdl@ causes any items buffered for output
 299 -- in handle @hdl@ to be sent immediately to the operating system.
 300 --
 301 -- This operation may fail with:
 302 --
 303 --  * 'isFullError' if the device is full;
 304 --
 305 --  * 'isPermissionError' if a system resource limit would be exceeded.
 306 --    It is unspecified whether the characters in the buffer are discarded
 307 --    or retained under these circumstances.
 308
 309 hFlush :: Handle -> IO ()
 310 hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer
 311
 312 -- | The action 'hFlushAll' @hdl@ flushes all buffered data in @hdl@,
 313 -- including any buffered read data.  Buffered read data is flushed
 314 -- by seeking the file position back to the point before the bufferred
 315 -- data was read, and hence only works if @hdl@ is seekable (see
 316 -- 'hIsSeekable').
 317 --
 318 -- This operation may fail with:
 319 --
 320 --  * 'isFullError' if the device is full;
 321 --
 322 --  * 'isPermissionError' if a system resource limit would be exceeded.
 323 --    It is unspecified whether the characters in the buffer are discarded
 324 --    or retained under these circumstances;
 325 --
 326 --  * 'isIllegalOperation' if @hdl@ has buffered read data, and is not
 327 --    seekable.
 328
 329 hFlushAll :: Handle -> IO ()
 330 hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer
 331
 332 -- -----------------------------------------------------------------------------
 333 -- Repositioning Handles
 334
 335 data HandlePosn = HandlePosn Handle HandlePosition
 336
 337 instance Eq HandlePosn where
 338     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 339
 340 instance Show HandlePosn where
 341    showsPrec p (HandlePosn h pos) =
 342         showsPrec p h . showString " at position " . shows pos
 343
 344   -- HandlePosition is the Haskell equivalent of POSIX' off_t.
 345   -- We represent it as an Integer on the Haskell side, but
 346   -- cheat slightly in that hGetPosn calls upon a C helper
 347   -- that reports the position back via (merely) an Int.
 348 type HandlePosition = Integer
 349
 350 -- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
 351 -- @hdl@ as a value of the abstract type 'HandlePosn'.
 352
 353 hGetPosn :: Handle -> IO HandlePosn
 354 hGetPosn handle = do
 355     posn <- hTell handle
 356     return (HandlePosn handle posn)
 357
 358 -- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
 359 -- then computation 'hSetPosn' @p@ sets the position of @hdl@
 360 -- to the position it held at the time of the call to 'hGetPosn'.
 361 --
 362 -- This operation may fail with:
 363 --
 364 --  * 'isPermissionError' if a system resource limit would be exceeded.
 365
 366 hSetPosn :: HandlePosn -> IO ()
 367 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
 368
 369 -- ---------------------------------------------------------------------------
 370 -- hSeek
 371
 372 {- Note:
 373  - when seeking using `SeekFromEnd', positive offsets (>=0) means
 374    seeking at or past EOF.
 375
 376  - we possibly deviate from the report on the issue of seeking within
 377    the buffer and whether to flush it or not.  The report isn't exactly
 378    clear here.
 379 -}
 380
 381 -- | Computation 'hSeek' @hdl mode i@ sets the position of handle
 382 -- @hdl@ depending on @mode@.
 383 -- The offset @i@ is given in terms of 8-bit bytes.
 384 --
 385 -- If @hdl@ is block- or line-buffered, then seeking to a position which is not
 386 -- in the current buffer will first cause any items in the output buffer to be
 387 -- written to the device, and then cause the input buffer to be discarded.
 388 -- Some handles may not be seekable (see 'hIsSeekable'), or only support a
 389 -- subset of the possible positioning operations (for instance, it may only
 390 -- be possible to seek to the end of a tape, or to a positive offset from
 391 -- the beginning or current position).
 392 -- It is not possible to set a negative I\/O position, or for
 393 -- a physical file, an I\/O position beyond the current end-of-file.
 394 --
 395 -- This operation may fail with:
 396 --
 397 --  * 'isIllegalOperationError' if the Handle is not seekable, or does
 398 --    not support the requested seek mode.
 399 --  * 'isPermissionError' if a system resource limit would be exceeded.
 400
 401 hSeek :: Handle -> SeekMode -> Integer -> IO ()
 402 hSeek handle mode offset =
 403     wantSeekableHandle "hSeek" handle $ \ handle_@Handle__{..} -> do
 404     debugIO ("hSeek " ++ show (mode,offset))
 405     buf <- readIORef haCharBuffer
 406
 407     if isWriteBuffer buf
 408         then do flushWriteBuffer handle_
 409                 IODevice.seek haDevice mode offset
 410         else do
 411
 412     let r = bufL buf; w = bufR buf
 413     if mode == RelativeSeek && isNothing haDecoder &&
 414        offset >= 0 && offset < fromIntegral (w - r)
 415         then writeIORef haCharBuffer buf{ bufL = r + fromIntegral offset }
 416         else do
 417
 418     flushCharReadBuffer handle_
 419     flushByteReadBuffer handle_
 420     IODevice.seek haDevice mode offset
 421
 422
 423 -- | Computation 'hTell' @hdl@ returns the current position of the
 424 -- handle @hdl@, as the number of bytes from the beginning of
 425 -- the file.  The value returned may be subsequently passed to
 426 -- 'hSeek' to reposition the handle to the current position.
 427 --
 428 -- This operation may fail with:
 429 --
 430 --  * 'isIllegalOperationError' if the Handle is not seekable.
 431 --
 432 hTell :: Handle -> IO Integer
 433 hTell handle =
 434     wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do
 435
 436       posn <- IODevice.tell haDevice
 437
 438       cbuf <- readIORef haCharBuffer
 439       bbuf <- readIORef haByteBuffer
 440
 441       let real_posn
 442            | isWriteBuffer cbuf = posn + fromIntegral (bufR cbuf)
 443            | otherwise = posn - fromIntegral (bufR cbuf - bufL cbuf)
 444                               - fromIntegral (bufR bbuf - bufL bbuf)
 445
 446       debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn))
 447       debugIO ("   cbuf: " ++ summaryBuffer cbuf ++
 448             "   bbuf: " ++ summaryBuffer bbuf)
 449
 450       return real_posn
 451
 452 -- -----------------------------------------------------------------------------
 453 -- Handle Properties
 454
 455 -- A number of operations return information about the properties of a
 456 -- handle.  Each of these operations returns `True' if the handle has
 457 -- the specified property, and `False' otherwise.
 458
 459 hIsOpen :: Handle -> IO Bool
 460 hIsOpen handle =
 461     withHandle_ "hIsOpen" handle $ \ handle_ -> do
 462     case haType handle_ of
 463       ClosedHandle         -> return False
 464       SemiClosedHandle     -> return False
 465       _                    -> return True
 466
 467 hIsClosed :: Handle -> IO Bool
 468 hIsClosed handle =
 469     withHandle_ "hIsClosed" handle $ \ handle_ -> do
 470     case haType handle_ of
 471       ClosedHandle         -> return True
 472       _                    -> return False
 473
 474 {- not defined, nor exported, but mentioned
 475    here for documentation purposes:
 476
 477     hSemiClosed :: Handle -> IO Bool
 478     hSemiClosed h = do
 479        ho <- hIsOpen h
 480        hc <- hIsClosed h
 481        return (not (ho || hc))
 482 -}
 483
 484 hIsReadable :: Handle -> IO Bool
 485 hIsReadable (DuplexHandle _ _ _) = return True
 486 hIsReadable handle =
 487     withHandle_ "hIsReadable" handle $ \ handle_ -> do
 488     case haType handle_ of
 489       ClosedHandle         -> ioe_closedHandle
 490       SemiClosedHandle     -> ioe_closedHandle
 491       htype                -> return (isReadableHandleType htype)
 492
 493 hIsWritable :: Handle -> IO Bool
 494 hIsWritable (DuplexHandle _ _ _) = return True
 495 hIsWritable handle =
 496     withHandle_ "hIsWritable" handle $ \ handle_ -> do
 497     case haType handle_ of
 498       ClosedHandle         -> ioe_closedHandle
 499       SemiClosedHandle     -> ioe_closedHandle
 500       htype                -> return (isWritableHandleType htype)
 501
 502 -- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
 503 -- for @hdl@.
 504
 505 hGetBuffering :: Handle -> IO BufferMode
 506 hGetBuffering handle =
 507     withHandle_ "hGetBuffering" handle $ \ handle_ -> do
 508     case haType handle_ of
 509       ClosedHandle         -> ioe_closedHandle
 510       _ ->
 511            -- We're being non-standard here, and allow the buffering
 512            -- of a semi-closed handle to be queried.   -- sof 6/98
 513           return (haBufferMode handle_)  -- could be stricter..
 514
 515 hIsSeekable :: Handle -> IO Bool
 516 hIsSeekable handle =
 517     withHandle_ "hIsSeekable" handle $ \ handle_@Handle__{..} -> do
 518     case haType of
 519       ClosedHandle         -> ioe_closedHandle
 520       SemiClosedHandle     -> ioe_closedHandle
 521       AppendHandle         -> return False
 522       _                    -> IODevice.isSeekable haDevice
 523
 524 -- -----------------------------------------------------------------------------
 525 -- Changing echo status (Non-standard GHC extensions)
 526
 527 -- | Set the echoing status of a handle connected to a terminal.
 528
 529 hSetEcho :: Handle -> Bool -> IO ()
 530 hSetEcho handle on = do
 531     isT   <- hIsTerminalDevice handle
 532     if not isT
 533      then return ()
 534      else
 535       withHandle_ "hSetEcho" handle $ \ Handle__{..} -> do
 536       case haType of
 537          ClosedHandle -> ioe_closedHandle
 538          _            -> IODevice.setEcho haDevice on
 539
 540 -- | Get the echoing status of a handle connected to a terminal.
 541
 542 hGetEcho :: Handle -> IO Bool
 543 hGetEcho handle = do
 544     isT   <- hIsTerminalDevice handle
 545     if not isT
 546      then return False
 547      else
 548        withHandle_ "hGetEcho" handle $ \ Handle__{..} -> do
 549        case haType of
 550          ClosedHandle -> ioe_closedHandle
 551          _            -> IODevice.getEcho haDevice
 552
 553 -- | Is the handle connected to a terminal?
 554
 555 hIsTerminalDevice :: Handle -> IO Bool
 556 hIsTerminalDevice handle = do
 557     withHandle_ "hIsTerminalDevice" handle $ \ Handle__{..} -> do
 558      case haType of
 559        ClosedHandle -> ioe_closedHandle
 560        _            -> IODevice.isTerminal haDevice
 561
 562 -- -----------------------------------------------------------------------------
 563 -- hSetBinaryMode
 564
 565 -- | Select binary mode ('True') or text mode ('False') on a open handle.
 566 -- (See also 'openBinaryFile'.)
 567 --
 568 -- This has the same effect as calling 'hSetEncoding' with 'latin1', together
 569 -- with 'hSetNewlineMode' with 'noNewlineTranslation'.
 570 --
 571 hSetBinaryMode :: Handle -> Bool -> IO ()
 572 hSetBinaryMode handle bin =
 573   withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} ->
 574     do
 575          flushCharBuffer h_
 576          closeTextCodecs h_
 577
 578          let mb_te | bin       = Nothing
 579                    | otherwise = Just localeEncoding
 580
 581          openTextEncoding mb_te haType $ \ mb_encoder mb_decoder -> do
 582
 583          -- should match the default newline mode, whatever that is
 584          let nl    | bin       = noNewlineTranslation
 585                    | otherwise = nativeNewlineMode
 586
 587          bbuf <- readIORef haByteBuffer
 588          ref <- newIORef (error "codec_state", bbuf)
 589
 590          return Handle__{ haLastDecode = ref,
 591                           haEncoder  = mb_encoder,
 592                           haDecoder  = mb_decoder,
 593                           haCodec    = mb_te,
 594                           haInputNL  = inputNL nl,
 595                           haOutputNL = outputNL nl, .. }
 596
 597 -- -----------------------------------------------------------------------------
 598 -- hSetNewlineMode
 599
 600 -- | Set the 'NewlineMode' on the specified 'Handle'.  All buffered
 601 -- data is flushed first.
 602 hSetNewlineMode :: Handle -> NewlineMode -> IO ()
 603 hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } =
 604   withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{..} ->
 605     do
 606          flushBuffer h_
 607          return h_{ haInputNL=i, haOutputNL=o }
 608
 609 -- -----------------------------------------------------------------------------
 610 -- Duplicating a Handle
 611
 612 -- | Returns a duplicate of the original handle, with its own buffer.
 613 -- The two Handles will share a file pointer, however.  The original
 614 -- handle's buffer is flushed, including discarding any input data,
 615 -- before the handle is duplicated.
 616
 617 hDuplicate :: Handle -> IO Handle
 618 hDuplicate h@(FileHandle path m) = do
 619   withHandle_' "hDuplicate" h m $ \h_ ->
 620       dupHandle path h Nothing h_ (Just handleFinalizer)
 621 hDuplicate h@(DuplexHandle path r w) = do
 622   write_side@(FileHandle _ write_m) <-
 623      withHandle_' "hDuplicate" h w $ \h_ ->
 624         dupHandle path h Nothing h_ (Just handleFinalizer)
 625   read_side@(FileHandle _ read_m) <-
 626     withHandle_' "hDuplicate" h r $ \h_ ->
 627         dupHandle path h (Just write_m) h_  Nothing
 628   return (DuplexHandle path read_m write_m)
 629
 630 dupHandle :: FilePath
 631           -> Handle
 632           -> Maybe (MVar Handle__)
 633           -> Handle__
 634           -> Maybe HandleFinalizer
 635           -> IO Handle
 636 dupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do
 637   -- flush the buffer first, so we don't have to copy its contents
 638   flushBuffer h_
 639   case other_side of
 640     Nothing -> do
 641        new_dev <- IODevice.dup haDevice
 642        dupHandle_ new_dev filepath other_side h_ mb_finalizer
 643     Just r  ->
 644        withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} -> do
 645          dupHandle_ dev filepath other_side h_ mb_finalizer
 646
 647 dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
 648            -> FilePath
 649            -> Maybe (MVar Handle__)
 650            -> Handle__
 651            -> Maybe HandleFinalizer
 652            -> IO Handle
 653 dupHandle_ new_dev filepath other_side h_@Handle__{..} mb_finalizer = do
 654    -- XXX wrong!
 655   let mb_codec = if isJust haEncoder then Just localeEncoding else Nothing
 656   mkHandle new_dev filepath haType True{-buffered-} mb_codec
 657       NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }
 658       mb_finalizer other_side
 659
 660 -- -----------------------------------------------------------------------------
 661 -- Replacing a Handle
 662
 663 {- |
 664 Makes the second handle a duplicate of the first handle.  The second
 665 handle will be closed first, if it is not already.
 666
 667 This can be used to retarget the standard Handles, for example:
 668
 669 > do h <- openFile "mystdout" WriteMode
 670 >    hDuplicateTo h stdout
 671 -}
 672
 673 hDuplicateTo :: Handle -> Handle -> IO ()
 674 hDuplicateTo h1@(FileHandle path m1) h2@(FileHandle _ m2)  = do
 675  withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
 676    _ <- hClose_help h2_
 677    withHandle_' "hDuplicateTo" h1 m1 $ \h1_ -> do
 678      dupHandleTo path h1 Nothing h2_ h1_ (Just handleFinalizer)
 679 hDuplicateTo h1@(DuplexHandle path r1 w1) h2@(DuplexHandle _ r2 w2)  = do
 680  withHandle__' "hDuplicateTo" h2 w2  $ \w2_ -> do
 681    _ <- hClose_help w2_
 682    withHandle_' "hDuplicateTo" h1 w1 $ \w1_ -> do
 683      dupHandleTo path h1 Nothing w2_ w1_ (Just handleFinalizer)
 684  withHandle__' "hDuplicateTo" h2 r2  $ \r2_ -> do
 685    _ <- hClose_help r2_
 686    withHandle_' "hDuplicateTo" h1 r1 $ \r1_ -> do
 687      dupHandleTo path h1 (Just w1) r2_ r1_ Nothing
 688 hDuplicateTo h1 _ =
 689   ioe_dupHandlesNotCompatible h1
 690
 691
 692 ioe_dupHandlesNotCompatible :: Handle -> IO a
 693 ioe_dupHandlesNotCompatible h =
 694    ioException (IOError (Just h) IllegalOperation "hDuplicateTo"
 695                 "handles are incompatible" Nothing Nothing)
 696
 697 dupHandleTo :: FilePath
 698             -> Handle
 699             -> Maybe (MVar Handle__)
 700             -> Handle__
 701             -> Handle__
 702             -> Maybe HandleFinalizer
 703             -> IO Handle__
 704 dupHandleTo filepath h other_side
 705             hto_@Handle__{haDevice=devTo,..}
 706             h_@Handle__{haDevice=dev} mb_finalizer = do
 707   flushBuffer h_
 708   case cast devTo of
 709     Nothing   -> ioe_dupHandlesNotCompatible h
 710     Just dev' -> do
 711       _ <- IODevice.dup2 dev dev'
 712       FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer
 713       takeMVar m
 714
 715 -- ---------------------------------------------------------------------------
 716 -- showing Handles.
 717 --
 718 -- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
 719 -- than the (pure) instance of 'Show' for 'Handle'.
 720
 721 hShow :: Handle -> IO String
 722 hShow h@(FileHandle path _) = showHandle' path False h
 723 hShow h@(DuplexHandle path _ _) = showHandle' path True h
 724
 725 showHandle' :: String -> Bool -> Handle -> IO String
 726 showHandle' filepath is_duplex h =
 727   withHandle_ "showHandle" h $ \hdl_ ->
 728     let
 729      showType | is_duplex = showString "duplex (read-write)"
 730               | otherwise = shows (haType hdl_)
 731     in
 732     return
 733       (( showChar '{' .
 734         showHdl (haType hdl_)
 735             (showString "loc=" . showString filepath . showChar ',' .
 736              showString "type=" . showType . showChar ',' .
 737              showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haCharBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
 738       ) "")
 739    where
 740
 741     showHdl :: HandleType -> ShowS -> ShowS
 742     showHdl ht cont =
 743        case ht of
 744         ClosedHandle  -> shows ht . showString "}"
 745         _ -> cont
 746
 747     showBufMode :: Buffer e -> BufferMode -> ShowS
 748     showBufMode buf bmo =
 749       case bmo of
 750         NoBuffering   -> showString "none"
 751         LineBuffering -> showString "line"
 752         BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
 753         BlockBuffering Nothing  -> showString "block " . showParen True (shows def)
 754       where
 755        def :: Int
 756        def = bufSize buf