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