1 {-# OPTIONS_GHC -XNoImplicitPrelude -#include "HsBase.h" #-}
2 {-# OPTIONS_GHC -fno-warn-unused-matches #-}
3 {-# OPTIONS_GHC -fno-warn-name-shadowing #-}
4 {-# OPTIONS_GHC -XRecordWildCards #-}
5 {-# OPTIONS_HADDOCK hide #-}
7 -----------------------------------------------------------------------------
9 -- Module : GHC.IO.Handle.Internals
10 -- Copyright : (c) The University of Glasgow, 1994-2001
11 -- License : see libraries/base/LICENSE
13 -- Maintainer : libraries@haskell.org
14 -- Stability : internal
15 -- Portability : non-portable
17 -- This module defines the basic operations on I\/O \"handles\". All
18 -- of the operations defined here are independent of the underlying
21 -----------------------------------------------------------------------------
24 module GHC.IO.Handle.Internals (
25 withHandle, withHandle', withHandle_,
26 withHandle__', withHandle_', withAllHandles__,
27 wantWritableHandle, wantReadableHandle, wantReadableHandle_,
30 mkHandle, mkFileHandle, mkDuplexHandle,
31 openTextEncoding, closeTextCodecs, initBufferState,
32 dEFAULT_CHAR_BUFFER_SIZE,
34 flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer,
35 flushCharBuffer, flushByteReadBuffer,
37 readTextDevice, writeTextDevice, readTextDeviceNonBlocking,
41 ioe_closedHandle, ioe_EOF, ioe_notReadable, ioe_notWritable,
42 ioe_finalizedHandle, ioe_bufsiz,
44 hClose_help, hLookAhead_,
46 HandleFinalizer, handleFinalizer,
53 import GHC.IO.Encoding as Encoding
54 import GHC.IO.Handle.Types
56 import GHC.IO.BufferedIO (BufferedIO)
57 import GHC.IO.Exception
58 import GHC.IO.Device (IODevice, SeekMode(..))
59 import qualified GHC.IO.Device as IODevice
60 import qualified GHC.IO.BufferedIO as Buffered
66 import GHC.Num ( Num(..) )
74 -- import System.IO.Error
75 import System.Posix.Internals hiding (FD)
82 -- ---------------------------------------------------------------------------
83 -- Creating a new handle
85 type HandleFinalizer = FilePath -> MVar Handle__ -> IO ()
87 newFileHandle :: FilePath -> Maybe HandleFinalizer -> Handle__ -> IO Handle
88 newFileHandle filepath mb_finalizer hc = do
91 Just finalizer -> addMVarFinalizer m (finalizer filepath m)
93 return (FileHandle filepath m)
95 -- ---------------------------------------------------------------------------
96 -- Working with Handles
99 In the concurrent world, handles are locked during use. This is done
100 by wrapping an MVar around the handle which acts as a mutex over
101 operations on the handle.
103 To avoid races, we use the following bracketing operations. The idea
104 is to obtain the lock, do some operation and replace the lock again,
105 whether the operation succeeded or failed. We also want to handle the
106 case where the thread receives an exception while processing the IO
107 operation: in these cases we also want to relinquish the lock.
109 There are three versions of @withHandle@: corresponding to the three
110 possible combinations of:
112 - the operation may side-effect the handle
113 - the operation may return a result
115 If the operation generates an error or an exception is raised, the
116 original handle is always replaced.
119 {-# INLINE withHandle #-}
120 withHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
121 withHandle fun h@(FileHandle _ m) act = withHandle' fun h m act
122 withHandle fun h@(DuplexHandle _ m _) act = withHandle' fun h m act
124 withHandle' :: String -> Handle -> MVar Handle__
125 -> (Handle__ -> IO (Handle__,a)) -> IO a
126 withHandle' fun h m act =
128 (h',v) <- do_operation fun h act m
129 checkHandleInvariants h'
133 {-# INLINE withHandle_ #-}
134 withHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
135 withHandle_ fun h@(FileHandle _ m) act = withHandle_' fun h m act
136 withHandle_ fun h@(DuplexHandle _ m _) act = withHandle_' fun h m act
138 withHandle_' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO a) -> IO a
139 withHandle_' fun h m act = withHandle' fun h m $ \h_ -> do
143 withAllHandles__ :: String -> Handle -> (Handle__ -> IO Handle__) -> IO ()
144 withAllHandles__ fun h@(FileHandle _ m) act = withHandle__' fun h m act
145 withAllHandles__ fun h@(DuplexHandle _ r w) act = do
146 withHandle__' fun h r act
147 withHandle__' fun h w act
149 withHandle__' :: String -> Handle -> MVar Handle__ -> (Handle__ -> IO Handle__)
151 withHandle__' fun h m act =
153 h' <- do_operation fun h act m
154 checkHandleInvariants h'
158 do_operation :: String -> Handle -> (Handle__ -> IO a) -> MVar Handle__ -> IO a
159 do_operation fun h act m = do
161 checkHandleInvariants h_
162 act h_ `catchException` handler h_
167 _ | Just ioe <- fromException e ->
168 ioError (augmentIOError ioe fun h)
169 _ | Just async_ex <- fromException e -> do -- see Note [async]
170 let _ = async_ex :: AsyncException
173 do_operation fun h act m
179 -- If an asynchronous exception is raised during an I/O operation,
180 -- normally it is fine to just re-throw the exception synchronously.
181 -- However, if we are inside an unsafePerformIO or an
182 -- unsafeInterleaveIO, this would replace the enclosing thunk with the
183 -- exception raised, which is wrong (#3997). We have to release the
184 -- lock on the Handle, but what do we replace the thunk with? What
185 -- should happen when the thunk is subsequently demanded again?
187 -- The only sensible choice we have is to re-do the IO operation on
188 -- resumption, but then we have to be careful in the IO library that
189 -- this is always safe to do. In particular we should
191 -- never perform any side-effects before an interruptible operation
193 -- because the interruptible operation may raise an asynchronous
194 -- exception, which may cause the operation and its side effects to be
195 -- subsequently performed again.
197 -- Re-doing the IO operation is achieved by:
198 -- - using throwTo to re-throw the asynchronous exception asynchronously
199 -- in the current thread
200 -- - on resumption, it will be as if throwTo returns. In that case, we
201 -- recursively invoke the original operation (see do_operation above).
203 -- Interruptible operations in the I/O library are:
204 -- - threadWaitRead/threadWaitWrite
205 -- - fillReadBuffer/flushWriteBuffer
206 -- - readTextDevice/writeTextDevice
208 augmentIOError :: IOException -> String -> Handle -> IOException
209 augmentIOError ioe@IOError{ ioe_filename = fp } fun h
210 = ioe { ioe_handle = Just h, ioe_location = fun, ioe_filename = filepath }
213 | otherwise = case h of
214 FileHandle path _ -> Just path
215 DuplexHandle path _ _ -> Just path
217 -- ---------------------------------------------------------------------------
218 -- Wrapper for write operations.
220 wantWritableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
221 wantWritableHandle fun h@(FileHandle _ m) act
222 = wantWritableHandle' fun h m act
223 wantWritableHandle fun h@(DuplexHandle _ _ m) act
224 = withHandle_' fun h m act
227 :: String -> Handle -> MVar Handle__
228 -> (Handle__ -> IO a) -> IO a
229 wantWritableHandle' fun h m act
230 = withHandle_' fun h m (checkWritableHandle act)
232 checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
233 checkWritableHandle act h_@Handle__{..}
235 ClosedHandle -> ioe_closedHandle
236 SemiClosedHandle -> ioe_closedHandle
237 ReadHandle -> ioe_notWritable
238 ReadWriteHandle -> do
239 buf <- readIORef haCharBuffer
240 when (not (isWriteBuffer buf)) $ do
241 flushCharReadBuffer h_
242 flushByteReadBuffer h_
243 buf <- readIORef haCharBuffer
244 writeIORef haCharBuffer buf{ bufState = WriteBuffer }
245 buf <- readIORef haByteBuffer
246 buf' <- Buffered.emptyWriteBuffer haDevice buf
247 writeIORef haByteBuffer buf'
251 -- ---------------------------------------------------------------------------
252 -- Wrapper for read operations.
254 wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
255 wantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)
257 wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
258 wantReadableHandle_ fun h@(FileHandle _ m) act
259 = wantReadableHandle' fun h m act
260 wantReadableHandle_ fun h@(DuplexHandle _ m _) act
261 = withHandle_' fun h m act
264 :: String -> Handle -> MVar Handle__
265 -> (Handle__ -> IO a) -> IO a
266 wantReadableHandle' fun h m act
267 = withHandle_' fun h m (checkReadableHandle act)
269 checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
270 checkReadableHandle act h_@Handle__{..} =
272 ClosedHandle -> ioe_closedHandle
273 SemiClosedHandle -> ioe_closedHandle
274 AppendHandle -> ioe_notReadable
275 WriteHandle -> ioe_notReadable
276 ReadWriteHandle -> do
277 -- a read/write handle and we want to read from it. We must
278 -- flush all buffered write data first.
279 cbuf <- readIORef haCharBuffer
280 when (isWriteBuffer cbuf) $ do
281 cbuf' <- flushWriteBuffer_ h_ cbuf
282 writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }
283 bbuf <- readIORef haByteBuffer
284 writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }
288 -- ---------------------------------------------------------------------------
289 -- Wrapper for seek operations.
291 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
292 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
293 ioException (IOError (Just h) IllegalOperation fun
294 "handle is not seekable" Nothing Nothing)
295 wantSeekableHandle fun h@(FileHandle _ m) act =
296 withHandle_' fun h m (checkSeekableHandle act)
298 checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
299 checkSeekableHandle act handle_@Handle__{haDevice=dev} =
300 case haType handle_ of
301 ClosedHandle -> ioe_closedHandle
302 SemiClosedHandle -> ioe_closedHandle
303 AppendHandle -> ioe_notSeekable
304 _ -> do b <- IODevice.isSeekable dev
305 if b then act handle_
308 -- -----------------------------------------------------------------------------
311 ioe_closedHandle, ioe_EOF,
312 ioe_notReadable, ioe_notWritable, ioe_cannotFlushNotSeekable,
313 ioe_notSeekable, ioe_invalidCharacter :: IO a
315 ioe_closedHandle = ioException
316 (IOError Nothing IllegalOperation ""
317 "handle is closed" Nothing Nothing)
318 ioe_EOF = ioException
319 (IOError Nothing EOF "" "" Nothing Nothing)
320 ioe_notReadable = ioException
321 (IOError Nothing IllegalOperation ""
322 "handle is not open for reading" Nothing Nothing)
323 ioe_notWritable = ioException
324 (IOError Nothing IllegalOperation ""
325 "handle is not open for writing" Nothing Nothing)
326 ioe_notSeekable = ioException
327 (IOError Nothing IllegalOperation ""
328 "handle is not seekable" Nothing Nothing)
329 ioe_cannotFlushNotSeekable = ioException
330 (IOError Nothing IllegalOperation ""
331 "cannot flush the read buffer: underlying device is not seekable"
333 ioe_invalidCharacter = ioException
334 (IOError Nothing InvalidArgument ""
335 ("invalid byte sequence for this encoding") Nothing Nothing)
337 ioe_finalizedHandle :: FilePath -> Handle__
338 ioe_finalizedHandle fp = throw
339 (IOError Nothing IllegalOperation ""
340 "handle is finalized" Nothing (Just fp))
342 ioe_bufsiz :: Int -> IO a
343 ioe_bufsiz n = ioException
344 (IOError Nothing InvalidArgument "hSetBuffering"
345 ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
346 -- 9 => should be parens'ified.
348 -- -----------------------------------------------------------------------------
351 -- For a duplex handle, we arrange that the read side points to the write side
352 -- (and hence keeps it alive if the read side is alive). This is done by
353 -- having the haOtherSide field of the read side point to the read side.
354 -- The finalizer is then placed on the write side, and the handle only gets
355 -- finalized once, when both sides are no longer required.
357 -- NOTE about finalized handles: It's possible that a handle can be
358 -- finalized and then we try to use it later, for example if the
359 -- handle is referenced from another finalizer, or from a thread that
360 -- has become unreferenced and then resurrected (arguably in the
361 -- latter case we shouldn't finalize the Handle...). Anyway,
362 -- we try to emit a helpful message which is better than nothing.
364 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
365 handleFinalizer fp m = do
366 handle_ <- takeMVar m
367 case haType handle_ of
368 ClosedHandle -> return ()
369 _ -> do flushWriteBuffer handle_ `catchAny` \_ -> return ()
370 -- ignore errors and async exceptions, and close the
371 -- descriptor anyway...
372 _ <- hClose_handle_ handle_
374 putMVar m (ioe_finalizedHandle fp)
376 -- ---------------------------------------------------------------------------
377 -- Allocating buffers
379 -- using an 8k char buffer instead of 32k improved performance for a
380 -- basic "cat" program by ~30% for me. --SDM
381 dEFAULT_CHAR_BUFFER_SIZE :: Int
382 dEFAULT_CHAR_BUFFER_SIZE = dEFAULT_BUFFER_SIZE `div` 4
384 getCharBuffer :: IODevice dev => dev -> BufferState
385 -> IO (IORef CharBuffer, BufferMode)
386 getCharBuffer dev state = do
387 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
388 ioref <- newIORef buffer
389 is_tty <- IODevice.isTerminal dev
392 | is_tty = LineBuffering
393 | otherwise = BlockBuffering Nothing
395 return (ioref, buffer_mode)
397 mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
398 mkUnBuffer state = do
399 buffer <- case state of -- See [note Buffer Sizing], GHC.IO.Handle.Types
400 ReadBuffer -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
401 WriteBuffer -> newCharBuffer 1 state
402 ref <- newIORef buffer
403 return (ref, NoBuffering)
405 -- -----------------------------------------------------------------------------
408 -- | syncs the file with the buffer, including moving the
409 -- file pointer backwards in the case of a read buffer. This can fail
410 -- on a non-seekable read Handle.
411 flushBuffer :: Handle__ -> IO ()
412 flushBuffer h_@Handle__{..} = do
413 buf <- readIORef haCharBuffer
416 flushCharReadBuffer h_
417 flushByteReadBuffer h_
419 buf' <- flushWriteBuffer_ h_ buf
420 writeIORef haCharBuffer buf'
422 -- | flushes at least the Char buffer, and the byte buffer for a write
423 -- Handle. Works on all Handles.
424 flushCharBuffer :: Handle__ -> IO ()
425 flushCharBuffer h_@Handle__{..} = do
426 buf <- readIORef haCharBuffer
429 flushCharReadBuffer h_
431 buf' <- flushWriteBuffer_ h_ buf
432 writeIORef haCharBuffer buf'
434 -- -----------------------------------------------------------------------------
435 -- Writing data (flushing write buffers)
437 -- flushWriteBuffer flushes the buffer iff it contains pending write
438 -- data. Flushes both the Char and the byte buffer, leaving both
440 flushWriteBuffer :: Handle__ -> IO ()
441 flushWriteBuffer h_@Handle__{..} = do
442 buf <- readIORef haCharBuffer
444 then do buf' <- flushWriteBuffer_ h_ buf
445 writeIORef haCharBuffer buf'
448 flushWriteBuffer_ :: Handle__ -> CharBuffer -> IO CharBuffer
449 flushWriteBuffer_ h_@Handle__{..} cbuf = do
450 bbuf <- readIORef haByteBuffer
451 if not (isEmptyBuffer cbuf) || not (isEmptyBuffer bbuf)
452 then do writeTextDevice h_ cbuf
453 return cbuf{ bufL=0, bufR=0 }
456 -- -----------------------------------------------------------------------------
457 -- Flushing read buffers
459 -- It is always possible to flush the Char buffer back to the byte buffer.
460 flushCharReadBuffer :: Handle__ -> IO ()
461 flushCharReadBuffer Handle__{..} = do
462 cbuf <- readIORef haCharBuffer
463 if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
465 -- haLastDecode is the byte buffer just before we did our last batch of
466 -- decoding. We're going to re-decode the bytes up to the current char,
467 -- to find out where we should revert the byte buffer to.
468 (codec_state, bbuf0) <- readIORef haLastDecode
470 cbuf0 <- readIORef haCharBuffer
471 writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
473 -- if we haven't used any characters from the char buffer, then just
474 -- re-install the old byte buffer.
476 then do writeIORef haByteBuffer bbuf0
482 writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
483 -- no decoder: the number of bytes to decode is the same as the
484 -- number of chars we have used up.
487 debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
488 " cbuf=" ++ summaryBuffer cbuf0)
490 -- restore the codec state
491 setState decoder codec_state
493 (bbuf1,cbuf1) <- (encode decoder) bbuf0
494 cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
496 debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
497 " cbuf=" ++ summaryBuffer cbuf1)
499 writeIORef haByteBuffer bbuf1
502 -- When flushing the byte read buffer, we seek backwards by the number
503 -- of characters in the buffer. The file descriptor must therefore be
504 -- seekable: attempting to flush the read buffer on an unseekable
505 -- handle is not allowed.
507 flushByteReadBuffer :: Handle__ -> IO ()
508 flushByteReadBuffer h_@Handle__{..} = do
509 bbuf <- readIORef haByteBuffer
511 if isEmptyBuffer bbuf then return () else do
513 seekable <- IODevice.isSeekable haDevice
514 when (not seekable) $ ioe_cannotFlushNotSeekable
516 let seek = negate (bufR bbuf - bufL bbuf)
518 debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
519 IODevice.seek haDevice RelativeSeek (fromIntegral seek)
521 writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
523 -- ----------------------------------------------------------------------------
526 mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
530 -> Maybe TextEncoding
532 -> Maybe HandleFinalizer
533 -> Maybe (MVar Handle__)
536 mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
537 openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
539 let buf_state = initBufferState ha_type
540 bbuf <- Buffered.newBuffer dev buf_state
541 bbufref <- newIORef bbuf
542 last_decode <- newIORef (error "codec_state", bbuf)
545 if buffered then getCharBuffer dev buf_state
546 else mkUnBuffer buf_state
548 spares <- newIORef BufferListNil
549 newFileHandle filepath finalizer
550 (Handle__ { haDevice = dev,
552 haBufferMode = bmode,
553 haByteBuffer = bbufref,
554 haLastDecode = last_decode,
555 haCharBuffer = cbufref,
557 haEncoder = mb_encoder,
558 haDecoder = mb_decoder,
560 haInputNL = inputNL nl,
561 haOutputNL = outputNL nl,
562 haOtherSide = other_side
565 -- | makes a new 'Handle'
566 mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
567 => dev -- ^ the underlying IO device, which must support
568 -- 'IODevice', 'BufferedIO' and 'Typeable'
570 -- ^ a string describing the 'Handle', e.g. the file
571 -- path for a file. Used in error messages.
573 -- The mode in which the 'Handle' is to be used
574 -> Maybe TextEncoding
575 -- Create the 'Handle' with no text encoding?
577 -- Translate newlines?
579 mkFileHandle dev filepath iomode mb_codec tr_newlines = do
580 mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec
582 (Just handleFinalizer) Nothing{-other_side-}
584 -- | like 'mkFileHandle', except that a 'Handle' is created with two
585 -- independent buffers, one for reading and one for writing. Used for
586 -- full-duplex streams, such as network sockets.
587 mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
588 -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
589 mkDuplexHandle dev filepath mb_codec tr_newlines = do
591 write_side@(FileHandle _ write_m) <-
592 mkHandle dev filepath WriteHandle True mb_codec
594 (Just handleFinalizer)
595 Nothing -- no othersie
597 read_side@(FileHandle _ read_m) <-
598 mkHandle dev filepath ReadHandle True mb_codec
600 Nothing -- no finalizer
603 return (DuplexHandle filepath read_m write_m)
605 ioModeToHandleType :: IOMode -> HandleType
606 ioModeToHandleType ReadMode = ReadHandle
607 ioModeToHandleType WriteMode = WriteHandle
608 ioModeToHandleType ReadWriteMode = ReadWriteHandle
609 ioModeToHandleType AppendMode = AppendHandle
611 initBufferState :: HandleType -> BufferState
612 initBufferState ReadHandle = ReadBuffer
613 initBufferState _ = WriteBuffer
616 :: Maybe TextEncoding
618 -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
621 openTextEncoding Nothing ha_type cont = cont Nothing Nothing
622 openTextEncoding (Just TextEncoding{..}) ha_type cont = do
623 mb_decoder <- if isReadableHandleType ha_type then do
624 decoder <- mkTextDecoder
625 return (Just decoder)
628 mb_encoder <- if isWritableHandleType ha_type then do
629 encoder <- mkTextEncoder
630 return (Just encoder)
633 cont mb_encoder mb_decoder
635 closeTextCodecs :: Handle__ -> IO ()
636 closeTextCodecs Handle__{..} = do
637 case haDecoder of Nothing -> return (); Just d -> Encoding.close d
638 case haEncoder of Nothing -> return (); Just d -> Encoding.close d
640 -- ---------------------------------------------------------------------------
643 -- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
644 -- EOF is read or an IO error occurs on a lazy stream. The
645 -- semi-closed Handle is then closed immediately. We have to be
646 -- careful with DuplexHandles though: we have to leave the closing to
647 -- the finalizer in that case, because the write side may still be in
649 hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
650 hClose_help handle_ =
651 case haType handle_ of
652 ClosedHandle -> return (handle_,Nothing)
653 _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
654 -- it is important that hClose doesn't fail and
655 -- leave the Handle open (#3128), so we catch
656 -- exceptions when flushing the buffer.
657 (h_, mb_exc2) <- hClose_handle_ handle_
658 return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
661 trymaybe :: IO () -> IO (Maybe SomeException)
662 trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
664 hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
665 hClose_handle_ h_@Handle__{..} = do
667 -- close the file descriptor, but not when this is the read
668 -- side of a duplex handle.
669 -- If an exception is raised by the close(), we want to continue
670 -- to close the handle and release the lock if it has one, then
671 -- we return the exception to the caller of hClose_help which can
672 -- raise it if necessary.
675 Nothing -> trymaybe $ IODevice.close haDevice
676 Just _ -> return Nothing
678 -- free the spare buffers
679 writeIORef haBuffers BufferListNil
680 writeIORef haCharBuffer noCharBuffer
681 writeIORef haByteBuffer noByteBuffer
683 -- release our encoder/decoder
686 -- we must set the fd to -1, because the finalizer is going
687 -- to run eventually and try to close/unlock it.
688 -- ToDo: necessary? the handle will be marked ClosedHandle
689 -- XXX GHC won't let us use record update here, hence wildcards
690 return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)
692 {-# NOINLINE noCharBuffer #-}
693 noCharBuffer :: CharBuffer
694 noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer
696 {-# NOINLINE noByteBuffer #-}
697 noByteBuffer :: Buffer Word8
698 noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer
700 -- ---------------------------------------------------------------------------
703 hLookAhead_ :: Handle__ -> IO Char
704 hLookAhead_ handle_@Handle__{..} = do
705 buf <- readIORef haCharBuffer
707 -- fill up the read buffer if necessary
708 new_buf <- if isEmptyBuffer buf
709 then readTextDevice handle_ buf
711 writeIORef haCharBuffer new_buf
713 peekCharBuf (bufRaw buf) (bufL buf)
715 -- ---------------------------------------------------------------------------
718 debugIO :: String -> IO ()
721 = do _ <- withCStringLen (s ++ "\n") $
722 \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
724 | otherwise = return ()
726 -- ----------------------------------------------------------------------------
729 -- Write the contents of the supplied Char buffer to the device, return
730 -- only when all the data has been written.
731 writeTextDevice :: Handle__ -> CharBuffer -> IO ()
732 writeTextDevice h_@Handle__{..} cbuf = do
734 bbuf <- readIORef haByteBuffer
736 debugIO ("writeTextDevice: cbuf=" ++ summaryBuffer cbuf ++
737 " bbuf=" ++ summaryBuffer bbuf)
739 (cbuf',bbuf') <- case haEncoder of
740 Nothing -> latin1_encode cbuf bbuf
741 Just encoder -> (encode encoder) cbuf bbuf
743 debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++
744 " bbuf=" ++ summaryBuffer bbuf')
746 bbuf' <- Buffered.flushWriteBuffer haDevice bbuf'
747 writeIORef haByteBuffer bbuf'
748 if not (isEmptyBuffer cbuf')
749 then writeTextDevice h_ cbuf'
752 -- Read characters into the provided buffer. Return when any
753 -- characters are available; raise an exception if the end of
755 readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
756 readTextDevice h_@Handle__{..} cbuf = do
758 bbuf0 <- readIORef haByteBuffer
760 debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++
761 " bbuf=" ++ summaryBuffer bbuf0)
763 bbuf1 <- if not (isEmptyBuffer bbuf0)
766 (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
767 if r == 0 then ioe_EOF else do -- raise EOF
770 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
775 writeIORef haLastDecode (error "codec_state", bbuf1)
776 latin1_decode bbuf1 cbuf
778 state <- getState decoder
779 writeIORef haLastDecode (state, bbuf1)
780 (encode decoder) bbuf1 cbuf
782 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
783 " bbuf=" ++ summaryBuffer bbuf2)
785 writeIORef haByteBuffer bbuf2
786 if bufR cbuf' == bufR cbuf -- no new characters
787 then readTextDevice' h_ bbuf2 cbuf -- we need more bytes to make a Char
790 -- we have an incomplete byte sequence at the end of the buffer: try to
792 readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
793 readTextDevice' h_@Handle__{..} bbuf0 cbuf = do
795 -- copy the partial sequence to the beginning of the buffer, so we have
796 -- room to read more bytes.
797 bbuf1 <- slideContents bbuf0
799 bbuf2 <- do (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
801 then ioe_invalidCharacter
804 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf2)
809 writeIORef haLastDecode (error "codec_state", bbuf2)
810 latin1_decode bbuf2 cbuf
812 state <- getState decoder
813 writeIORef haLastDecode (state, bbuf2)
814 (encode decoder) bbuf2 cbuf
816 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
817 " bbuf=" ++ summaryBuffer bbuf3)
819 writeIORef haByteBuffer bbuf3
820 if bufR cbuf == bufR cbuf'
821 then readTextDevice' h_ bbuf3 cbuf'
824 -- Read characters into the provided buffer. Do not block;
825 -- return zero characters instead. Raises an exception on end-of-file.
826 readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
827 readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
829 bbuf0 <- readIORef haByteBuffer
830 when (isEmptyBuffer bbuf0) $ do
831 (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
832 if isNothing r then ioe_EOF else do -- raise EOF
833 writeIORef haByteBuffer bbuf1
835 decodeByteBuf h_ cbuf
837 -- Decode bytes from the byte buffer into the supplied CharBuffer.
838 decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer
839 decodeByteBuf h_@Handle__{..} cbuf = do
841 bbuf0 <- readIORef haByteBuffer
846 writeIORef haLastDecode (error "codec_state", bbuf0)
847 latin1_decode bbuf0 cbuf
849 state <- getState decoder
850 writeIORef haLastDecode (state, bbuf0)
851 (encode decoder) bbuf0 cbuf
853 writeIORef haByteBuffer bbuf2