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   excs <- mapM (hClose' h) [r,w]
  86   hClose_maybethrow (listToMaybe (catMaybes excs)) h
  87
  88 hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()
  89 hClose_maybethrow Nothing  h = return ()
  90 hClose_maybethrow (Just e) h = hClose_rethrow e h
  91
  92 hClose_rethrow :: SomeException -> Handle -> IO ()
  93 hClose_rethrow e h =
  94   case fromException e of
  95     Just ioe -> ioError (augmentIOError ioe "hClose" h)
  96     Nothing  -> throwIO e
  97
  98 hClose' :: Handle -> MVar Handle__ -> IO (Maybe SomeException)
  99 hClose' h m = withHandle' "hClose" h m $ hClose_help
 100
 101 -----------------------------------------------------------------------------
 102 -- Detecting and changing the size of a file
 103
 104 -- | For a handle @hdl@ which attached to a physical file,
 105 -- 'hFileSize' @hdl@ returns the size of that file in 8-bit bytes.
 106
 107 hFileSize :: Handle -> IO Integer
 108 hFileSize handle =
 109     withHandle_ "hFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do
 110     case haType handle_ of
 111       ClosedHandle              -> ioe_closedHandle
 112       SemiClosedHandle          -> ioe_closedHandle
 113       _ -> do flushWriteBuffer handle_
 114               r <- IODevice.getSize dev
 115               if r /= -1
 116                  then return r
 117                  else ioException (IOError Nothing InappropriateType "hFileSize"
 118                                    "not a regular file" Nothing Nothing)
 119
 120
 121 -- | 'hSetFileSize' @hdl@ @size@ truncates the physical file with handle @hdl@ to @size@ bytes.
 122
 123 hSetFileSize :: Handle -> Integer -> IO ()
 124 hSetFileSize handle size =
 125     withHandle_ "hSetFileSize" handle $ \ handle_@Handle__{haDevice=dev} -> do
 126     case haType handle_ of
 127       ClosedHandle              -> ioe_closedHandle
 128       SemiClosedHandle          -> ioe_closedHandle
 129       _ -> do flushWriteBuffer handle_
 130               IODevice.setSize dev size
 131               return ()
 132
 133 -- ---------------------------------------------------------------------------
 134 -- Detecting the End of Input
 135
 136 -- | For a readable handle @hdl@, 'hIsEOF' @hdl@ returns
 137 -- 'True' if no further input can be taken from @hdl@ or for a
 138 -- physical file, if the current I\/O position is equal to the length of
 139 -- the file.  Otherwise, it returns 'False'.
 140 --
 141 -- NOTE: 'hIsEOF' may block, because it has to attempt to read from
 142 -- the stream to determine whether there is any more data to be read.
 143
 144 hIsEOF :: Handle -> IO Bool
 145 hIsEOF handle = wantReadableHandle_ "hIsEOF" handle $ \Handle__{..} -> do
 146
 147   cbuf <- readIORef haCharBuffer
 148   if not (isEmptyBuffer cbuf) then return False else do
 149
 150   bbuf <- readIORef haByteBuffer
 151   if not (isEmptyBuffer bbuf) then return False else do
 152
 153   -- NB. do no decoding, just fill the byte buffer; see #3808
 154   (r,bbuf') <- Buffered.fillReadBuffer haDevice bbuf
 155   if r == 0
 156      then return True
 157      else do writeIORef haByteBuffer bbuf'
 158              return False
 159
 160 -- ---------------------------------------------------------------------------
 161 -- Looking ahead
 162
 163 -- | Computation 'hLookAhead' returns the next character from the handle
 164 -- without removing it from the input buffer, blocking until a character
 165 -- is available.
 166 --
 167 -- This operation may fail with:
 168 --
 169 --  * 'isEOFError' if the end of file has been reached.
 170
 171 hLookAhead :: Handle -> IO Char
 172 hLookAhead handle =
 173   wantReadableHandle_ "hLookAhead"  handle hLookAhead_
 174
 175 -- ---------------------------------------------------------------------------
 176 -- Buffering Operations
 177
 178 -- Three kinds of buffering are supported: line-buffering,
 179 -- block-buffering or no-buffering.  See GHC.IO.Handle for definition and
 180 -- further explanation of what the type represent.
 181
 182 -- | Computation 'hSetBuffering' @hdl mode@ sets the mode of buffering for
 183 -- handle @hdl@ on subsequent reads and writes.
 184 --
 185 -- If the buffer mode is changed from 'BlockBuffering' or
 186 -- 'LineBuffering' to 'NoBuffering', then
 187 --
 188 --  * if @hdl@ is writable, the buffer is flushed as for 'hFlush';
 189 --
 190 --  * if @hdl@ is not writable, the contents of the buffer is discarded.
 191 --
 192 -- This operation may fail with:
 193 --
 194 --  * 'isPermissionError' if the handle has already been used for reading
 195 --    or writing and the implementation does not allow the buffering mode
 196 --    to be changed.
 197
 198 hSetBuffering :: Handle -> BufferMode -> IO ()
 199 hSetBuffering handle mode =
 200   withAllHandles__ "hSetBuffering" handle $ \ handle_@Handle__{..} -> do
 201   case haType of
 202     ClosedHandle -> ioe_closedHandle
 203     _ -> do
 204          if mode == haBufferMode then return handle_ else do
 205
 206          -- See [note Buffer Sizing] in GHC.IO.Handle.Types
 207
 208           -- check for errors:
 209           case mode of
 210               BlockBuffering (Just n) | n <= 0    -> ioe_bufsiz n
 211               _ -> return ()
 212
 213           -- for input terminals we need to put the terminal into
 214           -- cooked or raw mode depending on the type of buffering.
 215           is_tty <- IODevice.isTerminal haDevice
 216           when (is_tty && isReadableHandleType haType) $
 217                 case mode of
 218 #ifndef mingw32_HOST_OS
 219         -- 'raw' mode under win32 is a bit too specialised (and troublesome
 220         -- for most common uses), so simply disable its use here.
 221                   NoBuffering -> IODevice.setRaw haDevice True
 222 #else
 223                   NoBuffering -> return ()
 224 #endif
 225                   _           -> IODevice.setRaw haDevice False
 226
 227           -- throw away spare buffers, they might be the wrong size
 228           writeIORef haBuffers BufferListNil
 229
 230           return Handle__{ haBufferMode = mode,.. }
 231
 232 -- -----------------------------------------------------------------------------
 233 -- hSetEncoding
 234
 235 -- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding
 236 -- for the handle @hdl@ to @encoding@.  The default encoding when a 'Handle' is
 237 -- created is 'localeEncoding', namely the default encoding for the current
 238 -- locale.
 239 --
 240 -- To create a 'Handle' with no encoding at all, use 'openBinaryFile'.  To
 241 -- stop further encoding or decoding on an existing 'Handle', use
 242 -- 'hSetBinaryMode'.
 243 --
 244 -- 'hSetEncoding' may need to flush buffered data in order to change
 245 -- the encoding.
 246 --
 247 hSetEncoding :: Handle -> TextEncoding -> IO ()
 248 hSetEncoding hdl encoding = do
 249   withAllHandles__ "hSetEncoding" hdl $ \h_@Handle__{..} -> do
 250     flushCharBuffer h_
 251     closeTextCodecs h_
 252     openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do
 253     bbuf <- readIORef haByteBuffer
 254     ref <- newIORef (error "last_decode")
 255     return (Handle__{ haLastDecode = ref,
 256                       haDecoder = mb_decoder,
 257                       haEncoder = mb_encoder,
 258                       haCodec   = Just encoding, .. })
 259
 260 -- | Return the current 'TextEncoding' for the specified 'Handle', or
 261 -- 'Nothing' if the 'Handle' is in binary mode.
 262 --
 263 -- Note that the 'TextEncoding' remembers nothing about the state of
 264 -- the encoder/decoder in use on this 'Handle'.  For example, if the
 265 -- encoding in use is UTF-16, then using 'hGetEncoding' and
 266 -- 'hSetEncoding' to save and restore the encoding may result in an
 267 -- extra byte-order-mark being written to the file.
 268 --
 269 hGetEncoding :: Handle -> IO (Maybe TextEncoding)
 270 hGetEncoding hdl =
 271   withHandle_ "hGetEncoding" hdl $ \h_@Handle__{..} -> return haCodec
 272
 273 -- -----------------------------------------------------------------------------
 274 -- hFlush
 275
 276 -- | The action 'hFlush' @hdl@ causes any items buffered for output
 277 -- in handle @hdl@ to be sent immediately to the operating system.
 278 --
 279 -- This operation may fail with:
 280 --
 281 --  * 'isFullError' if the device is full;
 282 --
 283 --  * 'isPermissionError' if a system resource limit would be exceeded.
 284 --    It is unspecified whether the characters in the buffer are discarded
 285 --    or retained under these circumstances.
 286
 287 hFlush :: Handle -> IO ()
 288 hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer
 289
 290 -- | The action 'hFlushAll' @hdl@ flushes all buffered data in @hdl@,
 291 -- including any buffered read data.  Buffered read data is flushed
 292 -- by seeking the file position back to the point before the bufferred
 293 -- data was read, and hence only works if @hdl@ is seekable (see
 294 -- 'hIsSeekable').
 295 --
 296 -- This operation may fail with:
 297 --
 298 --  * 'isFullError' if the device is full;
 299 --
 300 --  * 'isPermissionError' if a system resource limit would be exceeded.
 301 --    It is unspecified whether the characters in the buffer are discarded
 302 --    or retained under these circumstances;
 303 --
 304 --  * 'isIllegalOperation' if @hdl@ has buffered read data, and is not
 305 --    seekable.
 306
 307 hFlushAll :: Handle -> IO ()
 308 hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer
 309
 310 -- -----------------------------------------------------------------------------
 311 -- Repositioning Handles
 312
 313 data HandlePosn = HandlePosn Handle HandlePosition
 314
 315 instance Eq HandlePosn where
 316     (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
 317
 318 instance Show HandlePosn where
 319    showsPrec p (HandlePosn h pos) =
 320         showsPrec p h . showString " at position " . shows pos
 321
 322   -- HandlePosition is the Haskell equivalent of POSIX' off_t.
 323   -- We represent it as an Integer on the Haskell side, but
 324   -- cheat slightly in that hGetPosn calls upon a C helper
 325   -- that reports the position back via (merely) an Int.
 326 type HandlePosition = Integer
 327
 328 -- | Computation 'hGetPosn' @hdl@ returns the current I\/O position of
 329 -- @hdl@ as a value of the abstract type 'HandlePosn'.
 330
 331 hGetPosn :: Handle -> IO HandlePosn
 332 hGetPosn handle = do
 333     posn <- hTell handle
 334     return (HandlePosn handle posn)
 335
 336 -- | If a call to 'hGetPosn' @hdl@ returns a position @p@,
 337 -- then computation 'hSetPosn' @p@ sets the position of @hdl@
 338 -- to the position it held at the time of the call to 'hGetPosn'.
 339 --
 340 -- This operation may fail with:
 341 --
 342 --  * 'isPermissionError' if a system resource limit would be exceeded.
 343
 344 hSetPosn :: HandlePosn -> IO ()
 345 hSetPosn (HandlePosn h i) = hSeek h AbsoluteSeek i
 346
 347 -- ---------------------------------------------------------------------------
 348 -- hSeek
 349
 350 {- Note:
 351  - when seeking using `SeekFromEnd', positive offsets (>=0) means
 352    seeking at or past EOF.
 353
 354  - we possibly deviate from the report on the issue of seeking within
 355    the buffer and whether to flush it or not.  The report isn't exactly
 356    clear here.
 357 -}
 358
 359 -- | Computation 'hSeek' @hdl mode i@ sets the position of handle
 360 -- @hdl@ depending on @mode@.
 361 -- The offset @i@ is given in terms of 8-bit bytes.
 362 --
 363 -- If @hdl@ is block- or line-buffered, then seeking to a position which is not
 364 -- in the current buffer will first cause any items in the output buffer to be
 365 -- written to the device, and then cause the input buffer to be discarded.
 366 -- Some handles may not be seekable (see 'hIsSeekable'), or only support a
 367 -- subset of the possible positioning operations (for instance, it may only
 368 -- be possible to seek to the end of a tape, or to a positive offset from
 369 -- the beginning or current position).
 370 -- It is not possible to set a negative I\/O position, or for
 371 -- a physical file, an I\/O position beyond the current end-of-file.
 372 --
 373 -- This operation may fail with:
 374 --
 375 --  * 'isIllegalOperationError' if the Handle is not seekable, or does
 376 --     not support the requested seek mode.
 377 --
 378 --  * 'isPermissionError' if a system resource limit would be exceeded.
 379
 380 hSeek :: Handle -> SeekMode -> Integer -> IO ()
 381 hSeek handle mode offset =
 382     wantSeekableHandle "hSeek" handle $ \ handle_@Handle__{..} -> do
 383     debugIO ("hSeek " ++ show (mode,offset))
 384     buf <- readIORef haCharBuffer
 385
 386     if isWriteBuffer buf
 387         then do flushWriteBuffer handle_
 388                 IODevice.seek haDevice mode offset
 389         else do
 390
 391     let r = bufL buf; w = bufR buf
 392     if mode == RelativeSeek && isNothing haDecoder &&
 393        offset >= 0 && offset < fromIntegral (w - r)
 394         then writeIORef haCharBuffer buf{ bufL = r + fromIntegral offset }
 395         else do
 396
 397     flushCharReadBuffer handle_
 398     flushByteReadBuffer handle_
 399     IODevice.seek haDevice mode offset
 400
 401
 402 -- | Computation 'hTell' @hdl@ returns the current position of the
 403 -- handle @hdl@, as the number of bytes from the beginning of
 404 -- the file.  The value returned may be subsequently passed to
 405 -- 'hSeek' to reposition the handle to the current position.
 406 --
 407 -- This operation may fail with:
 408 --
 409 --  * 'isIllegalOperationError' if the Handle is not seekable.
 410 --
 411 hTell :: Handle -> IO Integer
 412 hTell handle =
 413     wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do
 414
 415       posn <- IODevice.tell haDevice
 416
 417       -- we can't tell the real byte offset if there are buffered
 418       -- Chars, so must flush first:
 419       flushCharBuffer handle_
 420
 421       bbuf <- readIORef haByteBuffer
 422
 423       let real_posn
 424            | isWriteBuffer bbuf = posn + fromIntegral (bufferElems bbuf)
 425            | otherwise          = posn - fromIntegral (bufferElems bbuf)
 426
 427       cbuf <- readIORef haCharBuffer
 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