GHC/IO/Handle.hs

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