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