1 {-# LANGUAGE NoImplicitPrelude
5 , NondecreasingIndentation
8 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
9 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
10 {-# OPTIONS_HADDOCK hide #-}
12 -----------------------------------------------------------------------------
14 -- Module : GHC.IO.Handle.Internals
15 -- Copyright : (c) The University of Glasgow, 1994-2001
16 -- License : see libraries/base/LICENSE
18 -- Maintainer : libraries@haskell.org
19 -- Stability : internal
20 -- Portability : non-portable
22 -- This module defines the basic operations on I\/O \"handles\". All
23 -- of the operations defined here are independent of the underlying
26 -----------------------------------------------------------------------------
29 module GHC.IO.Handle.Internals (
30 withHandle, withHandle', withHandle_,
31 withHandle__', withHandle_', withAllHandles__,
32 wantWritableHandle, wantReadableHandle, wantReadableHandle_,
35 mkHandle, mkFileHandle, mkDuplexHandle,
36 openTextEncoding, closeTextCodecs, initBufferState,
37 dEFAULT_CHAR_BUFFER_SIZE,
39 flushBuffer, flushWriteBuffer, flushCharReadBuffer,
40 flushCharBuffer, flushByteReadBuffer, flushByteWriteBuffer,
42 readTextDevice, writeCharBuffer, readTextDeviceNonBlocking,
46 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
47 ioe_finalizedHandle, ioe_bufsiz,
49 hClose_help, hLookAhead_,
51 HandleFinalizer, handleFinalizer,
58 import GHC.IO.Encoding as Encoding
59 import GHC.IO.Handle.Types
61 import GHC.IO.BufferedIO (BufferedIO)
62 import GHC.IO.Exception
63 import GHC.IO.Device (IODevice, SeekMode(..))
64 import qualified GHC.IO.Device as IODevice
65 import qualified GHC.IO.BufferedIO as Buffered
71 import GHC.Num ( Num(..) )
78 import Foreign hiding (unsafePerformIO)
79 -- import System.IO.Error
80 import System.Posix.Internals hiding (FD)
87 -- ---------------------------------------------------------------------------
88 -- Creating a new handle
90 type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()
92 newFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle
93 newFileHandle filepath mb_finalizer hc = do
96 Just finalizer -> addMVarFinalizer m (finalizer filepath m)
98 return (FileHandle filepath m)
100 -- ---------------------------------------------------------------------------
101 -- Working with Handles
104 In the concurrent world, handles are locked during use. This is done
105 by wrapping an MVar around the handle which acts as a mutex over
106 operations on the handle.
108 To avoid races, we use the following bracketing operations. The idea
109 is to obtain the lock, do some operation and replace the lock again,
110 whether the operation succeeded or failed. We also want to handle the
111 case where the thread receives an exception while processing the IO
112 operation: in these cases we also want to relinquish the lock.
114 There are three versions of @withHandle@: corresponding to the three
115 possible combinations of:
117 - the operation may side-effect the handle
118 - the operation may return a result
120 If the operation generates an error or an exception is raised, the
121 original handle is always replaced.
124 {-# INLINE withHandle #-}
125 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
126 withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act
127 withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
129 withHandle' :: String -> Handle -> MVar Handle__
130 -> (Handle__ -> IO (Handle__,a)) -> IO a
131 withHandle' fun h m act =
133 (h',v) <- do_operation fun h act m
134 checkHandleInvariants h'
138 {-# INLINE withHandle_ #-}
139 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
140 withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act
141 withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
143 withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
144 withHandle_' fun h m act = withHandle' fun h m $ \h_ -> do
148 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
149 withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act
150 withAllHandles__ fun h@(DuplexHandle _ r w) act = do
151 withHandle__' fun h r act
152 withHandle__' fun h w act
154 withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
156 withHandle__' fun h m act =
158 h' <- do_operation fun h act m
159 checkHandleInvariants h'
163 do_operation :: String -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
164 do_operation fun h act m = do
166 checkHandleInvariants h_
167 act h_ `catchException` handler h_
172 _ | Just ioe <- fromException e ->
173 ioError (augmentIOError ioe fun h)
174 _ | Just async_ex <- fromException e -> do -- see Note [async]
175 let _ = async_ex :: AsyncException
178 do_operation fun h act m
184 -- If an asynchronous exception is raised during an I/O operation,
185 -- normally it is fine to just re-throw the exception synchronously.
186 -- However, if we are inside an unsafePerformIO or an
187 -- unsafeInterleaveIO, this would replace the enclosing thunk with the
188 -- exception raised, which is wrong (#3997). We have to release the
189 -- lock on the Handle, but what do we replace the thunk with? What
190 -- should happen when the thunk is subsequently demanded again?
192 -- The only sensible choice we have is to re-do the IO operation on
193 -- resumption, but then we have to be careful in the IO library that
194 -- this is always safe to do. In particular we should
196 -- never perform any side-effects before an interruptible operation
198 -- because the interruptible operation may raise an asynchronous
199 -- exception, which may cause the operation and its side effects to be
200 -- subsequently performed again.
202 -- Re-doing the IO operation is achieved by:
203 -- - using throwTo to re-throw the asynchronous exception asynchronously
204 -- in the current thread
205 -- - on resumption, it will be as if throwTo returns. In that case, we
206 -- recursively invoke the original operation (see do_operation above).
208 -- Interruptible operations in the I/O library are:
209 -- - threadWaitRead/threadWaitWrite
210 -- - fillReadBuffer/flushWriteBuffer
211 -- - readTextDevice/writeTextDevice
213 augmentIOError :: IOException -> String -> Handle -> IOException
214 augmentIOError ioe@IOError{ ioe_filename = fp } fun h
215 = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
218 | otherwise = case h of
219 FileHandle path _ -> Just path
220 DuplexHandle path _ _ -> Just path
222 -- ---------------------------------------------------------------------------
223 -- Wrapper for write operations.
225 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
226 wantWritableHandle fun h@(FileHandle _ m) act
227 = wantWritableHandle' fun h m act
228 wantWritableHandle fun h@(DuplexHandle _ _ m) act
229 = wantWritableHandle' fun h m act
230 -- we know it's not a ReadHandle or ReadWriteHandle, but we have to
231 -- check for ClosedHandle/SemiClosedHandle. (#4808)
234 :: String -> Handle -> MVar Handle__
235 -> (Handle__ -> IO a) -> IO a
236 wantWritableHandle' fun h m act
237 = withHandle_' fun h m (checkWritableHandle act)
239 checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
240 checkWritableHandle act h_@Handle__{..}
242 ClosedHandle -> ioe_closedHandle
243 SemiClosedHandle -> ioe_closedHandle
244 ReadHandle -> ioe_notWritable
245 ReadWriteHandle -> do
246 buf <- readIORef haCharBuffer
247 when (not (isWriteBuffer buf)) $ do
248 flushCharReadBuffer h_
249 flushByteReadBuffer h_
250 buf <- readIORef haCharBuffer
251 writeIORef haCharBuffer buf{ bufState = WriteBuffer }
252 buf <- readIORef haByteBuffer
253 buf' <- Buffered.emptyWriteBuffer haDevice buf
254 writeIORef haByteBuffer buf'
258 -- ---------------------------------------------------------------------------
259 -- Wrapper for read operations.
261 wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
262 wantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)
264 wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
265 wantReadableHandle_ fun h@(FileHandle _ m) act
266 = wantReadableHandle' fun h m act
267 wantReadableHandle_ fun h@(DuplexHandle _ m _) act
268 = wantReadableHandle' fun h m act
269 -- we know it's not a WriteHandle or ReadWriteHandle, but we have to
270 -- check for ClosedHandle/SemiClosedHandle. (#4808)
273 :: String -> Handle -> MVar Handle__
274 -> (Handle__ -> IO a) -> IO a
275 wantReadableHandle' fun h m act
276 = withHandle_' fun h m (checkReadableHandle act)
278 checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
279 checkReadableHandle act h_@Handle__{..} =
281 ClosedHandle -> ioe_closedHandle
282 SemiClosedHandle -> ioe_closedHandle
283 AppendHandle -> ioe_notReadable
284 WriteHandle -> ioe_notReadable
285 ReadWriteHandle -> do
286 -- a read/write handle and we want to read from it. We must
287 -- flush all buffered write data first.
288 bbuf <- readIORef haByteBuffer
289 when (isWriteBuffer bbuf) $ do
290 when (not (isEmptyBuffer bbuf)) $ flushByteWriteBuffer h_
291 cbuf' <- readIORef haCharBuffer
292 writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }
293 bbuf <- readIORef haByteBuffer
294 writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }
298 -- ---------------------------------------------------------------------------
299 -- Wrapper for seek operations.
301 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
302 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
303 ioException (IOError (Just h) IllegalOperation fun
304 "handle is not seekable" Nothing Nothing)
305 wantSeekableHandle fun h@(FileHandle _ m) act =
306 withHandle_' fun h m (checkSeekableHandle act)
308 checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
309 checkSeekableHandle act handle_@Handle__{haDevice=dev} =
310 case haType handle_ of
311 ClosedHandle -> ioe_closedHandle
312 SemiClosedHandle -> ioe_closedHandle
313 AppendHandle -> ioe_notSeekable
314 _ -> do b <- IODevice.isSeekable dev
315 if b then act handle_
318 -- -----------------------------------------------------------------------------
321 ioe_closedHandle, ioe_EOF,
322 ioe_notReadable, ioe_notWritable, ioe_cannotFlushNotSeekable,
323 ioe_notSeekable, ioe_invalidCharacter :: IO a
325 ioe_closedHandle = ioException
326 (IOError Nothing IllegalOperation ""
327 "handle is closed" Nothing Nothing)
328 ioe_EOF = ioException
329 (IOError Nothing EOF "" "" Nothing Nothing)
330 ioe_notReadable = ioException
331 (IOError Nothing IllegalOperation ""
332 "handle is not open for reading" Nothing Nothing)
333 ioe_notWritable = ioException
334 (IOError Nothing IllegalOperation ""
335 "handle is not open for writing" Nothing Nothing)
336 ioe_notSeekable = ioException
337 (IOError Nothing IllegalOperation ""
338 "handle is not seekable" Nothing Nothing)
339 ioe_cannotFlushNotSeekable = ioException
340 (IOError Nothing IllegalOperation ""
341 "cannot flush the read buffer: underlying device is not seekable"
343 ioe_invalidCharacter = ioException
344 (IOError Nothing InvalidArgument ""
345 ("invalid byte sequence for this encoding") Nothing Nothing)
347 ioe_finalizedHandle :: FilePath -> Handle__
348 ioe_finalizedHandle fp = throw
349 (IOError Nothing IllegalOperation ""
350 "handle is finalized" Nothing (Just fp))
352 ioe_bufsiz :: Int -> IO a
353 ioe_bufsiz n = ioException
354 (IOError Nothing InvalidArgument "hSetBuffering"
355 ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
356 -- 9 => should be parens'ified.
358 -- ---------------------------------------------------------------------------
359 -- Wrapper for Handle encoding/decoding.
361 -- The interface for TextEncoding changed so that a TextEncoding doesn't raise
362 -- an exception if it encounters an invalid sequnce. Furthermore, encoding
363 -- returns a reason as to why encoding stopped, letting us know if it was due
364 -- to input/output underflow or an invalid sequence.
366 -- This code adapts this elaborated interface back to the original TextEncoding
369 -- FIXME: it is possible that Handle code using the haDecoder/haEncoder fields
370 -- could be made clearer by using the 'encode' interface directly. I have not
373 -- FIXME: we should use recover to deal with EOF, rather than always throwing an
374 -- IOException (ioe_invalidCharacter).
376 streamEncode :: BufferCodec from to state
377 -> Buffer from -> Buffer to
378 -> IO (Buffer from, Buffer to)
379 streamEncode codec from to = go (from, to)
382 (why, from', to') <- encode codec from to
383 -- When we are dealing with Handles, we don't care about input/output
384 -- underflow particularly, and we want to delay errors about invalid
385 -- sequences as far as possible.
387 Encoding.InvalidSequence | bufL from == bufL from' -> recover codec from' to' >>= go
388 _ -> return (from', to')
390 -- -----------------------------------------------------------------------------
393 -- For a duplex handle, we arrange that the read side points to the write side
394 -- (and hence keeps it alive if the read side is alive). This is done by
395 -- having the haOtherSide field of the read side point to the read side.
396 -- The finalizer is then placed on the write side, and the handle only gets
397 -- finalized once, when both sides are no longer required.
399 -- NOTE about finalized handles: It's possible that a handle can be
400 -- finalized and then we try to use it later, for example if the
401 -- handle is referenced from another finalizer, or from a thread that
402 -- has become unreferenced and then resurrected (arguably in the
403 -- latter case we shouldn't finalize the Handle...). Anyway,
404 -- we try to emit a helpful message which is better than nothing.
406 -- [later; 8/2010] However, a program like this can yield a strange
409 -- main = writeFile "out" loop
410 -- loop = let x = x in x
412 -- because the main thread and the Handle are both unreachable at the
413 -- same time, the Handle may get finalized before the main thread
414 -- receives the NonTermination exception, and the exception handler
415 -- will then report an error. We'd rather this was not an error and
416 -- the program just prints "<<loop>>".
418 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
419 handleFinalizer fp m = do
420 handle_ <- takeMVar m
421 (handle_', _) <- hClose_help handle_
425 -- ---------------------------------------------------------------------------
426 -- Allocating buffers
428 -- using an 8k char buffer instead of 32k improved performance for a
429 -- basic "cat" program by ~30% for me. --SDM
430 dEFAULT_CHAR_BUFFER_SIZE :: Int
431 dEFAULT_CHAR_BUFFER_SIZE = 2048 -- 8k/sizeof(HsChar)
433 getCharBuffer :: IODevice dev => dev -> BufferState
434 -> IO (IORef CharBuffer, BufferMode)
435 getCharBuffer dev state = do
436 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
437 ioref <- newIORef buffer
438 is_tty <- IODevice.isTerminal dev
441 | is_tty = LineBuffering
442 | otherwise = BlockBuffering Nothing
444 return (ioref, buffer_mode)
446 mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
447 mkUnBuffer state = do
448 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
449 -- See [note Buffer Sizing], GHC.IO.Handle.Types
450 ref <- newIORef buffer
451 return (ref, NoBuffering)
453 -- -----------------------------------------------------------------------------
456 -- | syncs the file with the buffer, including moving the
457 -- file pointer backwards in the case of a read buffer. This can fail
458 -- on a non-seekable read Handle.
459 flushBuffer :: Handle__ -> IO ()
460 flushBuffer h_@Handle__{..} = do
461 buf <- readIORef haCharBuffer
464 flushCharReadBuffer h_
465 flushByteReadBuffer h_
467 flushByteWriteBuffer h_
469 -- | flushes the Char buffer only. Works on all Handles.
470 flushCharBuffer :: Handle__ -> IO ()
471 flushCharBuffer h_@Handle__{..} = do
472 cbuf <- readIORef haCharBuffer
473 case bufState cbuf of
475 flushCharReadBuffer h_
477 when (not (isEmptyBuffer cbuf)) $
478 error "internal IO library error: Char buffer non-empty"
480 -- -----------------------------------------------------------------------------
481 -- Writing data (flushing write buffers)
483 -- flushWriteBuffer flushes the buffer iff it contains pending write
484 -- data. Flushes both the Char and the byte buffer, leaving both
486 flushWriteBuffer :: Handle__ -> IO ()
487 flushWriteBuffer h_@Handle__{..} = do
488 buf <- readIORef haByteBuffer
489 when (isWriteBuffer buf) $ flushByteWriteBuffer h_
491 flushByteWriteBuffer :: Handle__ -> IO ()
492 flushByteWriteBuffer h_@Handle__{..} = do
493 bbuf <- readIORef haByteBuffer
494 when (not (isEmptyBuffer bbuf)) $ do
495 bbuf' <- Buffered.flushWriteBuffer haDevice bbuf
496 writeIORef haByteBuffer bbuf'
498 -- write the contents of the CharBuffer to the Handle__.
499 -- The data will be encoded and pushed to the byte buffer,
500 -- flushing if the buffer becomes full.
501 writeCharBuffer :: Handle__ -> CharBuffer -> IO ()
502 writeCharBuffer h_@Handle__{..} !cbuf = do
504 bbuf <- readIORef haByteBuffer
506 debugIO ("writeCharBuffer: cbuf=" ++ summaryBuffer cbuf ++
507 " bbuf=" ++ summaryBuffer bbuf)
509 (cbuf',bbuf') <- case haEncoder of
510 Nothing -> latin1_encode cbuf bbuf
511 Just encoder -> (streamEncode encoder) cbuf bbuf
513 debugIO ("writeCharBuffer after encoding: cbuf=" ++ summaryBuffer cbuf' ++
514 " bbuf=" ++ summaryBuffer bbuf')
516 -- flush if the write buffer is full
517 if isFullBuffer bbuf'
518 -- or we made no progress
519 || not (isEmptyBuffer cbuf') && bufL cbuf' == bufL cbuf
520 -- or the byte buffer has more elements than the user wanted buffered
521 || (case haBufferMode of
522 BlockBuffering (Just s) -> bufferElems bbuf' >= s
526 bbuf'' <- Buffered.flushWriteBuffer haDevice bbuf'
527 writeIORef haByteBuffer bbuf''
529 writeIORef haByteBuffer bbuf'
531 if not (isEmptyBuffer cbuf')
532 then writeCharBuffer h_ cbuf'
535 -- -----------------------------------------------------------------------------
536 -- Flushing read buffers
538 -- It is always possible to flush the Char buffer back to the byte buffer.
539 flushCharReadBuffer :: Handle__ -> IO ()
540 flushCharReadBuffer Handle__{..} = do
541 cbuf <- readIORef haCharBuffer
542 if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
544 -- haLastDecode is the byte buffer just before we did our last batch of
545 -- decoding. We're going to re-decode the bytes up to the current char,
546 -- to find out where we should revert the byte buffer to.
547 (codec_state, bbuf0) <- readIORef haLastDecode
549 cbuf0 <- readIORef haCharBuffer
550 writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
552 -- if we haven't used any characters from the char buffer, then just
553 -- re-install the old byte buffer.
555 then do writeIORef haByteBuffer bbuf0
561 writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
562 -- no decoder: the number of bytes to decode is the same as the
563 -- number of chars we have used up.
566 debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
567 " cbuf=" ++ summaryBuffer cbuf0)
569 -- restore the codec state
570 setState decoder codec_state
572 (bbuf1,cbuf1) <- (streamEncode decoder) bbuf0
573 cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
575 debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
576 " cbuf=" ++ summaryBuffer cbuf1)
578 writeIORef haByteBuffer bbuf1
581 -- When flushing the byte read buffer, we seek backwards by the number
582 -- of characters in the buffer. The file descriptor must therefore be
583 -- seekable: attempting to flush the read buffer on an unseekable
584 -- handle is not allowed.
586 flushByteReadBuffer :: Handle__ -> IO ()
587 flushByteReadBuffer h_@Handle__{..} = do
588 bbuf <- readIORef haByteBuffer
590 if isEmptyBuffer bbuf then return () else do
592 seekable <- IODevice.isSeekable haDevice
593 when (not seekable) $ ioe_cannotFlushNotSeekable
595 let seek = negate (bufR bbuf - bufL bbuf)
597 debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
598 IODevice.seek haDevice RelativeSeek (fromIntegral seek)
600 writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
602 -- ----------------------------------------------------------------------------
605 mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
609 -> Maybe TextEncoding
611 -> Maybe HandleFinalizer
612 -> Maybe (MVar Handle__)
615 mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
616 openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
618 let buf_state = initBufferState ha_type
619 bbuf <- Buffered.newBuffer dev buf_state
620 bbufref <- newIORef bbuf
621 last_decode <- newIORef (error "codec_state", bbuf)
624 if buffered then getCharBuffer dev buf_state
625 else mkUnBuffer buf_state
627 spares <- newIORef BufferListNil
628 newFileHandle filepath finalizer
629 (Handle__ { haDevice = dev,
631 haBufferMode = bmode,
632 haByteBuffer = bbufref,
633 haLastDecode = last_decode,
634 haCharBuffer = cbufref,
636 haEncoder = mb_encoder,
637 haDecoder = mb_decoder,
639 haInputNL = inputNL nl,
640 haOutputNL = outputNL nl,
641 haOtherSide = other_side
644 -- | makes a new 'Handle'
645 mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
646 => dev -- ^ the underlying IO device, which must support
647 -- 'IODevice', 'BufferedIO' and 'Typeable'
649 -- ^ a string describing the 'Handle', e.g. the file
650 -- path for a file. Used in error messages.
652 -- The mode in which the 'Handle' is to be used
653 -> Maybe TextEncoding
654 -- Create the 'Handle' with no text encoding?
656 -- Translate newlines?
658 mkFileHandle dev filepath iomode mb_codec tr_newlines = do
659 mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec
661 (Just handleFinalizer) Nothing{-other_side-}
663 -- | like 'mkFileHandle', except that a 'Handle' is created with two
664 -- independent buffers, one for reading and one for writing. Used for
665 -- full-duplex streams, such as network sockets.
666 mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
667 -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
668 mkDuplexHandle dev filepath mb_codec tr_newlines = do
670 write_side@(FileHandle _ write_m) <-
671 mkHandle dev filepath WriteHandle True mb_codec
673 (Just handleFinalizer)
674 Nothing -- no othersie
676 read_side@(FileHandle _ read_m) <-
677 mkHandle dev filepath ReadHandle True mb_codec
679 Nothing -- no finalizer
682 return (DuplexHandle filepath read_m write_m)
684 ioModeToHandleType :: IOMode -> HandleType
685 ioModeToHandleType ReadMode = ReadHandle
686 ioModeToHandleType WriteMode = WriteHandle
687 ioModeToHandleType ReadWriteMode = ReadWriteHandle
688 ioModeToHandleType AppendMode = AppendHandle
690 initBufferState :: HandleType -> BufferState
691 initBufferState ReadHandle = ReadBuffer
692 initBufferState _ = WriteBuffer
695 :: Maybe TextEncoding
697 -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
700 openTextEncoding Nothing ha_type cont = cont Nothing Nothing
701 openTextEncoding (Just TextEncoding{..}) ha_type cont = do
702 mb_decoder <- if isReadableHandleType ha_type then do
703 decoder <- mkTextDecoder
704 return (Just decoder)
707 mb_encoder <- if isWritableHandleType ha_type then do
708 encoder <- mkTextEncoder
709 return (Just encoder)
712 cont mb_encoder mb_decoder
714 closeTextCodecs :: Handle__ -> IO ()
715 closeTextCodecs Handle__{..} = do
716 case haDecoder of Nothing -> return (); Just d -> Encoding.close d
717 case haEncoder of Nothing -> return (); Just d -> Encoding.close d
719 -- ---------------------------------------------------------------------------
722 -- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
723 -- EOF is read or an IO error occurs on a lazy stream. The
724 -- semi-closed Handle is then closed immediately. We have to be
725 -- careful with DuplexHandles though: we have to leave the closing to
726 -- the finalizer in that case, because the write side may still be in
728 hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
729 hClose_help handle_ =
730 case haType handle_ of
731 ClosedHandle -> return (handle_,Nothing)
732 _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
733 -- it is important that hClose doesn't fail and
734 -- leave the Handle open (#3128), so we catch
735 -- exceptions when flushing the buffer.
736 (h_, mb_exc2) <- hClose_handle_ handle_
737 return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
740 trymaybe :: IO () -> IO (Maybe SomeException)
741 trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
743 hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
744 hClose_handle_ h_@Handle__{..} = do
746 -- close the file descriptor, but not when this is the read
747 -- side of a duplex handle.
748 -- If an exception is raised by the close(), we want to continue
749 -- to close the handle and release the lock if it has one, then
750 -- we return the exception to the caller of hClose_help which can
751 -- raise it if necessary.
754 Nothing -> trymaybe $ IODevice.close haDevice
755 Just _ -> return Nothing
757 -- free the spare buffers
758 writeIORef haBuffers BufferListNil
759 writeIORef haCharBuffer noCharBuffer
760 writeIORef haByteBuffer noByteBuffer
762 -- release our encoder/decoder
765 -- we must set the fd to -1, because the finalizer is going
766 -- to run eventually and try to close/unlock it.
767 -- ToDo: necessary? the handle will be marked ClosedHandle
768 -- XXX GHC won't let us use record update here, hence wildcards
769 return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)
771 {-# NOINLINE noCharBuffer #-}
772 noCharBuffer :: CharBuffer
773 noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer
775 {-# NOINLINE noByteBuffer #-}
776 noByteBuffer :: Buffer Word8
777 noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer
779 -- ---------------------------------------------------------------------------
782 hLookAhead_ :: Handle__ -> IO Char
783 hLookAhead_ handle_@Handle__{..} = do
784 buf <- readIORef haCharBuffer
786 -- fill up the read buffer if necessary
787 new_buf <- if isEmptyBuffer buf
788 then readTextDevice handle_ buf
790 writeIORef haCharBuffer new_buf
792 peekCharBuf (bufRaw buf) (bufL buf)
794 -- ---------------------------------------------------------------------------
797 debugIO :: String -> IO ()
800 = do _ <- withCStringLen (s ++ "\n") $
801 \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
803 | otherwise = return ()
805 -- ----------------------------------------------------------------------------
808 -- Read characters into the provided buffer. Return when any
809 -- characters are available; raise an exception if the end of
811 readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
812 readTextDevice h_@Handle__{..} cbuf = do
814 bbuf0 <- readIORef haByteBuffer
816 debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++
817 " bbuf=" ++ summaryBuffer bbuf0)
819 bbuf1 <- if not (isEmptyBuffer bbuf0)
822 (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
823 if r == 0 then ioe_EOF else do -- raise EOF
826 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
831 writeIORef haLastDecode (error "codec_state", bbuf1)
832 latin1_decode bbuf1 cbuf
834 state <- getState decoder
835 writeIORef haLastDecode (state, bbuf1)
836 (streamEncode decoder) bbuf1 cbuf
838 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
839 " bbuf=" ++ summaryBuffer bbuf2)
841 writeIORef haByteBuffer bbuf2
842 if bufR cbuf' == bufR cbuf -- no new characters
843 then readTextDevice' h_ bbuf2 cbuf -- we need more bytes to make a Char
846 -- we have an incomplete byte sequence at the end of the buffer: try to
848 readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
849 readTextDevice' h_@Handle__{..} bbuf0 cbuf = do
851 -- copy the partial sequence to the beginning of the buffer, so we have
852 -- room to read more bytes.
853 bbuf1 <- slideContents bbuf0
855 bbuf2 <- do (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
857 then ioe_invalidCharacter
860 debugIO ("readTextDevice' after reading: bbuf=" ++ summaryBuffer bbuf2)
865 writeIORef haLastDecode (error "codec_state", bbuf2)
866 latin1_decode bbuf2 cbuf
868 state <- getState decoder
869 writeIORef haLastDecode (state, bbuf2)
870 (streamEncode decoder) bbuf2 cbuf
872 debugIO ("readTextDevice' after decoding: cbuf=" ++ summaryBuffer cbuf' ++
873 " bbuf=" ++ summaryBuffer bbuf3)
875 writeIORef haByteBuffer bbuf3
876 if bufR cbuf == bufR cbuf'
877 then readTextDevice' h_ bbuf3 cbuf'
880 -- Read characters into the provided buffer. Do not block;
881 -- return zero characters instead. Raises an exception on end-of-file.
882 readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
883 readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
885 bbuf0 <- readIORef haByteBuffer
886 when (isEmptyBuffer bbuf0) $ do
887 (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
888 if isNothing r then ioe_EOF else do -- raise EOF
889 writeIORef haByteBuffer bbuf1
891 decodeByteBuf h_ cbuf
893 -- Decode bytes from the byte buffer into the supplied CharBuffer.
894 decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer
895 decodeByteBuf h_@Handle__{..} cbuf = do
897 bbuf0 <- readIORef haByteBuffer
902 writeIORef haLastDecode (error "codec_state", bbuf0)
903 latin1_decode bbuf0 cbuf
905 state <- getState decoder
906 writeIORef haLastDecode (state, bbuf0)
907 (streamEncode decoder) bbuf0 cbuf
909 writeIORef haByteBuffer bbuf2