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 -- -----------------------------------------------------------------------------
361 -- For a duplex handle, we arrange that the read side points to the write side
362 -- (and hence keeps it alive if the read side is alive). This is done by
363 -- having the haOtherSide field of the read side point to the read side.
364 -- The finalizer is then placed on the write side, and the handle only gets
365 -- finalized once, when both sides are no longer required.
367 -- NOTE about finalized handles: It's possible that a handle can be
368 -- finalized and then we try to use it later, for example if the
369 -- handle is referenced from another finalizer, or from a thread that
370 -- has become unreferenced and then resurrected (arguably in the
371 -- latter case we shouldn't finalize the Handle...). Anyway,
372 -- we try to emit a helpful message which is better than nothing.
374 -- [later; 8/2010] However, a program like this can yield a strange
377 -- main = writeFile "out" loop
378 -- loop = let x = x in x
380 -- because the main thread and the Handle are both unreachable at the
381 -- same time, the Handle may get finalized before the main thread
382 -- receives the NonTermination exception, and the exception handler
383 -- will then report an error. We'd rather this was not an error and
384 -- the program just prints "<<loop>>".
386 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
387 handleFinalizer fp m = do
388 handle_ <- takeMVar m
389 (handle_', _) <- hClose_help handle_
393 -- ---------------------------------------------------------------------------
394 -- Allocating buffers
396 -- using an 8k char buffer instead of 32k improved performance for a
397 -- basic "cat" program by ~30% for me. --SDM
398 dEFAULT_CHAR_BUFFER_SIZE :: Int
399 dEFAULT_CHAR_BUFFER_SIZE = 2048 -- 8k/sizeof(HsChar)
401 getCharBuffer :: IODevice dev => dev -> BufferState
402 -> IO (IORef CharBuffer, BufferMode)
403 getCharBuffer dev state = do
404 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
405 ioref <- newIORef buffer
406 is_tty <- IODevice.isTerminal dev
409 | is_tty = LineBuffering
410 | otherwise = BlockBuffering Nothing
412 return (ioref, buffer_mode)
414 mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
415 mkUnBuffer state = do
416 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
417 -- See [note Buffer Sizing], GHC.IO.Handle.Types
418 ref <- newIORef buffer
419 return (ref, NoBuffering)
421 -- -----------------------------------------------------------------------------
424 -- | syncs the file with the buffer, including moving the
425 -- file pointer backwards in the case of a read buffer. This can fail
426 -- on a non-seekable read Handle.
427 flushBuffer :: Handle__ -> IO ()
428 flushBuffer h_@Handle__{..} = do
429 buf <- readIORef haCharBuffer
432 flushCharReadBuffer h_
433 flushByteReadBuffer h_
435 flushByteWriteBuffer h_
437 -- | flushes the Char buffer only. Works on all Handles.
438 flushCharBuffer :: Handle__ -> IO ()
439 flushCharBuffer h_@Handle__{..} = do
440 cbuf <- readIORef haCharBuffer
441 case bufState cbuf of
443 flushCharReadBuffer h_
445 when (not (isEmptyBuffer cbuf)) $
446 error "internal IO library error: Char buffer non-empty"
448 -- -----------------------------------------------------------------------------
449 -- Writing data (flushing write buffers)
451 -- flushWriteBuffer flushes the buffer iff it contains pending write
452 -- data. Flushes both the Char and the byte buffer, leaving both
454 flushWriteBuffer :: Handle__ -> IO ()
455 flushWriteBuffer h_@Handle__{..} = do
456 buf <- readIORef haByteBuffer
457 when (isWriteBuffer buf) $ flushByteWriteBuffer h_
459 flushByteWriteBuffer :: Handle__ -> IO ()
460 flushByteWriteBuffer h_@Handle__{..} = do
461 bbuf <- readIORef haByteBuffer
462 when (not (isEmptyBuffer bbuf)) $ do
463 bbuf' <- Buffered.flushWriteBuffer haDevice bbuf
464 writeIORef haByteBuffer bbuf'
466 -- write the contents of the CharBuffer to the Handle__.
467 -- The data will be encoded and pushed to the byte buffer,
468 -- flushing if the buffer becomes full.
469 writeCharBuffer :: Handle__ -> CharBuffer -> IO ()
470 writeCharBuffer h_@Handle__{..} !cbuf = do
472 bbuf <- readIORef haByteBuffer
474 debugIO ("writeCharBuffer: cbuf=" ++ summaryBuffer cbuf ++
475 " bbuf=" ++ summaryBuffer bbuf)
477 (cbuf',bbuf') <- case haEncoder of
478 Nothing -> latin1_encode cbuf bbuf
479 Just encoder -> (encode encoder) cbuf bbuf
481 debugIO ("writeCharBuffer after encoding: cbuf=" ++ summaryBuffer cbuf' ++
482 " bbuf=" ++ summaryBuffer bbuf')
484 -- flush if the write buffer is full
485 if isFullBuffer bbuf'
486 -- or we made no progress
487 || not (isEmptyBuffer cbuf') && bufL cbuf' == bufL cbuf
488 -- or the byte buffer has more elements than the user wanted buffered
489 || (case haBufferMode of
490 BlockBuffering (Just s) -> bufferElems bbuf' >= s
494 bbuf'' <- Buffered.flushWriteBuffer haDevice bbuf'
495 writeIORef haByteBuffer bbuf''
497 writeIORef haByteBuffer bbuf'
499 if not (isEmptyBuffer cbuf')
500 then writeCharBuffer h_ cbuf'
503 -- -----------------------------------------------------------------------------
504 -- Flushing read buffers
506 -- It is always possible to flush the Char buffer back to the byte buffer.
507 flushCharReadBuffer :: Handle__ -> IO ()
508 flushCharReadBuffer Handle__{..} = do
509 cbuf <- readIORef haCharBuffer
510 if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
512 -- haLastDecode is the byte buffer just before we did our last batch of
513 -- decoding. We're going to re-decode the bytes up to the current char,
514 -- to find out where we should revert the byte buffer to.
515 (codec_state, bbuf0) <- readIORef haLastDecode
517 cbuf0 <- readIORef haCharBuffer
518 writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
520 -- if we haven't used any characters from the char buffer, then just
521 -- re-install the old byte buffer.
523 then do writeIORef haByteBuffer bbuf0
529 writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
530 -- no decoder: the number of bytes to decode is the same as the
531 -- number of chars we have used up.
534 debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
535 " cbuf=" ++ summaryBuffer cbuf0)
537 -- restore the codec state
538 setState decoder codec_state
540 (bbuf1,cbuf1) <- (encode decoder) bbuf0
541 cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
543 debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
544 " cbuf=" ++ summaryBuffer cbuf1)
546 writeIORef haByteBuffer bbuf1
549 -- When flushing the byte read buffer, we seek backwards by the number
550 -- of characters in the buffer. The file descriptor must therefore be
551 -- seekable: attempting to flush the read buffer on an unseekable
552 -- handle is not allowed.
554 flushByteReadBuffer :: Handle__ -> IO ()
555 flushByteReadBuffer h_@Handle__{..} = do
556 bbuf <- readIORef haByteBuffer
558 if isEmptyBuffer bbuf then return () else do
560 seekable <- IODevice.isSeekable haDevice
561 when (not seekable) $ ioe_cannotFlushNotSeekable
563 let seek = negate (bufR bbuf - bufL bbuf)
565 debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
566 IODevice.seek haDevice RelativeSeek (fromIntegral seek)
568 writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
570 -- ----------------------------------------------------------------------------
573 mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
577 -> Maybe TextEncoding
579 -> Maybe HandleFinalizer
580 -> Maybe (MVar Handle__)
583 mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
584 openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
586 let buf_state = initBufferState ha_type
587 bbuf <- Buffered.newBuffer dev buf_state
588 bbufref <- newIORef bbuf
589 last_decode <- newIORef (error "codec_state", bbuf)
592 if buffered then getCharBuffer dev buf_state
593 else mkUnBuffer buf_state
595 spares <- newIORef BufferListNil
596 newFileHandle filepath finalizer
597 (Handle__ { haDevice = dev,
599 haBufferMode = bmode,
600 haByteBuffer = bbufref,
601 haLastDecode = last_decode,
602 haCharBuffer = cbufref,
604 haEncoder = mb_encoder,
605 haDecoder = mb_decoder,
607 haInputNL = inputNL nl,
608 haOutputNL = outputNL nl,
609 haOtherSide = other_side
612 -- | makes a new 'Handle'
613 mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
614 => dev -- ^ the underlying IO device, which must support
615 -- 'IODevice', 'BufferedIO' and 'Typeable'
617 -- ^ a string describing the 'Handle', e.g. the file
618 -- path for a file. Used in error messages.
620 -- The mode in which the 'Handle' is to be used
621 -> Maybe TextEncoding
622 -- Create the 'Handle' with no text encoding?
624 -- Translate newlines?
626 mkFileHandle dev filepath iomode mb_codec tr_newlines = do
627 mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec
629 (Just handleFinalizer) Nothing{-other_side-}
631 -- | like 'mkFileHandle', except that a 'Handle' is created with two
632 -- independent buffers, one for reading and one for writing. Used for
633 -- full-duplex streams, such as network sockets.
634 mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
635 -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
636 mkDuplexHandle dev filepath mb_codec tr_newlines = do
638 write_side@(FileHandle _ write_m) <-
639 mkHandle dev filepath WriteHandle True mb_codec
641 (Just handleFinalizer)
642 Nothing -- no othersie
644 read_side@(FileHandle _ read_m) <-
645 mkHandle dev filepath ReadHandle True mb_codec
647 Nothing -- no finalizer
650 return (DuplexHandle filepath read_m write_m)
652 ioModeToHandleType :: IOMode -> HandleType
653 ioModeToHandleType ReadMode = ReadHandle
654 ioModeToHandleType WriteMode = WriteHandle
655 ioModeToHandleType ReadWriteMode = ReadWriteHandle
656 ioModeToHandleType AppendMode = AppendHandle
658 initBufferState :: HandleType -> BufferState
659 initBufferState ReadHandle = ReadBuffer
660 initBufferState _ = WriteBuffer
663 :: Maybe TextEncoding
665 -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
668 openTextEncoding Nothing ha_type cont = cont Nothing Nothing
669 openTextEncoding (Just TextEncoding{..}) ha_type cont = do
670 mb_decoder <- if isReadableHandleType ha_type then do
671 decoder <- mkTextDecoder
672 return (Just decoder)
675 mb_encoder <- if isWritableHandleType ha_type then do
676 encoder <- mkTextEncoder
677 return (Just encoder)
680 cont mb_encoder mb_decoder
682 closeTextCodecs :: Handle__ -> IO ()
683 closeTextCodecs Handle__{..} = do
684 case haDecoder of Nothing -> return (); Just d -> Encoding.close d
685 case haEncoder of Nothing -> return (); Just d -> Encoding.close d
687 -- ---------------------------------------------------------------------------
690 -- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
691 -- EOF is read or an IO error occurs on a lazy stream. The
692 -- semi-closed Handle is then closed immediately. We have to be
693 -- careful with DuplexHandles though: we have to leave the closing to
694 -- the finalizer in that case, because the write side may still be in
696 hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
697 hClose_help handle_ =
698 case haType handle_ of
699 ClosedHandle -> return (handle_,Nothing)
700 _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
701 -- it is important that hClose doesn't fail and
702 -- leave the Handle open (#3128), so we catch
703 -- exceptions when flushing the buffer.
704 (h_, mb_exc2) <- hClose_handle_ handle_
705 return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
708 trymaybe :: IO () -> IO (Maybe SomeException)
709 trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
711 hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
712 hClose_handle_ h_@Handle__{..} = do
714 -- close the file descriptor, but not when this is the read
715 -- side of a duplex handle.
716 -- If an exception is raised by the close(), we want to continue
717 -- to close the handle and release the lock if it has one, then
718 -- we return the exception to the caller of hClose_help which can
719 -- raise it if necessary.
722 Nothing -> trymaybe $ IODevice.close haDevice
723 Just _ -> return Nothing
725 -- free the spare buffers
726 writeIORef haBuffers BufferListNil
727 writeIORef haCharBuffer noCharBuffer
728 writeIORef haByteBuffer noByteBuffer
730 -- release our encoder/decoder
733 -- we must set the fd to -1, because the finalizer is going
734 -- to run eventually and try to close/unlock it.
735 -- ToDo: necessary? the handle will be marked ClosedHandle
736 -- XXX GHC won't let us use record update here, hence wildcards
737 return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)
739 {-# NOINLINE noCharBuffer #-}
740 noCharBuffer :: CharBuffer
741 noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer
743 {-# NOINLINE noByteBuffer #-}
744 noByteBuffer :: Buffer Word8
745 noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer
747 -- ---------------------------------------------------------------------------
750 hLookAhead_ :: Handle__ -> IO Char
751 hLookAhead_ handle_@Handle__{..} = do
752 buf <- readIORef haCharBuffer
754 -- fill up the read buffer if necessary
755 new_buf <- if isEmptyBuffer buf
756 then readTextDevice handle_ buf
758 writeIORef haCharBuffer new_buf
760 peekCharBuf (bufRaw buf) (bufL buf)
762 -- ---------------------------------------------------------------------------
765 debugIO :: String -> IO ()
768 = do _ <- withCStringLen (s ++ "\n") $
769 \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
771 | otherwise = return ()
773 -- ----------------------------------------------------------------------------
776 -- Read characters into the provided buffer. Return when any
777 -- characters are available; raise an exception if the end of
779 readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
780 readTextDevice h_@Handle__{..} cbuf = do
782 bbuf0 <- readIORef haByteBuffer
784 debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++
785 " bbuf=" ++ summaryBuffer bbuf0)
787 bbuf1 <- if not (isEmptyBuffer bbuf0)
790 (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
791 if r == 0 then ioe_EOF else do -- raise EOF
794 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
799 writeIORef haLastDecode (error "codec_state", bbuf1)
800 latin1_decode bbuf1 cbuf
802 state <- getState decoder
803 writeIORef haLastDecode (state, bbuf1)
804 (encode decoder) bbuf1 cbuf
806 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
807 " bbuf=" ++ summaryBuffer bbuf2)
809 writeIORef haByteBuffer bbuf2
810 if bufR cbuf' == bufR cbuf -- no new characters
811 then readTextDevice' h_ bbuf2 cbuf -- we need more bytes to make a Char
814 -- we have an incomplete byte sequence at the end of the buffer: try to
816 readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
817 readTextDevice' h_@Handle__{..} bbuf0 cbuf = do
819 -- copy the partial sequence to the beginning of the buffer, so we have
820 -- room to read more bytes.
821 bbuf1 <- slideContents bbuf0
823 bbuf2 <- do (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
825 then ioe_invalidCharacter
828 debugIO ("readTextDevice' after reading: bbuf=" ++ summaryBuffer bbuf2)
833 writeIORef haLastDecode (error "codec_state", bbuf2)
834 latin1_decode bbuf2 cbuf
836 state <- getState decoder
837 writeIORef haLastDecode (state, bbuf2)
838 (encode decoder) bbuf2 cbuf
840 debugIO ("readTextDevice' after decoding: cbuf=" ++ summaryBuffer cbuf' ++
841 " bbuf=" ++ summaryBuffer bbuf3)
843 writeIORef haByteBuffer bbuf3
844 if bufR cbuf == bufR cbuf'
845 then readTextDevice' h_ bbuf3 cbuf'
848 -- Read characters into the provided buffer. Do not block;
849 -- return zero characters instead. Raises an exception on end-of-file.
850 readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
851 readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
853 bbuf0 <- readIORef haByteBuffer
854 when (isEmptyBuffer bbuf0) $ do
855 (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
856 if isNothing r then ioe_EOF else do -- raise EOF
857 writeIORef haByteBuffer bbuf1
859 decodeByteBuf h_ cbuf
861 -- Decode bytes from the byte buffer into the supplied CharBuffer.
862 decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer
863 decodeByteBuf h_@Handle__{..} cbuf = do
865 bbuf0 <- readIORef haByteBuffer
870 writeIORef haLastDecode (error "codec_state", bbuf0)
871 latin1_decode bbuf0 cbuf
873 state <- getState decoder
874 writeIORef haLastDecode (state, bbuf0)
875 (encode decoder) bbuf0 cbuf
877 writeIORef haByteBuffer bbuf2