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       -- we can't tell the real byte offset if there are buffered
 421       -- Chars, so must flush first:
 422       flushCharBuffer handle_
 423
 424       bbuf <- readIORef haByteBuffer
 425
 426       let real_posn
 427            | isWriteBuffer bbuf = posn + fromIntegral (bufferElems bbuf)
 428            | otherwise          = posn - fromIntegral (bufferElems bbuf)
 429
 430       cbuf <- readIORef haCharBuffer
 431       debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn))
 432       debugIO ("   cbuf: " ++ summaryBuffer cbuf ++
 433             "   bbuf: " ++ summaryBuffer bbuf)
 434
 435       return real_posn
 436
 437 -- -----------------------------------------------------------------------------
 438 -- Handle Properties
 439
 440 -- A number of operations return information about the properties of a
 441 -- handle.  Each of these operations returns `True' if the handle has
 442 -- the specified property, and `False' otherwise.
 443
 444 hIsOpen :: Handle -> IO Bool
 445 hIsOpen handle =
 446     withHandle_ "hIsOpen" handle $ \ handle_ -> do
 447     case haType handle_ of
 448       ClosedHandle         -> return False
 449       SemiClosedHandle     -> return False
 450       _                    -> return True
 451
 452 hIsClosed :: Handle -> IO Bool
 453 hIsClosed handle =
 454     withHandle_ "hIsClosed" handle $ \ handle_ -> do
 455     case haType handle_ of
 456       ClosedHandle         -> return True
 457       _                    -> return False
 458
 459 {- not defined, nor exported, but mentioned
 460    here for documentation purposes:
 461
 462     hSemiClosed :: Handle -> IO Bool
 463     hSemiClosed h = do
 464        ho <- hIsOpen h
 465        hc <- hIsClosed h
 466        return (not (ho || hc))
 467 -}
 468
 469 hIsReadable :: Handle -> IO Bool
 470 hIsReadable (DuplexHandle _ _ _) = return True
 471 hIsReadable handle =
 472     withHandle_ "hIsReadable" handle $ \ handle_ -> do
 473     case haType handle_ of
 474       ClosedHandle         -> ioe_closedHandle
 475       SemiClosedHandle     -> ioe_closedHandle
 476       htype                -> return (isReadableHandleType htype)
 477
 478 hIsWritable :: Handle -> IO Bool
 479 hIsWritable (DuplexHandle _ _ _) = return True
 480 hIsWritable handle =
 481     withHandle_ "hIsWritable" handle $ \ handle_ -> do
 482     case haType handle_ of
 483       ClosedHandle         -> ioe_closedHandle
 484       SemiClosedHandle     -> ioe_closedHandle
 485       htype                -> return (isWritableHandleType htype)
 486
 487 -- | Computation 'hGetBuffering' @hdl@ returns the current buffering mode
 488 -- for @hdl@.
 489
 490 hGetBuffering :: Handle -> IO BufferMode
 491 hGetBuffering handle =
 492     withHandle_ "hGetBuffering" handle $ \ handle_ -> do
 493     case haType handle_ of
 494       ClosedHandle         -> ioe_closedHandle
 495       _ ->
 496            -- We're being non-standard here, and allow the buffering
 497            -- of a semi-closed handle to be queried.   -- sof 6/98
 498           return (haBufferMode handle_)  -- could be stricter..
 499
 500 hIsSeekable :: Handle -> IO Bool
 501 hIsSeekable handle =
 502     withHandle_ "hIsSeekable" handle $ \ handle_@Handle__{..} -> do
 503     case haType of
 504       ClosedHandle         -> ioe_closedHandle
 505       SemiClosedHandle     -> ioe_closedHandle
 506       AppendHandle         -> return False
 507       _                    -> IODevice.isSeekable haDevice
 508
 509 -- -----------------------------------------------------------------------------
 510 -- Changing echo status (Non-standard GHC extensions)
 511
 512 -- | Set the echoing status of a handle connected to a terminal.
 513
 514 hSetEcho :: Handle -> Bool -> IO ()
 515 hSetEcho handle on = do
 516     isT   <- hIsTerminalDevice handle
 517     if not isT
 518      then return ()
 519      else
 520       withHandle_ "hSetEcho" handle $ \ Handle__{..} -> do
 521       case haType of
 522          ClosedHandle -> ioe_closedHandle
 523          _            -> IODevice.setEcho haDevice on
 524
 525 -- | Get the echoing status of a handle connected to a terminal.
 526
 527 hGetEcho :: Handle -> IO Bool
 528 hGetEcho handle = do
 529     isT   <- hIsTerminalDevice handle
 530     if not isT
 531      then return False
 532      else
 533        withHandle_ "hGetEcho" handle $ \ Handle__{..} -> do
 534        case haType of
 535          ClosedHandle -> ioe_closedHandle
 536          _            -> IODevice.getEcho haDevice
 537
 538 -- | Is the handle connected to a terminal?
 539
 540 hIsTerminalDevice :: Handle -> IO Bool
 541 hIsTerminalDevice handle = do
 542     withHandle_ "hIsTerminalDevice" handle $ \ Handle__{..} -> do
 543      case haType of
 544        ClosedHandle -> ioe_closedHandle
 545        _            -> IODevice.isTerminal haDevice
 546
 547 -- -----------------------------------------------------------------------------
 548 -- hSetBinaryMode
 549
 550 -- | Select binary mode ('True') or text mode ('False') on a open handle.
 551 -- (See also 'openBinaryFile'.)
 552 --
 553 -- This has the same effect as calling 'hSetEncoding' with 'latin1', together
 554 -- with 'hSetNewlineMode' with 'noNewlineTranslation'.
 555 --
 556 hSetBinaryMode :: Handle -> Bool -> IO ()
 557 hSetBinaryMode handle bin =
 558   withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} ->
 559     do
 560          flushCharBuffer h_
 561          closeTextCodecs h_
 562
 563          let mb_te | bin       = Nothing
 564                    | otherwise = Just localeEncoding
 565
 566          openTextEncoding mb_te haType $ \ mb_encoder mb_decoder -> do
 567
 568          -- should match the default newline mode, whatever that is
 569          let nl    | bin       = noNewlineTranslation
 570                    | otherwise = nativeNewlineMode
 571
 572          bbuf <- readIORef haByteBuffer
 573          ref <- newIORef (error "codec_state", bbuf)
 574
 575          return Handle__{ haLastDecode = ref,
 576                           haEncoder  = mb_encoder,
 577                           haDecoder  = mb_decoder,
 578                           haCodec    = mb_te,
 579                           haInputNL  = inputNL nl,
 580                           haOutputNL = outputNL nl, .. }
 581
 582 -- -----------------------------------------------------------------------------
 583 -- hSetNewlineMode
 584
 585 -- | Set the 'NewlineMode' on the specified 'Handle'.  All buffered
 586 -- data is flushed first.
 587 hSetNewlineMode :: Handle -> NewlineMode -> IO ()
 588 hSetNewlineMode handle NewlineMode{ inputNL=i, outputNL=o } =
 589   withAllHandles__ "hSetNewlineMode" handle $ \h_@Handle__{..} ->
 590     do
 591          flushBuffer h_
 592          return h_{ haInputNL=i, haOutputNL=o }
 593
 594 -- -----------------------------------------------------------------------------
 595 -- Duplicating a Handle
 596
 597 -- | Returns a duplicate of the original handle, with its own buffer.
 598 -- The two Handles will share a file pointer, however.  The original
 599 -- handle's buffer is flushed, including discarding any input data,
 600 -- before the handle is duplicated.
 601
 602 hDuplicate :: Handle -> IO Handle
 603 hDuplicate h@(FileHandle path m) = do
 604   withHandle_' "hDuplicate" h m $ \h_ ->
 605       dupHandle path h Nothing h_ (Just handleFinalizer)
 606 hDuplicate h@(DuplexHandle path r w) = do
 607   write_side@(FileHandle _ write_m) <-
 608      withHandle_' "hDuplicate" h w $ \h_ ->
 609         dupHandle path h Nothing h_ (Just handleFinalizer)
 610   read_side@(FileHandle _ read_m) <-
 611     withHandle_' "hDuplicate" h r $ \h_ ->
 612         dupHandle path h (Just write_m) h_  Nothing
 613   return (DuplexHandle path read_m write_m)
 614
 615 dupHandle :: FilePath
 616           -> Handle
 617           -> Maybe (MVar Handle__)
 618           -> Handle__
 619           -> Maybe HandleFinalizer
 620           -> IO Handle
 621 dupHandle filepath h other_side h_@Handle__{..} mb_finalizer = do
 622   -- flush the buffer first, so we don't have to copy its contents
 623   flushBuffer h_
 624   case other_side of
 625     Nothing -> do
 626        new_dev <- IODevice.dup haDevice
 627        dupHandle_ new_dev filepath other_side h_ mb_finalizer
 628     Just r  ->
 629        withHandle_' "dupHandle" h r $ \Handle__{haDevice=dev} -> do
 630          dupHandle_ dev filepath other_side h_ mb_finalizer
 631
 632 dupHandle_ :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
 633            -> FilePath
 634            -> Maybe (MVar Handle__)
 635            -> Handle__
 636            -> Maybe HandleFinalizer
 637            -> IO Handle
 638 dupHandle_ new_dev filepath other_side h_@Handle__{..} mb_finalizer = do
 639    -- XXX wrong!
 640   let mb_codec = if isJust haEncoder then Just localeEncoding else Nothing
 641   mkHandle new_dev filepath haType True{-buffered-} mb_codec
 642       NewlineMode { inputNL = haInputNL, outputNL = haOutputNL }
 643       mb_finalizer other_side
 644
 645 -- -----------------------------------------------------------------------------
 646 -- Replacing a Handle
 647
 648 {- |
 649 Makes the second handle a duplicate of the first handle.  The second
 650 handle will be closed first, if it is not already.
 651
 652 This can be used to retarget the standard Handles, for example:
 653
 654 > do h <- openFile "mystdout" WriteMode
 655 >    hDuplicateTo h stdout
 656 -}
 657
 658 hDuplicateTo :: Handle -> Handle -> IO ()
 659 hDuplicateTo h1@(FileHandle path m1) h2@(FileHandle _ m2)  = do
 660  withHandle__' "hDuplicateTo" h2 m2 $ \h2_ -> do
 661    _ <- hClose_help h2_
 662    withHandle_' "hDuplicateTo" h1 m1 $ \h1_ -> do
 663      dupHandleTo path h1 Nothing h2_ h1_ (Just handleFinalizer)
 664 hDuplicateTo h1@(DuplexHandle path r1 w1) h2@(DuplexHandle _ r2 w2)  = do
 665  withHandle__' "hDuplicateTo" h2 w2  $ \w2_ -> do
 666    _ <- hClose_help w2_
 667    withHandle_' "hDuplicateTo" h1 w1 $ \w1_ -> do
 668      dupHandleTo path h1 Nothing w2_ w1_ (Just handleFinalizer)
 669  withHandle__' "hDuplicateTo" h2 r2  $ \r2_ -> do
 670    _ <- hClose_help r2_
 671    withHandle_' "hDuplicateTo" h1 r1 $ \r1_ -> do
 672      dupHandleTo path h1 (Just w1) r2_ r1_ Nothing
 673 hDuplicateTo h1 _ =
 674   ioe_dupHandlesNotCompatible h1
 675
 676
 677 ioe_dupHandlesNotCompatible :: Handle -> IO a
 678 ioe_dupHandlesNotCompatible h =
 679    ioException (IOError (Just h) IllegalOperation "hDuplicateTo"
 680                 "handles are incompatible" Nothing Nothing)
 681
 682 dupHandleTo :: FilePath
 683             -> Handle
 684             -> Maybe (MVar Handle__)
 685             -> Handle__
 686             -> Handle__
 687             -> Maybe HandleFinalizer
 688             -> IO Handle__
 689 dupHandleTo filepath h other_side
 690             hto_@Handle__{haDevice=devTo,..}
 691             h_@Handle__{haDevice=dev} mb_finalizer = do
 692   flushBuffer h_
 693   case cast devTo of
 694     Nothing   -> ioe_dupHandlesNotCompatible h
 695     Just dev' -> do
 696       _ <- IODevice.dup2 dev dev'
 697       FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer
 698       takeMVar m
 699
 700 -- ---------------------------------------------------------------------------
 701 -- showing Handles.
 702 --
 703 -- | 'hShow' is in the 'IO' monad, and gives more comprehensive output
 704 -- than the (pure) instance of 'Show' for 'Handle'.
 705
 706 hShow :: Handle -> IO String
 707 hShow h@(FileHandle path _) = showHandle' path False h
 708 hShow h@(DuplexHandle path _ _) = showHandle' path True h
 709
 710 showHandle' :: String -> Bool -> Handle -> IO String
 711 showHandle' filepath is_duplex h =
 712   withHandle_ "showHandle" h $ \hdl_ ->
 713     let
 714      showType | is_duplex = showString "duplex (read-write)"
 715               | otherwise = shows (haType hdl_)
 716     in
 717     return
 718       (( showChar '{' .
 719         showHdl (haType hdl_)
 720             (showString "loc=" . showString filepath . showChar ',' .
 721              showString "type=" . showType . showChar ',' .
 722              showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haCharBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
 723       ) "")
 724    where
 725
 726     showHdl :: HandleType -> ShowS -> ShowS
 727     showHdl ht cont =
 728        case ht of
 729         ClosedHandle  -> shows ht . showString "}"
 730         _ -> cont
 731
 732     showBufMode :: Buffer e -> BufferMode -> ShowS
 733     showBufMode buf bmo =
 734       case bmo of
 735         NoBuffering   -> showString "none"
 736         LineBuffering -> showString "line"
 737         BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
 738         BlockBuffering Nothing  -> showString "block " . showParen True (shows def)
 739       where
 740        def :: Int
 741        def = bufSize buf