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, flushWriteBuffer_, flushCharReadBuffer,
34 flushCharBuffer, flushByteReadBuffer,
36 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 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 = 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 -- [later; 8/2010] However, a program like this can yield a strange
366 -- main = writeFile "out" loop
367 -- loop = let x = x in x
369 -- because the main thread and the Handle are both unreachable at the
370 -- same time, the Handle may get finalized before the main thread
371 -- receives the NonTermination exception, and the exception handler
372 -- will then report an error. We'd rather this was not an error and
373 -- the program just prints "<<loop>>".
375 handleFinalizer :: FilePath -> MVar Handle__ -> IO ()
376 handleFinalizer fp m = do
377 handle_ <- takeMVar m
378 (handle_', _) <- hClose_help handle_
382 -- ---------------------------------------------------------------------------
383 -- Allocating buffers
385 -- using an 8k char buffer instead of 32k improved performance for a
386 -- basic "cat" program by ~30% for me. --SDM
387 dEFAULT_CHAR_BUFFER_SIZE :: Int
388 dEFAULT_CHAR_BUFFER_SIZE = dEFAULT_BUFFER_SIZE `div` 4
390 getCharBuffer :: IODevice dev => dev -> BufferState
391 -> IO (IORef CharBuffer, BufferMode)
392 getCharBuffer dev state = do
393 buffer <- newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
394 ioref <- newIORef buffer
395 is_tty <- IODevice.isTerminal dev
398 | is_tty = LineBuffering
399 | otherwise = BlockBuffering Nothing
401 return (ioref, buffer_mode)
403 mkUnBuffer :: BufferState -> IO (IORef CharBuffer, BufferMode)
404 mkUnBuffer state = do
405 buffer <- case state of -- See [note Buffer Sizing], GHC.IO.Handle.Types
406 ReadBuffer -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
407 WriteBuffer -> newCharBuffer 1 state
408 ref <- newIORef buffer
409 return (ref, NoBuffering)
411 -- -----------------------------------------------------------------------------
414 -- | syncs the file with the buffer, including moving the
415 -- file pointer backwards in the case of a read buffer. This can fail
416 -- on a non-seekable read Handle.
417 flushBuffer :: Handle__ -> IO ()
418 flushBuffer h_@Handle__{..} = do
419 buf <- readIORef haCharBuffer
422 flushCharReadBuffer h_
423 flushByteReadBuffer h_
425 buf' <- flushWriteBuffer_ h_ buf
426 writeIORef haCharBuffer buf'
428 -- | flushes at least the Char buffer, and the byte buffer for a write
429 -- Handle. Works on all Handles.
430 flushCharBuffer :: Handle__ -> IO ()
431 flushCharBuffer h_@Handle__{..} = do
432 buf <- readIORef haCharBuffer
435 flushCharReadBuffer h_
437 buf' <- flushWriteBuffer_ h_ buf
438 writeIORef haCharBuffer buf'
440 -- -----------------------------------------------------------------------------
441 -- Writing data (flushing write buffers)
443 -- flushWriteBuffer flushes the buffer iff it contains pending write
444 -- data. Flushes both the Char and the byte buffer, leaving both
446 flushWriteBuffer :: Handle__ -> IO ()
447 flushWriteBuffer h_@Handle__{..} = do
448 buf <- readIORef haCharBuffer
450 then do buf' <- flushWriteBuffer_ h_ buf
451 writeIORef haCharBuffer buf'
454 flushWriteBuffer_ :: Handle__ -> CharBuffer -> IO CharBuffer
455 flushWriteBuffer_ h_@Handle__{..} cbuf = do
456 bbuf <- readIORef haByteBuffer
457 if not (isEmptyBuffer cbuf) || not (isEmptyBuffer bbuf)
458 then do writeTextDevice h_ cbuf
459 return cbuf{ bufL=0, bufR=0 }
462 -- -----------------------------------------------------------------------------
463 -- Flushing read buffers
465 -- It is always possible to flush the Char buffer back to the byte buffer.
466 flushCharReadBuffer :: Handle__ -> IO ()
467 flushCharReadBuffer Handle__{..} = do
468 cbuf <- readIORef haCharBuffer
469 if isWriteBuffer cbuf || isEmptyBuffer cbuf then return () else do
471 -- haLastDecode is the byte buffer just before we did our last batch of
472 -- decoding. We're going to re-decode the bytes up to the current char,
473 -- to find out where we should revert the byte buffer to.
474 (codec_state, bbuf0) <- readIORef haLastDecode
476 cbuf0 <- readIORef haCharBuffer
477 writeIORef haCharBuffer cbuf0{ bufL=0, bufR=0 }
479 -- if we haven't used any characters from the char buffer, then just
480 -- re-install the old byte buffer.
482 then do writeIORef haByteBuffer bbuf0
488 writeIORef haByteBuffer bbuf0 { bufL = bufL bbuf0 + bufL cbuf0 }
489 -- no decoder: the number of bytes to decode is the same as the
490 -- number of chars we have used up.
493 debugIO ("flushCharReadBuffer re-decode, bbuf=" ++ summaryBuffer bbuf0 ++
494 " cbuf=" ++ summaryBuffer cbuf0)
496 -- restore the codec state
497 setState decoder codec_state
499 (bbuf1,cbuf1) <- (encode decoder) bbuf0
500 cbuf0{ bufL=0, bufR=0, bufSize = bufL cbuf0 }
502 debugIO ("finished, bbuf=" ++ summaryBuffer bbuf1 ++
503 " cbuf=" ++ summaryBuffer cbuf1)
505 writeIORef haByteBuffer bbuf1
508 -- When flushing the byte read buffer, we seek backwards by the number
509 -- of characters in the buffer. The file descriptor must therefore be
510 -- seekable: attempting to flush the read buffer on an unseekable
511 -- handle is not allowed.
513 flushByteReadBuffer :: Handle__ -> IO ()
514 flushByteReadBuffer h_@Handle__{..} = do
515 bbuf <- readIORef haByteBuffer
517 if isEmptyBuffer bbuf then return () else do
519 seekable <- IODevice.isSeekable haDevice
520 when (not seekable) $ ioe_cannotFlushNotSeekable
522 let seek = negate (bufR bbuf - bufL bbuf)
524 debugIO ("flushByteReadBuffer: new file offset = " ++ show seek)
525 IODevice.seek haDevice RelativeSeek (fromIntegral seek)
527 writeIORef haByteBuffer bbuf{ bufL=0, bufR=0 }
529 -- ----------------------------------------------------------------------------
532 mkHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
536 -> Maybe TextEncoding
538 -> Maybe HandleFinalizer
539 -> Maybe (MVar Handle__)
542 mkHandle dev filepath ha_type buffered mb_codec nl finalizer other_side = do
543 openTextEncoding mb_codec ha_type $ \ mb_encoder mb_decoder -> do
545 let buf_state = initBufferState ha_type
546 bbuf <- Buffered.newBuffer dev buf_state
547 bbufref <- newIORef bbuf
548 last_decode <- newIORef (error "codec_state", bbuf)
551 if buffered then getCharBuffer dev buf_state
552 else mkUnBuffer buf_state
554 spares <- newIORef BufferListNil
555 newFileHandle filepath finalizer
556 (Handle__ { haDevice = dev,
558 haBufferMode = bmode,
559 haByteBuffer = bbufref,
560 haLastDecode = last_decode,
561 haCharBuffer = cbufref,
563 haEncoder = mb_encoder,
564 haDecoder = mb_decoder,
566 haInputNL = inputNL nl,
567 haOutputNL = outputNL nl,
568 haOtherSide = other_side
571 -- | makes a new 'Handle'
572 mkFileHandle :: (IODevice dev, BufferedIO dev, Typeable dev)
573 => dev -- ^ the underlying IO device, which must support
574 -- 'IODevice', 'BufferedIO' and 'Typeable'
576 -- ^ a string describing the 'Handle', e.g. the file
577 -- path for a file. Used in error messages.
579 -- The mode in which the 'Handle' is to be used
580 -> Maybe TextEncoding
581 -- Create the 'Handle' with no text encoding?
583 -- Translate newlines?
585 mkFileHandle dev filepath iomode mb_codec tr_newlines = do
586 mkHandle dev filepath (ioModeToHandleType iomode) True{-buffered-} mb_codec
588 (Just handleFinalizer) Nothing{-other_side-}
590 -- | like 'mkFileHandle', except that a 'Handle' is created with two
591 -- independent buffers, one for reading and one for writing. Used for
592 -- full-duplex streams, such as network sockets.
593 mkDuplexHandle :: (IODevice dev, BufferedIO dev, Typeable dev) => dev
594 -> FilePath -> Maybe TextEncoding -> NewlineMode -> IO Handle
595 mkDuplexHandle dev filepath mb_codec tr_newlines = do
597 write_side@(FileHandle _ write_m) <-
598 mkHandle dev filepath WriteHandle True mb_codec
600 (Just handleFinalizer)
601 Nothing -- no othersie
603 read_side@(FileHandle _ read_m) <-
604 mkHandle dev filepath ReadHandle True mb_codec
606 Nothing -- no finalizer
609 return (DuplexHandle filepath read_m write_m)
611 ioModeToHandleType :: IOMode -> HandleType
612 ioModeToHandleType ReadMode = ReadHandle
613 ioModeToHandleType WriteMode = WriteHandle
614 ioModeToHandleType ReadWriteMode = ReadWriteHandle
615 ioModeToHandleType AppendMode = AppendHandle
617 initBufferState :: HandleType -> BufferState
618 initBufferState ReadHandle = ReadBuffer
619 initBufferState _ = WriteBuffer
622 :: Maybe TextEncoding
624 -> (forall es ds . Maybe (TextEncoder es) -> Maybe (TextDecoder ds) -> IO a)
627 openTextEncoding Nothing ha_type cont = cont Nothing Nothing
628 openTextEncoding (Just TextEncoding{..}) ha_type cont = do
629 mb_decoder <- if isReadableHandleType ha_type then do
630 decoder <- mkTextDecoder
631 return (Just decoder)
634 mb_encoder <- if isWritableHandleType ha_type then do
635 encoder <- mkTextEncoder
636 return (Just encoder)
639 cont mb_encoder mb_decoder
641 closeTextCodecs :: Handle__ -> IO ()
642 closeTextCodecs Handle__{..} = do
643 case haDecoder of Nothing -> return (); Just d -> Encoding.close d
644 case haEncoder of Nothing -> return (); Just d -> Encoding.close d
646 -- ---------------------------------------------------------------------------
649 -- hClose_help is also called by lazyRead (in GHC.IO.Handle.Text) when
650 -- EOF is read or an IO error occurs on a lazy stream. The
651 -- semi-closed Handle is then closed immediately. We have to be
652 -- careful with DuplexHandles though: we have to leave the closing to
653 -- the finalizer in that case, because the write side may still be in
655 hClose_help :: Handle__ -> IO (Handle__, Maybe SomeException)
656 hClose_help handle_ =
657 case haType handle_ of
658 ClosedHandle -> return (handle_,Nothing)
659 _ -> do mb_exc1 <- trymaybe $ flushWriteBuffer handle_ -- interruptible
660 -- it is important that hClose doesn't fail and
661 -- leave the Handle open (#3128), so we catch
662 -- exceptions when flushing the buffer.
663 (h_, mb_exc2) <- hClose_handle_ handle_
664 return (h_, if isJust mb_exc1 then mb_exc1 else mb_exc2)
667 trymaybe :: IO () -> IO (Maybe SomeException)
668 trymaybe io = (do io; return Nothing) `catchException` \e -> return (Just e)
670 hClose_handle_ :: Handle__ -> IO (Handle__, Maybe SomeException)
671 hClose_handle_ h_@Handle__{..} = do
673 -- close the file descriptor, but not when this is the read
674 -- side of a duplex handle.
675 -- If an exception is raised by the close(), we want to continue
676 -- to close the handle and release the lock if it has one, then
677 -- we return the exception to the caller of hClose_help which can
678 -- raise it if necessary.
681 Nothing -> trymaybe $ IODevice.close haDevice
682 Just _ -> return Nothing
684 -- free the spare buffers
685 writeIORef haBuffers BufferListNil
686 writeIORef haCharBuffer noCharBuffer
687 writeIORef haByteBuffer noByteBuffer
689 -- release our encoder/decoder
692 -- we must set the fd to -1, because the finalizer is going
693 -- to run eventually and try to close/unlock it.
694 -- ToDo: necessary? the handle will be marked ClosedHandle
695 -- XXX GHC won't let us use record update here, hence wildcards
696 return (Handle__{ haType = ClosedHandle, .. }, maybe_exception)
698 {-# NOINLINE noCharBuffer #-}
699 noCharBuffer :: CharBuffer
700 noCharBuffer = unsafePerformIO $ newCharBuffer 1 ReadBuffer
702 {-# NOINLINE noByteBuffer #-}
703 noByteBuffer :: Buffer Word8
704 noByteBuffer = unsafePerformIO $ newByteBuffer 1 ReadBuffer
706 -- ---------------------------------------------------------------------------
709 hLookAhead_ :: Handle__ -> IO Char
710 hLookAhead_ handle_@Handle__{..} = do
711 buf <- readIORef haCharBuffer
713 -- fill up the read buffer if necessary
714 new_buf <- if isEmptyBuffer buf
715 then readTextDevice handle_ buf
717 writeIORef haCharBuffer new_buf
719 peekCharBuf (bufRaw buf) (bufL buf)
721 -- ---------------------------------------------------------------------------
724 debugIO :: String -> IO ()
727 = do _ <- withCStringLen (s ++ "\n") $
728 \(p, len) -> c_write 1 (castPtr p) (fromIntegral len)
730 | otherwise = return ()
732 -- ----------------------------------------------------------------------------
735 -- Write the contents of the supplied Char buffer to the device, return
736 -- only when all the data has been written.
737 writeTextDevice :: Handle__ -> CharBuffer -> IO ()
738 writeTextDevice h_@Handle__{..} cbuf = do
740 bbuf <- readIORef haByteBuffer
742 debugIO ("writeTextDevice: cbuf=" ++ summaryBuffer cbuf ++
743 " bbuf=" ++ summaryBuffer bbuf)
745 (cbuf',bbuf') <- case haEncoder of
746 Nothing -> latin1_encode cbuf bbuf
747 Just encoder -> (encode encoder) cbuf bbuf
749 debugIO ("writeTextDevice after encoding: cbuf=" ++ summaryBuffer cbuf' ++
750 " bbuf=" ++ summaryBuffer bbuf')
752 bbuf' <- Buffered.flushWriteBuffer haDevice bbuf'
753 writeIORef haByteBuffer bbuf'
754 if not (isEmptyBuffer cbuf')
755 then writeTextDevice h_ cbuf'
758 -- Read characters into the provided buffer. Return when any
759 -- characters are available; raise an exception if the end of
761 readTextDevice :: Handle__ -> CharBuffer -> IO CharBuffer
762 readTextDevice h_@Handle__{..} cbuf = do
764 bbuf0 <- readIORef haByteBuffer
766 debugIO ("readTextDevice: cbuf=" ++ summaryBuffer cbuf ++
767 " bbuf=" ++ summaryBuffer bbuf0)
769 bbuf1 <- if not (isEmptyBuffer bbuf0)
772 (r,bbuf1) <- Buffered.fillReadBuffer haDevice bbuf0
773 if r == 0 then ioe_EOF else do -- raise EOF
776 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf1)
781 writeIORef haLastDecode (error "codec_state", bbuf1)
782 latin1_decode bbuf1 cbuf
784 state <- getState decoder
785 writeIORef haLastDecode (state, bbuf1)
786 (encode decoder) bbuf1 cbuf
788 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
789 " bbuf=" ++ summaryBuffer bbuf2)
791 writeIORef haByteBuffer bbuf2
792 if bufR cbuf' == bufR cbuf -- no new characters
793 then readTextDevice' h_ bbuf2 cbuf -- we need more bytes to make a Char
796 -- we have an incomplete byte sequence at the end of the buffer: try to
798 readTextDevice' :: Handle__ -> Buffer Word8 -> CharBuffer -> IO CharBuffer
799 readTextDevice' h_@Handle__{..} bbuf0 cbuf = do
801 -- copy the partial sequence to the beginning of the buffer, so we have
802 -- room to read more bytes.
803 bbuf1 <- slideContents bbuf0
805 bbuf2 <- do (r,bbuf2) <- Buffered.fillReadBuffer haDevice bbuf1
807 then ioe_invalidCharacter
810 debugIO ("readTextDevice after reading: bbuf=" ++ summaryBuffer bbuf2)
815 writeIORef haLastDecode (error "codec_state", bbuf2)
816 latin1_decode bbuf2 cbuf
818 state <- getState decoder
819 writeIORef haLastDecode (state, bbuf2)
820 (encode decoder) bbuf2 cbuf
822 debugIO ("readTextDevice after decoding: cbuf=" ++ summaryBuffer cbuf' ++
823 " bbuf=" ++ summaryBuffer bbuf3)
825 writeIORef haByteBuffer bbuf3
826 if bufR cbuf == bufR cbuf'
827 then readTextDevice' h_ bbuf3 cbuf'
830 -- Read characters into the provided buffer. Do not block;
831 -- return zero characters instead. Raises an exception on end-of-file.
832 readTextDeviceNonBlocking :: Handle__ -> CharBuffer -> IO CharBuffer
833 readTextDeviceNonBlocking h_@Handle__{..} cbuf = do
835 bbuf0 <- readIORef haByteBuffer
836 when (isEmptyBuffer bbuf0) $ do
837 (r,bbuf1) <- Buffered.fillReadBuffer0 haDevice bbuf0
838 if isNothing r then ioe_EOF else do -- raise EOF
839 writeIORef haByteBuffer bbuf1
841 decodeByteBuf h_ cbuf
843 -- Decode bytes from the byte buffer into the supplied CharBuffer.
844 decodeByteBuf :: Handle__ -> CharBuffer -> IO CharBuffer
845 decodeByteBuf h_@Handle__{..} cbuf = do
847 bbuf0 <- readIORef haByteBuffer
852 writeIORef haLastDecode (error "codec_state", bbuf0)
853 latin1_decode bbuf0 cbuf
855 state <- getState decoder
856 writeIORef haLastDecode (state, bbuf0)
857 (encode decoder) bbuf0 cbuf
859 writeIORef haByteBuffer bbuf2