GHC/IO/Handle.hs

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