1 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
2 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
3 {-# OPTIONS_HADDOCK hide #-}
4 {-# LANGUAGE NoImplicitPrelude, RecordWildCards, BangPatterns #-}
6 -----------------------------------------------------------------------------
8 -- Module : GHC.IO.Handle.Internals
9 -- Copyright : (c) The University of Glasgow, 1994-2001
10 -- License : see libraries/base/LICENSE
12 -- Maintainer : libraries@haskell.org
13 -- Stability : internal
14 -- Portability : non-portable
16 -- This module defines the basic operations on I\/O \"handles\". All
17 -- of the operations defined here are independent of the underlying
20 -----------------------------------------------------------------------------
23 module GHC.IO.Handle.Internals (
24 withHandle, withHandle', withHandle_,
25 withHandle__', withHandle_', withAllHandles__,
26 wantWritableHandle, wantReadableHandle, wantReadableHandle_,
29 mkHandle, mkFileHandle, mkDuplexHandle,
30 openTextEncoding, closeTextCodecs, initBufferState,
31 dEFAULT_CHAR_BUFFER_SIZE,
33 flushBuffer, flushWriteBuffer, flushCharReadBuffer,
34 flushCharBuffer, flushByteReadBuffer, flushByteWriteBuffer,
36 readTextDevice, writeCharBuffer, readTextDeviceNonBlocking,
40 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
41 ioe_finalizedHandle, ioe_bufsiz,
43 hClose_help, hLookAhead_,
45 HandleFinalizer, handleFinalizer,
52 import GHC.IO.Encoding as Encoding
53 import GHC.IO.Handle.Types
55 import GHC.IO.BufferedIO (BufferedIO)
56 import GHC.IO.Exception
57 import GHC.IO.Device (IODevice, SeekMode(..))
58 import qualified GHC.IO.Device as IODevice
59 import qualified GHC.IO.BufferedIO as Buffered
65 import GHC.Num ( Num(..) )
72 import Foreign hiding (unsafePerformIO)
73 -- import System.IO.Error
74 import System.Posix.Internals hiding (FD)
81 -- ---------------------------------------------------------------------------
82 -- Creating a new handle
84 type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()
86 newFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle
87 newFileHandle filepath mb_finalizer hc = do
90 Just finalizer -> addMVarFinalizer m (finalizer filepath m)
92 return (FileHandle filepath m)
94 -- ---------------------------------------------------------------------------
95 -- Working with Handles
98 In the concurrent world, handles are locked during use. This is done
99 by wrapping an MVar around the handle which acts as a mutex over
100 operations on the handle.
102 To avoid races, we use the following bracketing operations. The idea
103 is to obtain the lock, do some operation and replace the lock again,
104 whether the operation succeeded or failed. We also want to handle the
105 case where the thread receives an exception while processing the IO
106 operation: in these cases we also want to relinquish the lock.
108 There are three versions of @withHandle@: corresponding to the three
109 possible combinations of:
111 - the operation may side-effect the handle
112 - the operation may return a result
114 If the operation generates an error or an exception is raised, the
115 original handle is always replaced.
118 {-# INLINE withHandle #-}
119 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
120 withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act
121 withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
123 withHandle' :: String -> Handle -> MVar Handle__
124 -> (Handle__ -> IO (Handle__,a)) -> IO a
125 withHandle' fun h m act =
127 (h',v) <- do_operation fun h act m
128 checkHandleInvariants h'
132 {-# INLINE withHandle_ #-}
133 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
134 withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act
135 withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
137 withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
138 withHandle_' fun h m act = withHandle' fun h m $ \h_ -> do
142 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
143 withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act
144 withAllHandles__ fun h@(DuplexHandle _ r w) act = do
145 withHandle__' fun h r act
146 withHandle__' fun h w act
148 withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
150 withHandle__' fun h m act =
152 h' <- do_operation fun h act m
153 checkHandleInvariants h'
157 do_operation :: String -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
158 do_operation fun h act m = do
160 checkHandleInvariants h_
161 act h_ `catchException` handler h_
166 _ | Just ioe <- fromException e ->
167 ioError (augmentIOError ioe fun h)
168 _ | Just async_ex <- fromException e -> do -- see Note [async]
169 let _ = async_ex :: AsyncException
172 do_operation fun h act m
178 -- If an asynchronous exception is raised during an I/O operation,
179 -- normally it is fine to just re-throw the exception synchronously.
180 -- However, if we are inside an unsafePerformIO or an
181 -- unsafeInterleaveIO, this would replace the enclosing thunk with the
182 -- exception raised, which is wrong (#3997). We have to release the
183 -- lock on the Handle, but what do we replace the thunk with? What
184 -- should happen when the thunk is subsequently demanded again?
186 -- The only sensible choice we have is to re-do the IO operation on
187 -- resumption, but then we have to be careful in the IO library that
188 -- this is always safe to do. In particular we should
190 -- never perform any side-effects before an interruptible operation
192 -- because the interruptible operation may raise an asynchronous
193 -- exception, which may cause the operation and its side effects to be
194 -- subsequently performed again.
196 -- Re-doing the IO operation is achieved by:
197 -- - using throwTo to re-throw the asynchronous exception asynchronously
198 -- in the current thread
199 -- - on resumption, it will be as if throwTo returns. In that case, we
200 -- recursively invoke the original operation (see do_operation above).
202 -- Interruptible operations in the I/O library are:
203 -- - threadWaitRead/threadWaitWrite
204 -- - fillReadBuffer/flushWriteBuffer
205 -- - readTextDevice/writeTextDevice
207 augmentIOError :: IOException -> String -> Handle -> IOException
208 augmentIOError ioe@IOError{ ioe_filename = fp } fun h
209 = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
212 | otherwise = case h of
213 FileHandle path _ -> Just path
214 DuplexHandle path _ _ -> Just path
216 -- ---------------------------------------------------------------------------
217 -- Wrapper for write operations.
219 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
220 wantWritableHandle fun h@(FileHandle _ m) act
221 = wantWritableHandle' fun h m act
222 wantWritableHandle fun h@(DuplexHandle _ _ m) act
223 = wantWritableHandle' fun h m act
224 -- we know it's not a ReadHandle or ReadWriteHandle, but we have to
225 -- check for ClosedHandle/SemiClosedHandle. (#4808)
228 :: String -> Handle -> MVar Handle__
229 -> (Handle__ -> IO a) -> IO a
230 wantWritableHandle' fun h m act
231 = withHandle_' fun h m (checkWritableHandle act)
233 checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
234 checkWritableHandle act h_@Handle__{..}
236 ClosedHandle -> ioe_closedHandle
237 SemiClosedHandle -> ioe_closedHandle
238 ReadHandle -> ioe_notWritable
239 ReadWriteHandle -> do
240 buf <- readIORef haCharBuffer
241 when (not (isWriteBuffer buf)) $ do
242 flushCharReadBuffer h_
243 flushByteReadBuffer h_
244 buf <- readIORef haCharBuffer
245 writeIORef haCharBuffer buf{ bufState = WriteBuffer }
246 buf <- readIORef haByteBuffer
247 buf' <- Buffered.emptyWriteBuffer haDevice buf
248 writeIORef haByteBuffer buf'
252 -- ---------------------------------------------------------------------------
253 -- Wrapper for read operations.
255 wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
256 wantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)
258 wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
259 wantReadableHandle_ fun h@(FileHandle _ m) act
260 = wantReadableHandle' fun h m act
261 wantReadableHandle_ fun h@(DuplexHandle _ m _) act
262 = wantReadableHandle' fun h m act
263 -- we know it's not a WriteHandle or ReadWriteHandle, but we have to
264 -- check for ClosedHandle/SemiClosedHandle. (#4808)
267 :: String -> Handle -> MVar Handle__
268 -> (Handle__ -> IO a) -> IO a
269 wantReadableHandle' fun h m act
270 = withHandle_' fun h m (checkReadableHandle act)
272 checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
273 checkReadableHandle act h_@Handle__{..} =
275 ClosedHandle -> ioe_closedHandle
276 SemiClosedHandle -> ioe_closedHandle
277 AppendHandle -> ioe_notReadable
278 WriteHandle -> ioe_notReadable
279 ReadWriteHandle -> do
280 -- a read/write handle and we want to read from it. We must
281 -- flush all buffered write data first.
282 bbuf <- readIORef haByteBuffer
283 when (isWriteBuffer bbuf) $ do
284 when (not (isEmptyBuffer bbuf)) $ flushByteWriteBuffer h_
285 cbuf' <- readIORef haCharBuffer
286 writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }
287 bbuf <- readIORef haByteBuffer
288 writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }
292 -- ---------------------------------------------------------------------------
293 -- Wrapper for seek operations.
295 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
296 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
297 ioException (IOError (Just h) IllegalOperation fun
298 "handle is not seekable" Nothing Nothing)
299 wantSeekableHandle fun h@(FileHandle _ m) act =
300 withHandle_' fun h m (checkSeekableHandle act)
302 checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
303 checkSeekableHandle act handle_@Handle__{haDevice=dev} =
304 case haType handle_ of
305 ClosedHandle -> ioe_closedHandle
306 SemiClosedHandle -> ioe_closedHandle
307 AppendHandle -> ioe_notSeekable
308 _ -> do b <- IODevice.isSeekable dev
309 if b then act handle_
312 -- -----------------------------------------------------------------------------
315 ioe_closedHandle, ioe_EOF,
316 ioe_notReadable, ioe_notWritable, ioe_cannotFlushNotSeekable,
317 ioe_notSeekable, ioe_invalidCharacter :: IO a
319 ioe_closedHandle = ioException
320 (IOError Nothing IllegalOperation ""
321 "handle is closed" Nothing Nothing)
322 ioe_EOF = ioException
323 (IOError Nothing EOF "" "" Nothing Nothing)
324 ioe_notReadable = ioException
325 (IOError Nothing IllegalOperation ""
326 "handle is not open for reading" Nothing Nothing)
327 ioe_notWritable = ioException
328 (IOError Nothing IllegalOperation ""
329 "handle is not open for writing" Nothing Nothing)
330 ioe_notSeekable = ioException
331 (IOError Nothing IllegalOperation ""
332 "handle is not seekable" Nothing Nothing)
333 ioe_cannotFlushNotSeekable = ioException
334 (IOError Nothing IllegalOperation ""
335 "cannot flush the read buffer: underlying device is not seekable"
337 ioe_invalidCharacter = ioException
338 (IOError Nothing InvalidArgument ""
339 ("invalid byte sequence for this encoding") Nothing Nothing)
341 ioe_finalizedHandle :: FilePath -> Handle__
342 ioe_finalizedHandle fp = throw
343 (IOError Nothing IllegalOperation ""
344 "handle is finalized" Nothing (Just fp))
346 ioe_bufsiz :: Int -> IO a
347 ioe_bufsiz n = ioException
348 (IOError Nothing InvalidArgument "hSetBuffering"
349 ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
350 -- 9 => should be parens'ified.
352 -- -----------------------------------------------------------------------------
355 -- For a duplex handle, we arrange that the read side points to the write side
356 -- (and hence keeps it alive if the read side is alive). This is done by
357 -- having the haOtherSide field of the read side point to the read side.
358 -- The finalizer is then placed on the write side, and the handle only gets
359 -- finalized once, when both sides are no longer required.
361 -- NOTE about finalized handles: It's possible that a handle can be
362 -- finalized and then we try to use it later, for example if the
363 -- handle is referenced from another finalizer, or from a thread that
364 -- has become unreferenced and then resurrected (arguably in the
365 -- latter case we shouldn't finalize the Handle...). Anyway,
366 -- we try to emit a helpful message which is better than nothing.
368 -- [later; 8/2010] However, a program like this can yield a strange
371 -- main = writeFile "out" loop
372 -- loop = let x = x in x
374 -- because the main thread and the Handle are both unreachable at the
375 -- same time, the Handle may get finalized before the main thread
376 -- receives the NonTermination exception, and the exception handler
377 -- will then report an error. We'd rather this was not an error and
378 -- the program just prints "<<loop>>".
380 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
381 handleFinalizer fp m = do
382 handle_ <- takeMVar m
383 (handle_', _) <- hClose_help handle_
387 -- ---------------------------------------------------------------------------
388 -- Allocating buffers
390 -- using an 8k char buffer instead of 32k improved performance for a
391 -- basic "cat" program by ~30% for me. --SDM
392 dEFAULT_CHAR_BUFFER_SIZE :: Int
393 dEFAULT_CHAR_BUFFER_SIZE = dEFAULT_BUFFER_SIZE `div` 4
395 getCharBuffer :: IODevice dev => dev -> BufferState
396 -> IO (IORef CharBuffer, BufferMode)
397 getCharBuffer dev state = do
398 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
399 ioref <- newIORef buffer
400 is_tty <- IODevice.isTerminal dev
403 | is_tty = LineBuffering
404 | otherwise = BlockBuffering Nothing
406 return (ioref, buffer_mode)
408 mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
409 mkUnBuffer state = do
410 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
411 -- See [note Buffer Sizing], GHC.IO.Handle.Types
412 ref <- newIORef buffer
413 return (ref, NoBuffering)
415 -- -----------------------------------------------------------------------------
418 -- | syncs the file with the buffer, including moving the
419 -- file pointer backwards in the case of a read buffer. This can fail
420 -- on a non-seekable read Handle.
421 flushBuffer :: Handle__ -> IO ()
422 flushBuffer h_@Handle__{..} = do
423 buf <- readIORef haCharBuffer
426 flushCharReadBuffer h_
427 flushByteReadBuffer h_
429 flushByteWriteBuffer h_
431 -- | flushes the Char buffer only. Works on all Handles.
432 flushCharBuffer :: Handle__ -> IO ()
433 flushCharBuffer h_@Handle__{..} = do
434 cbuf <- readIORef haCharBuffer
435 case bufState cbuf of
437 flushCharReadBuffer h_
439 when (not (isEmptyBuffer cbuf)) $
440 error "internal IO library error: Char buffer non-empty"
442 -- -----------------------------------------------------------------------------
443 -- Writing data (flushing write buffers)
445 -- flushWriteBuffer flushes the buffer iff it contains pending write
446 -- data. Flushes both the Char and the byte buffer, leaving both
448 flushWriteBuffer :: Handle__ -> IO ()
449 flushWriteBuffer h_@Handle__{..} = do
450 buf <- readIORef haByteBuffer
451 when (isWriteBuffer buf) $ flushByteWriteBuffer h_
453 flushByteWriteBuffer :: Handle__ -> IO ()
454 flushByteWriteBuffer h_@Handle__{..} = do
455 bbuf <- readIORef haByteBuffer
456 when (not (isEmptyBuffer bbuf)) $ do
457 bbuf' <- Buffered.flushWriteBuffer haDevice bbuf
458 writeIORef haByteBuffer bbuf'
460 -- write the contents of the CharBuffer to the Handle__.
461 -- The data will be encoded and pushed to the byte buffer,
462 -- flushing if the buffer becomes full.
463 writeCharBuffer :: Handle__ -> CharBuffer -> IO ()
464 writeCharBuffer h_@Handle__{..} !cbuf = do
466 bbuf <- readIORef haByteBuffer
468 debugIO ("writeCharBuffer: cbuf=" ++ summaryBuffer cbuf ++
469 " bbuf=" ++ summaryBuffer bbuf)
471 (cbuf',bbuf') <- case haEncoder of
472 Nothing -> latin1_encode cbuf bbuf
473 Just encoder -> (encode encoder) cbuf bbuf
475 debugIO ("writeCharBuffer after encoding: cbuf=" ++ summaryBuffer cbuf' ++
476 " bbuf=" ++ summaryBuffer bbuf')
478 -- flush if the write buffer is full
479 if isFullBuffer bbuf'
480 -- or we made no progress
481 || not (isEmptyBuffer cbuf') && bufL cbuf' == bufL cbuf
482 -- or the byte buffer has more elements than the user wanted buffered
483 || (case haBufferMode of
484 BlockBuffering (Just s) -> bufferElems bbuf' >= s
488 bbuf'' <- Buffered.flushWriteBuffer haDevice bbuf'
489 writeIORef haByteBuffer bbuf''
491 writeIORef haByteBuffer bbuf'
493 if not (isEmptyBuffer cbuf')
494 then writeCharBuffer h_ cbuf'
497 -- -----------------------------------------------------------------------------
498 -- Flushing read buffers
500 -- It is always possible to flush the Char buffer back to the byte buffer.
501 flushCharReadBuffer :: Handle__ -> IO ()
502 flushCharReadBuffer Handle__{..} = do
503 cbuf <- readIORef haCharBuffer
504 if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
506 -- haLastDecode is the byte buffer just before we did our last batch of
507 -- decoding. We're going to re-decode the bytes up to the current char,
508 -- to find out where we should revert the byte buffer to.
509 (codec_state, bbuf0) <- readIORef haLastDecode
511 cbuf0 <- readIORef haCharBuffer
512 writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
514 -- if we haven't used any characters from the char buffer, then just
515 -- re-install the old byte buffer.
517 then do writeIORef haByteBuffer bbuf0
523 writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
524 -- no decoder: the number of bytes to decode is the same as the
525 -- number of chars we have used up.
528 debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
529 " cbuf=" ++ summaryBuffer cbuf0)
531 -- restore the codec state
532 setState decoder codec_state
534 (bbuf1,cbuf1) <- (encode decoder) bbuf0
535 cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
537 debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
538 " cbuf=" ++ summaryBuffer cbuf1)
540 writeIORef haByteBuffer bbuf1
543 -- When flushing the byte read buffer, we seek backwards by the number
544 -- of characters in the buffer. The file descriptor must therefore be
545 -- seekable: attempting to flush the read buffer on an unseekable
546 -- handle is not allowed.
548 flushByteReadBuffer :: Handle__ -> IO ()
549 flushByteReadBuffer h_@Handle__{..} = do
550 bbuf <- readIORef haByteBuffer
552 if isEmptyBuffer bbuf then return () else do
554 seekable <- IODevice.isSeekable haDevice
555 when (not seekable) $ ioe_cannotFlushNotSeekable
557 let seek = negate (bufR bbuf - bufL bbuf)
559 debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
560 IODevice.seek haDevice RelativeSeek (fromIntegral seek)
562 writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
564 -- ----------------------------------------------------------------------------
567 mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
571 -> Maybe TextEncoding
573 -> Maybe HandleFinalizer
574 -> Maybe (MVar Handle__)
577 mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
578 openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
580 let buf_state = initBufferState ha_type
581 bbuf <- Buffered.newBuffer dev buf_state
582 bbufref <- newIORef bbuf
583 last_decode <- newIORef (error "codec_state", bbuf)
586 if buffered then getCharBuffer dev buf_state
587 else mkUnBuffer buf_state
589 spares <- newIORef BufferListNil
590 newFileHandle filepath finalizer
591 (Handle__ { haDevice = dev,
593 haBufferMode = bmode,
594 haByteBuffer = bbufref,
595 haLastDecode = last_decode,
596 haCharBuffer = cbufref,
598 haEncoder = mb_encoder,
599 haDecoder = mb_decoder,
601 haInputNL = inputNL nl,
602 haOutputNL = outputNL nl,
603 haOtherSide = other_side
606 -- | makes a new 'Handle'
607 mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
608 => dev -- ^ the underlying IO device, which must support
609 -- 'IODevice', 'BufferedIO' and 'Typeable'
611 -- ^ a string describing the 'Handle', e.g. the file
612 -- path for a file. Used in error messages.
614 -- The mode in which the 'Handle' is to be used
615 -> Maybe TextEncoding
616 -- Create the 'Handle' with no text encoding?
618 -- Translate newlines?
620 mkFileHandle dev filepath iomode mb_codec tr_newlines = do
621 mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec
623 (Just handleFinalizer) Nothing{-other_side-}
625 -- | like 'mkFileHandle', except that a 'Handle' is created with two
626 -- independent buffers, one for reading and one for writing. Used for
627 -- full-duplex streams, such as network sockets.
628 mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
629 -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
630 mkDuplexHandle dev filepath mb_codec tr_newlines = do
632 write_side@(FileHandle _ write_m) <-
633 mkHandle dev filepath WriteHandle True mb_codec
635 (Just handleFinalizer)
636 Nothing -- no othersie
638 read_side@(FileHandle _ read_m) <-
639 mkHandle dev filepath ReadHandle True mb_codec
641 Nothing -- no finalizer
644 return (DuplexHandle filepath read_m write_m)
646 ioModeToHandleType :: IOMode -> HandleType
647 ioModeToHandleType ReadMode = ReadHandle
648 ioModeToHandleType WriteMode = WriteHandle
649 ioModeToHandleType ReadWriteMode = ReadWriteHandle
650 ioModeToHandleType AppendMode = AppendHandle
652 initBufferState :: HandleType -> BufferState
653 initBufferState ReadHandle = ReadBuffer
654 initBufferState _ = WriteBuffer
657 :: Maybe TextEncoding
659 -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
662 openTextEncoding Nothing ha_type cont = cont Nothing Nothing
663 openTextEncoding (Just TextEncoding{..}) ha_type cont = do
664 mb_decoder <- if isReadableHandleType ha_type then do
665 decoder <- mkTextDecoder
666 return (Just decoder)
669 mb_encoder <- if isWritableHandleType ha_type then do
670 encoder <- mkTextEncoder
671 return (Just encoder)
674 cont mb_encoder mb_decoder
676 closeTextCodecs :: Handle__ -> IO ()
677 closeTextCodecs Handle__{..} = do
678 case haDecoder of Nothing -> return (); Just d -> Encoding.close d
679 case haEncoder of Nothing -> return (); Just d -> Encoding.close d
681 -- ---------------------------------------------------------------------------
684 -- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
685 -- EOF is read or an IO error occurs on a lazy stream. The
686 -- semi-closed Handle is then closed immediately. We have to be
687 -- careful with DuplexHandles though: we have to leave the closing to
688 -- the finalizer in that case, because the write side may still be in
690 hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
691 hClose_help handle_ =
692 case haType handle_ of
693 ClosedHandle -> return (handle_,Nothing)
694 _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
695 -- it is important that hClose doesn't fail and
696 -- leave the Handle open (#3128), so we catch
697 -- exceptions when flushing the buffer.
698 (h_, mb_exc2) <- hClose_handle_ handle_
699 return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
702 trymaybe :: IO () -> IO (Maybe SomeException)
703 trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
705 hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
706 hClose_handle_ h_@Handle__{..} = do
708 -- close the file descriptor, but not when this is the read
709 -- side of a duplex handle.
710 -- If an exception is raised by the close(), we want to continue
711 -- to close the handle and release the lock if it has one, then
712 -- we return the exception to the caller of hClose_help which can
713 -- raise it if necessary.
716 Nothing -> trymaybe $ IODevice.close haDevice
717 Just _ -> return Nothing
719 -- free the spare buffers
720 writeIORef haBuffers BufferListNil
721 writeIORef haCharBuffer noCharBuffer
722 writeIORef haByteBuffer noByteBuffer
724 -- release our encoder/decoder
727 -- we must set the fd to -1, because the finalizer is going
728 -- to run eventually and try to close/unlock it.
729 -- ToDo: necessary? the handle will be marked ClosedHandle
730 -- XXX GHC won't let us use record update here, hence wildcards
731 return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)
733 {-# NOINLINE noCharBuffer #-}
734 noCharBuffer :: CharBuffer
735 noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer
737 {-# NOINLINE noByteBuffer #-}
738 noByteBuffer :: Buffer Word8
739 noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer
741 -- ---------------------------------------------------------------------------
744 hLookAhead_ :: Handle__ -> IO Char
745 hLookAhead_ handle_@Handle__{..} = do
746 buf <- readIORef haCharBuffer
748 -- fill up the read buffer if necessary
749 new_buf <- if isEmptyBuffer buf
750 then readTextDevice handle_ buf
752 writeIORef haCharBuffer new_buf
754 peekCharBuf (bufRaw buf) (bufL buf)
756 -- ---------------------------------------------------------------------------
759 debugIO :: String -> IO ()
762 = do _ <- withCStringLen (s ++ "\n") $
763 \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
765 | otherwise = return ()
767 -- ----------------------------------------------------------------------------
770 -- Read characters into the provided buffer. Return when any
771 -- characters are available; raise an exception if the end of
773 readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
774 readTextDevice h_@Handle__{..} cbuf = do
776 bbuf0 <- readIORef haByteBuffer
778 debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++
779 " bbuf=" ++ summaryBuffer bbuf0)
781 bbuf1 <- if not (isEmptyBuffer bbuf0)
784 (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
785 if r == 0 then ioe_EOF else do -- raise EOF
788 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
793 writeIORef haLastDecode (error "codec_state", bbuf1)
794 latin1_decode bbuf1 cbuf
796 state <- getState decoder
797 writeIORef haLastDecode (state, bbuf1)
798 (encode decoder) bbuf1 cbuf
800 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
801 " bbuf=" ++ summaryBuffer bbuf2)
803 writeIORef haByteBuffer bbuf2
804 if bufR cbuf' == bufR cbuf -- no new characters
805 then readTextDevice' h_ bbuf2 cbuf -- we need more bytes to make a Char
808 -- we have an incomplete byte sequence at the end of the buffer: try to
810 readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
811 readTextDevice' h_@Handle__{..} bbuf0 cbuf = do
813 -- copy the partial sequence to the beginning of the buffer, so we have
814 -- room to read more bytes.
815 bbuf1 <- slideContents bbuf0
817 bbuf2 <- do (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
819 then ioe_invalidCharacter
822 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf2)
827 writeIORef haLastDecode (error "codec_state", bbuf2)
828 latin1_decode bbuf2 cbuf
830 state <- getState decoder
831 writeIORef haLastDecode (state, bbuf2)
832 (encode decoder) bbuf2 cbuf
834 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
835 " bbuf=" ++ summaryBuffer bbuf3)
837 writeIORef haByteBuffer bbuf3
838 if bufR cbuf == bufR cbuf'
839 then readTextDevice' h_ bbuf3 cbuf'
842 -- Read characters into the provided buffer. Do not block;
843 -- return zero characters instead. Raises an exception on end-of-file.
844 readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
845 readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
847 bbuf0 <- readIORef haByteBuffer
848 when (isEmptyBuffer bbuf0) $ do
849 (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
850 if isNothing r then ioe_EOF else do -- raise EOF
851 writeIORef haByteBuffer bbuf1
853 decodeByteBuf h_ cbuf
855 -- Decode bytes from the byte buffer into the supplied CharBuffer.
856 decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer
857 decodeByteBuf h_@Handle__{..} cbuf = do
859 bbuf0 <- readIORef haByteBuffer
864 writeIORef haLastDecode (error "codec_state", bbuf0)
865 latin1_decode bbuf0 cbuf
867 state <- getState decoder
868 writeIORef haLastDecode (state, bbuf0)
869 (encode decoder) bbuf0 cbuf
871 writeIORef haByteBuffer bbuf2