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, initBufferState,
32 dEFAULT_CHAR_BUFFER_SIZE,
34 flushBuffer, flushWriteBuffer, flushWriteBuffer_, flushCharReadBuffer,
35 flushCharBuffer, flushByteReadBuffer,
37 readTextDevice, writeTextDevice, 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
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(..) )
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 = withHandle_' fun h m act
226 :: String -> Handle -> MVar Handle__
227 -> (Handle__ -> IO a) -> IO a
228 wantWritableHandle' fun h m act
229 = withHandle_' fun h m (checkWritableHandle act)
231 checkWritableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
232 checkWritableHandle act h_@Handle__{..}
234 ClosedHandle -> ioe_closedHandle
235 SemiClosedHandle -> ioe_closedHandle
236 ReadHandle -> ioe_notWritable
237 ReadWriteHandle -> do
238 buf <- readIORef haCharBuffer
239 when (not (isWriteBuffer buf)) $ do
240 flushCharReadBuffer h_
241 flushByteReadBuffer h_
242 buf <- readIORef haCharBuffer
243 writeIORef haCharBuffer buf{ bufState = WriteBuffer }
244 buf <- readIORef haByteBuffer
245 buf' <- Buffered.emptyWriteBuffer haDevice buf
246 writeIORef haByteBuffer buf'
250 -- ---------------------------------------------------------------------------
251 -- Wrapper for read operations.
253 wantReadableHandle :: String -> Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
254 wantReadableHandle fun h act = withHandle fun h (checkReadableHandle act)
256 wantReadableHandle_ :: String -> Handle -> (Handle__ -> IO a) -> IO a
257 wantReadableHandle_ fun h@(FileHandle _ m) act
258 = wantReadableHandle' fun h m act
259 wantReadableHandle_ fun h@(DuplexHandle _ m _) act
260 = withHandle_' fun h m act
263 :: String -> Handle -> MVar Handle__
264 -> (Handle__ -> IO a) -> IO a
265 wantReadableHandle' fun h m act
266 = withHandle_' fun h m (checkReadableHandle act)
268 checkReadableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
269 checkReadableHandle act h_@Handle__{..} =
271 ClosedHandle -> ioe_closedHandle
272 SemiClosedHandle -> ioe_closedHandle
273 AppendHandle -> ioe_notReadable
274 WriteHandle -> ioe_notReadable
275 ReadWriteHandle -> do
276 -- a read/write handle and we want to read from it. We must
277 -- flush all buffered write data first.
278 cbuf <- readIORef haCharBuffer
279 when (isWriteBuffer cbuf) $ do
280 cbuf' <- flushWriteBuffer_ h_ cbuf
281 writeIORef haCharBuffer cbuf'{ bufState = ReadBuffer }
282 bbuf <- readIORef haByteBuffer
283 writeIORef haByteBuffer bbuf{ bufState = ReadBuffer }
287 -- ---------------------------------------------------------------------------
288 -- Wrapper for seek operations.
290 wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
291 wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
292 ioException (IOError (Just h) IllegalOperation fun
293 "handle is not seekable" Nothing Nothing)
294 wantSeekableHandle fun h@(FileHandle _ m) act =
295 withHandle_' fun h m (checkSeekableHandle act)
297 checkSeekableHandle :: (Handle__ -> IO a) -> Handle__ -> IO a
298 checkSeekableHandle act handle_@Handle__{haDevice=dev} =
299 case haType handle_ of
300 ClosedHandle -> ioe_closedHandle
301 SemiClosedHandle -> ioe_closedHandle
302 AppendHandle -> ioe_notSeekable
303 _ -> do b <- IODevice.isSeekable dev
304 if b then act handle_
307 -- -----------------------------------------------------------------------------
310 ioe_closedHandle, ioe_EOF,
311 ioe_notReadable, ioe_notWritable, ioe_cannotFlushNotSeekable,
312 ioe_notSeekable, ioe_invalidCharacter :: IO a
314 ioe_closedHandle = ioException
315 (IOError Nothing IllegalOperation ""
316 "handle is closed" Nothing Nothing)
317 ioe_EOF = ioException
318 (IOError Nothing EOF "" "" Nothing Nothing)
319 ioe_notReadable = ioException
320 (IOError Nothing IllegalOperation ""
321 "handle is not open for reading" Nothing Nothing)
322 ioe_notWritable = ioException
323 (IOError Nothing IllegalOperation ""
324 "handle is not open for writing" Nothing Nothing)
325 ioe_notSeekable = ioException
326 (IOError Nothing IllegalOperation ""
327 "handle is not seekable" Nothing Nothing)
328 ioe_cannotFlushNotSeekable = ioException
329 (IOError Nothing IllegalOperation ""
330 "cannot flush the read buffer: underlying device is not seekable"
332 ioe_invalidCharacter = ioException
333 (IOError Nothing InvalidArgument ""
334 ("invalid byte sequence for this encoding") Nothing Nothing)
336 ioe_finalizedHandle :: FilePath -> Handle__
337 ioe_finalizedHandle fp = throw
338 (IOError Nothing IllegalOperation ""
339 "handle is finalized" Nothing (Just fp))
341 ioe_bufsiz :: Int -> IO a
342 ioe_bufsiz n = ioException
343 (IOError Nothing InvalidArgument "hSetBuffering"
344 ("illegal buffer size " ++ showsPrec 9 n []) Nothing Nothing)
345 -- 9 => should be parens'ified.
347 -- -----------------------------------------------------------------------------
350 -- For a duplex handle, we arrange that the read side points to the write side
351 -- (and hence keeps it alive if the read side is alive). This is done by
352 -- having the haOtherSide field of the read side point to the read side.
353 -- The finalizer is then placed on the write side, and the handle only gets
354 -- finalized once, when both sides are no longer required.
356 -- NOTE about finalized handles: It's possible that a handle can be
357 -- finalized and then we try to use it later, for example if the
358 -- handle is referenced from another finalizer, or from a thread that
359 -- has become unreferenced and then resurrected (arguably in the
360 -- latter case we shouldn't finalize the Handle...). Anyway,
361 -- we try to emit a helpful message which is better than nothing.
363 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
364 handleFinalizer fp m = do
365 handle_ <- takeMVar m
366 case haType handle_ of
367 ClosedHandle -> return ()
368 _ -> do flushWriteBuffer handle_ `catchAny` \_ -> return ()
369 -- ignore errors and async exceptions, and close the
370 -- descriptor anyway...
371 _ <- hClose_handle_ handle_
373 putMVar m (ioe_finalizedHandle fp)
375 -- ---------------------------------------------------------------------------
376 -- Allocating buffers
378 -- using an 8k char buffer instead of 32k improved performance for a
379 -- basic "cat" program by ~30% for me. --SDM
380 dEFAULT_CHAR_BUFFER_SIZE :: Int
381 dEFAULT_CHAR_BUFFER_SIZE = dEFAULT_BUFFER_SIZE `div` 4
383 getCharBuffer :: IODevice dev => dev -> BufferState
384 -> IO (IORef CharBuffer, BufferMode)
385 getCharBuffer dev state = do
386 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
387 ioref <- newIORef buffer
388 is_tty <- IODevice.isTerminal dev
391 | is_tty = LineBuffering
392 | otherwise = BlockBuffering Nothing
394 return (ioref, buffer_mode)
396 mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
397 mkUnBuffer state = do
398 buffer <- case state of -- See [note Buffer Sizing], GHC.IO.Handle.Types
399 ReadBuffer -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
400 WriteBuffer -> newCharBuffer 1 state
401 ref <- newIORef buffer
402 return (ref, NoBuffering)
404 -- -----------------------------------------------------------------------------
407 -- | syncs the file with the buffer, including moving the
408 -- file pointer backwards in the case of a read buffer. This can fail
409 -- on a non-seekable read Handle.
410 flushBuffer :: Handle__ -> IO ()
411 flushBuffer h_@Handle__{..} = do
412 buf <- readIORef haCharBuffer
415 flushCharReadBuffer h_
416 flushByteReadBuffer h_
418 buf' <- flushWriteBuffer_ h_ buf
419 writeIORef haCharBuffer buf'
421 -- | flushes at least the Char buffer, and the byte buffer for a write
422 -- Handle. Works on all Handles.
423 flushCharBuffer :: Handle__ -> IO ()
424 flushCharBuffer h_@Handle__{..} = do
425 buf <- readIORef haCharBuffer
428 flushCharReadBuffer h_
430 buf' <- flushWriteBuffer_ h_ buf
431 writeIORef haCharBuffer buf'
433 -- -----------------------------------------------------------------------------
434 -- Writing data (flushing write buffers)
436 -- flushWriteBuffer flushes the buffer iff it contains pending write
437 -- data. Flushes both the Char and the byte buffer, leaving both
439 flushWriteBuffer :: Handle__ -> IO ()
440 flushWriteBuffer h_@Handle__{..} = do
441 buf <- readIORef haCharBuffer
443 then do buf' <- flushWriteBuffer_ h_ buf
444 writeIORef haCharBuffer buf'
447 flushWriteBuffer_ :: Handle__ -> CharBuffer -> IO CharBuffer
448 flushWriteBuffer_ h_@Handle__{..} cbuf = do
449 bbuf <- readIORef haByteBuffer
450 if not (isEmptyBuffer cbuf) || not (isEmptyBuffer bbuf)
451 then do writeTextDevice h_ cbuf
452 return cbuf{ bufL=0, bufR=0 }
455 -- -----------------------------------------------------------------------------
456 -- Flushing read buffers
458 -- It is always possible to flush the Char buffer back to the byte buffer.
459 flushCharReadBuffer :: Handle__ -> IO ()
460 flushCharReadBuffer Handle__{..} = do
461 cbuf <- readIORef haCharBuffer
462 if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
464 -- haLastDecode is the byte buffer just before we did our last batch of
465 -- decoding. We're going to re-decode the bytes up to the current char,
466 -- to find out where we should revert the byte buffer to.
467 (codec_state, bbuf0) <- readIORef haLastDecode
469 cbuf0 <- readIORef haCharBuffer
470 writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
472 -- if we haven't used any characters from the char buffer, then just
473 -- re-install the old byte buffer.
475 then do writeIORef haByteBuffer bbuf0
481 writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
482 -- no decoder: the number of bytes to decode is the same as the
483 -- number of chars we have used up.
486 debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
487 " cbuf=" ++ summaryBuffer cbuf0)
489 -- restore the codec state
490 setState decoder codec_state
492 (bbuf1,cbuf1) <- (encode decoder) bbuf0
493 cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
495 debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
496 " cbuf=" ++ summaryBuffer cbuf1)
498 writeIORef haByteBuffer bbuf1
501 -- When flushing the byte read buffer, we seek backwards by the number
502 -- of characters in the buffer. The file descriptor must therefore be
503 -- seekable: attempting to flush the read buffer on an unseekable
504 -- handle is not allowed.
506 flushByteReadBuffer :: Handle__ -> IO ()
507 flushByteReadBuffer h_@Handle__{..} = do
508 bbuf <- readIORef haByteBuffer
510 if isEmptyBuffer bbuf then return () else do
512 seekable <- IODevice.isSeekable haDevice
513 when (not seekable) $ ioe_cannotFlushNotSeekable
515 let seek = negate (bufR bbuf - bufL bbuf)
517 debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
518 IODevice.seek haDevice RelativeSeek (fromIntegral seek)
520 writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
522 -- ----------------------------------------------------------------------------
525 mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
529 -> Maybe TextEncoding
531 -> Maybe HandleFinalizer
532 -> Maybe (MVar Handle__)
535 mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
536 openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
538 let buf_state = initBufferState ha_type
539 bbuf <- Buffered.newBuffer dev buf_state
540 bbufref <- newIORef bbuf
541 last_decode <- newIORef (error "codec_state", bbuf)
544 if buffered then getCharBuffer dev buf_state
545 else mkUnBuffer buf_state
547 spares <- newIORef BufferListNil
548 newFileHandle filepath finalizer
549 (Handle__ { haDevice = dev,
551 haBufferMode = bmode,
552 haByteBuffer = bbufref,
553 haLastDecode = last_decode,
554 haCharBuffer = cbufref,
556 haEncoder = mb_encoder,
557 haDecoder = mb_decoder,
559 haInputNL = inputNL nl,
560 haOutputNL = outputNL nl,
561 haOtherSide = other_side
564 -- | makes a new 'Handle'
565 mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
566 => dev -- ^ the underlying IO device, which must support
567 -- 'IODevice', 'BufferedIO' and 'Typeable'
569 -- ^ a string describing the 'Handle', e.g. the file
570 -- path for a file. Used in error messages.
572 -- The mode in which the 'Handle' is to be used
573 -> Maybe TextEncoding
574 -- Create the 'Handle' with no text encoding?
576 -- Translate newlines?
578 mkFileHandle dev filepath iomode mb_codec tr_newlines = do
579 mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec
581 (Just handleFinalizer) Nothing{-other_side-}
583 -- | like 'mkFileHandle', except that a 'Handle' is created with two
584 -- independent buffers, one for reading and one for writing. Used for
585 -- full-dupliex streams, such as network sockets.
586 mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
587 -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
588 mkDuplexHandle dev filepath mb_codec tr_newlines = do
590 write_side@(FileHandle _ write_m) <-
591 mkHandle dev filepath WriteHandle True mb_codec
593 (Just handleFinalizer)
594 Nothing -- no othersie
596 read_side@(FileHandle _ read_m) <-
597 mkHandle dev filepath ReadHandle True mb_codec
599 Nothing -- no finalizer
602 return (DuplexHandle filepath read_m write_m)
604 ioModeToHandleType :: IOMode -> HandleType
605 ioModeToHandleType ReadMode = ReadHandle
606 ioModeToHandleType WriteMode = WriteHandle
607 ioModeToHandleType ReadWriteMode = ReadWriteHandle
608 ioModeToHandleType AppendMode = AppendHandle
610 initBufferState :: HandleType -> BufferState
611 initBufferState ReadHandle = ReadBuffer
612 initBufferState _ = WriteBuffer
615 :: Maybe TextEncoding
617 -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
620 openTextEncoding Nothing ha_type cont = cont Nothing Nothing
621 openTextEncoding (Just TextEncoding{..}) ha_type cont = do
622 mb_decoder <- if isReadableHandleType ha_type then do
623 decoder <- mkTextDecoder
624 return (Just decoder)
627 mb_encoder <- if isWritableHandleType ha_type then do
628 encoder <- mkTextEncoder
629 return (Just encoder)
632 cont mb_encoder mb_decoder
634 -- ---------------------------------------------------------------------------
637 -- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
638 -- EOF is read or an IO error occurs on a lazy stream. The
639 -- semi-closed Handle is then closed immediately. We have to be
640 -- careful with DuplexHandles though: we have to leave the closing to
641 -- the finalizer in that case, because the write side may still be in
643 hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
644 hClose_help handle_ =
645 case haType handle_ of
646 ClosedHandle -> return (handle_,Nothing)
647 _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
648 -- it is important that hClose doesn't fail and
649 -- leave the Handle open (#3128), so we catch
650 -- exceptions when flushing the buffer.
651 (h_, mb_exc2) <- hClose_handle_ handle_
652 return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
655 trymaybe :: IO () -> IO (Maybe SomeException)
656 trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
658 hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
659 hClose_handle_ Handle__{..} = do
661 -- close the file descriptor, but not when this is the read
662 -- side of a duplex handle.
663 -- If an exception is raised by the close(), we want to continue
664 -- to close the handle and release the lock if it has one, then
665 -- we return the exception to the caller of hClose_help which can
666 -- raise it if necessary.
669 Nothing -> trymaybe $ IODevice.close haDevice
670 Just _ -> return Nothing
672 -- free the spare buffers
673 writeIORef haBuffers BufferListNil
674 writeIORef haCharBuffer noCharBuffer
675 writeIORef haByteBuffer noByteBuffer
677 -- release our encoder/decoder
678 case haDecoder of Nothing -> return (); Just d -> close d
679 case haEncoder of Nothing -> return (); Just d -> close d
681 -- we must set the fd to -1, because the finalizer is going
682 -- to run eventually and try to close/unlock it.
683 -- ToDo: necessary? the handle will be marked ClosedHandle
684 -- XXX GHC won't let us use record update here, hence wildcards
685 return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)
687 {-# NOINLINE noCharBuffer #-}
688 noCharBuffer :: CharBuffer
689 noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer
691 {-# NOINLINE noByteBuffer #-}
692 noByteBuffer :: Buffer Word8
693 noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer
695 -- ---------------------------------------------------------------------------
698 hLookAhead_ :: Handle__ -> IO Char
699 hLookAhead_ handle_@Handle__{..} = do
700 buf <- readIORef haCharBuffer
702 -- fill up the read buffer if necessary
703 new_buf <- if isEmptyBuffer buf
704 then readTextDevice handle_ buf
706 writeIORef haCharBuffer new_buf
708 peekCharBuf (bufRaw buf) (bufL buf)
710 -- ---------------------------------------------------------------------------
713 debugIO :: String -> IO ()
716 = do _ <- withCStringLen (s ++ "\n") $
717 \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
719 | otherwise = return ()
721 -- ----------------------------------------------------------------------------
724 -- Write the contents of the supplied Char buffer to the device, return
725 -- only when all the data has been written.
726 writeTextDevice :: Handle__ -> CharBuffer -> IO ()
727 writeTextDevice h_@Handle__{..} cbuf = do
729 bbuf <- readIORef haByteBuffer
731 debugIO ("writeTextDevice: cbuf=" ++ summaryBuffer cbuf ++
732 " bbuf=" ++ summaryBuffer bbuf)
734 (cbuf',bbuf') <- case haEncoder of
735 Nothing -> latin1_encode cbuf bbuf
736 Just encoder -> (encode encoder) cbuf bbuf
738 debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++
739 " bbuf=" ++ summaryBuffer bbuf')
741 bbuf' <- Buffered.flushWriteBuffer haDevice bbuf'
742 writeIORef haByteBuffer bbuf'
743 if not (isEmptyBuffer cbuf')
744 then writeTextDevice h_ cbuf'
747 -- Read characters into the provided buffer. Return when any
748 -- characters are available; raise an exception if the end of
750 readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
751 readTextDevice h_@Handle__{..} cbuf = do
753 bbuf0 <- readIORef haByteBuffer
755 debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++
756 " bbuf=" ++ summaryBuffer bbuf0)
758 bbuf1 <- if not (isEmptyBuffer bbuf0)
761 (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
762 if r == 0 then ioe_EOF else do -- raise EOF
765 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
770 writeIORef haLastDecode (error "codec_state", bbuf1)
771 latin1_decode bbuf1 cbuf
773 state <- getState decoder
774 writeIORef haLastDecode (state, bbuf1)
775 (encode decoder) bbuf1 cbuf
777 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
778 " bbuf=" ++ summaryBuffer bbuf2)
780 writeIORef haByteBuffer bbuf2
781 if bufR cbuf' == bufR cbuf -- no new characters
782 then readTextDevice' h_ bbuf2 cbuf -- we need more bytes to make a Char
785 -- we have an incomplete byte sequence at the end of the buffer: try to
787 readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
788 readTextDevice' h_@Handle__{..} bbuf0 cbuf = do
790 -- copy the partial sequence to the beginning of the buffer, so we have
791 -- room to read more bytes.
792 bbuf1 <- slideContents bbuf0
794 bbuf2 <- do (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
796 then ioe_invalidCharacter
799 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf2)
804 writeIORef haLastDecode (error "codec_state", bbuf2)
805 latin1_decode bbuf2 cbuf
807 state <- getState decoder
808 writeIORef haLastDecode (state, bbuf2)
809 (encode decoder) bbuf2 cbuf
811 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
812 " bbuf=" ++ summaryBuffer bbuf3)
814 writeIORef haByteBuffer bbuf3
815 if bufR cbuf == bufR cbuf'
816 then readTextDevice' h_ bbuf3 cbuf'
819 -- Read characters into the provided buffer. Do not block;
820 -- return zero characters instead. Raises an exception on end-of-file.
821 readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
822 readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
824 bbuf0 <- readIORef haByteBuffer
825 bbuf1 <- if not (isEmptyBuffer bbuf0)
828 (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
829 if isNothing r then ioe_EOF else do -- raise EOF
835 writeIORef haLastDecode (error "codec_state", bbuf1)
836 latin1_decode bbuf1 cbuf
838 state <- getState decoder
839 writeIORef haLastDecode (state, bbuf1)
840 (encode decoder) bbuf1 cbuf
842 writeIORef haByteBuffer bbuf2