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