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