-{-# OPTIONS_GHC -XNoImplicitPrelude -XRecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
+{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : GHC.IO.Handle
mb_exc <- hClose' h m
hClose_maybethrow mb_exc h
hClose h@(DuplexHandle _ r w) = do
- mb_exc1 <- hClose' h w
- mb_exc2 <- hClose' h r
- case mb_exc1 of
- Nothing -> return ()
- Just e -> hClose_maybethrow mb_exc2 h
+ excs <- mapM (hClose' h) [r,w]
+ hClose_maybethrow (listToMaybe (catMaybes excs)) h
hClose_maybethrow :: Maybe SomeException -> Handle -> IO ()
-hClose_maybethrow Nothing h = return ()
+hClose_maybethrow Nothing h = return ()
hClose_maybethrow (Just e) h = hClose_rethrow e h
hClose_rethrow :: SomeException -> Handle -> IO ()
_ -> do
if mode == haBufferMode then return handle_ else do
- {- Note:
- - we flush the old buffer regardless of whether
- the new buffer could fit the contents of the old buffer
- or not.
- - allow a handle's buffering to change even if IO has
- occurred (ANSI C spec. does not allow this, nor did
- the previous implementation of IO.hSetBuffering).
- - a non-standard extension is to allow the buffering
- of semi-closed handles to change [sof 6/98]
- -}
- flushCharBuffer handle_
-
- let state = initBufferState haType
- reading = not (isWritableHandleType haType)
-
- new_buf <-
- case mode of
- -- See [note Buffer Sizing], GHC.IO.Handle.Types
- NoBuffering | reading -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
- | otherwise -> newCharBuffer 1 state
- LineBuffering -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
- BlockBuffering Nothing -> newCharBuffer dEFAULT_CHAR_BUFFER_SIZE state
- BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
- | otherwise -> newCharBuffer n state
+ -- See [note Buffer Sizing] in GHC.IO.Handle.Types
- writeIORef haCharBuffer new_buf
+ -- check for errors:
+ case mode of
+ BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
+ _ -> return ()
-- for input terminals we need to put the terminal into
-- cooked or raw mode depending on the type of buffering.
hSetEncoding hdl encoding = do
withAllHandles__ "hSetEncoding" hdl $ \h_@Handle__{..} -> do
flushCharBuffer h_
+ closeTextCodecs h_
openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do
bbuf <- readIORef haByteBuffer
ref <- newIORef (error "last_decode")
-- This operation may fail with:
--
-- * 'isIllegalOperationError' if the Handle is not seekable, or does
--- not support the requested seek mode.
+-- not support the requested seek mode.
+--
-- * 'isPermissionError' if a system resource limit would be exceeded.
hSeek :: Handle -> SeekMode -> Integer -> IO ()
posn <- IODevice.tell haDevice
- cbuf <- readIORef haCharBuffer
+ -- we can't tell the real byte offset if there are buffered
+ -- Chars, so must flush first:
+ flushCharBuffer handle_
+
bbuf <- readIORef haByteBuffer
- let real_posn
- | isWriteBuffer cbuf = posn + fromIntegral (bufR cbuf)
- | otherwise = posn - fromIntegral (bufR cbuf - bufL cbuf)
- - fromIntegral (bufR bbuf - bufL bbuf)
+ let real_posn
+ | isWriteBuffer bbuf = posn + fromIntegral (bufferElems bbuf)
+ | otherwise = posn - fromIntegral (bufferElems bbuf)
+ cbuf <- readIORef haCharBuffer
debugIO ("\nhGetPosn: (posn, real_posn) = " ++ show (posn, real_posn))
debugIO (" cbuf: " ++ summaryBuffer cbuf ++
" bbuf: " ++ summaryBuffer bbuf)
withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} ->
do
flushCharBuffer h_
+ closeTextCodecs h_
let mb_te | bin = Nothing
| otherwise = Just localeEncoding