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