GHC/IO/Handle.hs

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