-{-# OPTIONS_GHC -fno-implicit-prelude #-}
-{-# OPTIONS_GHC -XRecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}
+{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-}
+
-----------------------------------------------------------------------------
-- |
-- Module : GHC.IO.Handle
mkFileHandle, mkDuplexHandle,
hFileSize, hSetFileSize, hIsEOF, hLookAhead,
- hSetBuffering, hSetBinaryMode, hSetEncoding,
- hFlush, hDuplicate, hDuplicateTo,
+ hSetBuffering, hSetBinaryMode, hSetEncoding, hGetEncoding,
+ hFlush, hFlushAll, hDuplicate, hDuplicateTo,
hClose, hClose_help,
import GHC.IO.Handle.Types
import GHC.IO.Handle.Internals
import GHC.IO.Handle.Text
-import System.IO.Error
+import qualified GHC.IO.BufferedIO as Buffered
import GHC.Base
import GHC.Exception
-- physical file, if the current I\/O position is equal to the length of
-- the file. Otherwise, it returns 'False'.
--
--- NOTE: 'hIsEOF' may block, because it is the same as calling
--- 'hLookAhead' and checking for an EOF exception.
+-- NOTE: 'hIsEOF' may block, because it has to attempt to read from
+-- the stream to determine whether there is any more data to be read.
hIsEOF :: Handle -> IO Bool
-hIsEOF handle =
- catch
- (do hLookAhead handle; return False)
- (\e -> if isEOFError e then return True else ioError e)
+hIsEOF handle = wantReadableHandle_ "hIsEOF" handle $ \Handle__{..} -> do
+
+ cbuf <- readIORef haCharBuffer
+ if not (isEmptyBuffer cbuf) then return False else do
+
+ bbuf <- readIORef haByteBuffer
+ if not (isEmptyBuffer bbuf) then return False else do
+
+ -- NB. do no decoding, just fill the byte buffer; see #3808
+ (r,bbuf') <- Buffered.fillReadBuffer haDevice bbuf
+ if r == 0
+ then return True
+ else do writeIORef haByteBuffer bbuf'
+ return False
-- ---------------------------------------------------------------------------
-- Looking ahead
_ -> 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
-- | The action 'hSetEncoding' @hdl@ @encoding@ changes the text encoding
--- for the handle @hdl@ to @encoding@. Encodings are available from the
--- module "GHC.IO.Encoding". The default encoding when a 'Handle' is
+-- for the handle @hdl@ to @encoding@. The default encoding when a 'Handle' is
-- created is 'localeEncoding', namely the default encoding for the current
-- locale.
--
-- stop further encoding or decoding on an existing 'Handle', use
-- 'hSetBinaryMode'.
--
+-- 'hSetEncoding' may need to flush buffered data in order to change
+-- the encoding.
+--
hSetEncoding :: Handle -> TextEncoding -> IO ()
hSetEncoding hdl encoding = do
- withHandle "hSetEncoding" hdl $ \h_@Handle__{..} -> do
+ withAllHandles__ "hSetEncoding" hdl $ \h_@Handle__{..} -> do
flushCharBuffer h_
- (mb_encoder,mb_decoder) <- getEncoding (Just encoding) haType
- return (Handle__{ haDecoder = mb_decoder, haEncoder = mb_encoder, .. },
- ())
+ closeTextCodecs h_
+ openTextEncoding (Just encoding) haType $ \ mb_encoder mb_decoder -> do
+ bbuf <- readIORef haByteBuffer
+ ref <- newIORef (error "last_decode")
+ return (Handle__{ haLastDecode = ref,
+ haDecoder = mb_decoder,
+ haEncoder = mb_encoder,
+ haCodec = Just encoding, .. })
+
+-- | Return the current 'TextEncoding' for the specified 'Handle', or
+-- 'Nothing' if the 'Handle' is in binary mode.
+--
+-- Note that the 'TextEncoding' remembers nothing about the state of
+-- the encoder/decoder in use on this 'Handle'. For example, if the
+-- encoding in use is UTF-16, then using 'hGetEncoding' and
+-- 'hSetEncoding' to save and restore the encoding may result in an
+-- extra byte-order-mark being written to the file.
+--
+hGetEncoding :: Handle -> IO (Maybe TextEncoding)
+hGetEncoding hdl =
+ withHandle_ "hGetEncoding" hdl $ \h_@Handle__{..} -> return haCodec
-- -----------------------------------------------------------------------------
-- hFlush
hFlush :: Handle -> IO ()
hFlush handle = wantWritableHandle "hFlush" handle flushWriteBuffer
+-- | The action 'hFlushAll' @hdl@ flushes all buffered data in @hdl@,
+-- including any buffered read data. Buffered read data is flushed
+-- by seeking the file position back to the point before the bufferred
+-- data was read, and hence only works if @hdl@ is seekable (see
+-- 'hIsSeekable').
+--
+-- This operation may fail with:
+--
+-- * 'isFullError' if the device is full;
+--
+-- * 'isPermissionError' if a system resource limit would be exceeded.
+-- It is unspecified whether the characters in the buffer are discarded
+-- or retained under these circumstances;
+--
+-- * 'isIllegalOperation' if @hdl@ has buffered read data, and is not
+-- seekable.
+
+hFlushAll :: Handle -> IO ()
+hFlushAll handle = withHandle_ "hFlushAll" handle flushBuffer
+
-- -----------------------------------------------------------------------------
-- Repositioning Handles
--
-- This operation may fail with:
--
+-- * 'isIllegalOperationError' if the Handle is not seekable, or does
+-- not support the requested seek mode.
+--
-- * 'isPermissionError' if a system resource limit would be exceeded.
hSeek :: Handle -> SeekMode -> Integer -> IO ()
IODevice.seek haDevice mode offset
+-- | Computation 'hTell' @hdl@ returns the current position of the
+-- handle @hdl@, as the number of bytes from the beginning of
+-- the file. The value returned may be subsequently passed to
+-- 'hSeek' to reposition the handle to the current position.
+--
+-- This operation may fail with:
+--
+-- * 'isIllegalOperationError' if the Handle is not seekable.
+--
hTell :: Handle -> IO Integer
hTell handle =
wantSeekableHandle "hGetPosn" handle $ \ handle_@Handle__{..} -> do
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)
hSetBinaryMode handle bin =
withAllHandles__ "hSetBinaryMode" handle $ \ h_@Handle__{..} ->
do
- flushBuffer h_
+ flushCharBuffer h_
+ closeTextCodecs h_
+
let mb_te | bin = Nothing
| otherwise = Just localeEncoding
+ openTextEncoding mb_te haType $ \ mb_encoder mb_decoder -> do
+
-- should match the default newline mode, whatever that is
let nl | bin = noNewlineTranslation
| otherwise = nativeNewlineMode
- (mb_encoder, mb_decoder) <- getEncoding mb_te haType
- return Handle__{ haEncoder = mb_encoder,
+ bbuf <- readIORef haByteBuffer
+ ref <- newIORef (error "codec_state", bbuf)
+
+ return Handle__{ haLastDecode = ref,
+ haEncoder = mb_encoder,
haDecoder = mb_decoder,
+ haCodec = mb_te,
haInputNL = inputNL nl,
haOutputNL = outputNL nl, .. }
case cast devTo of
Nothing -> ioe_dupHandlesNotCompatible h
Just dev' -> do
- IODevice.dup2 dev dev'
+ _ <- IODevice.dup2 dev dev'
FileHandle _ m <- dupHandle_ dev' filepath other_side h_ mb_finalizer
takeMVar m
projects / ghc-base.git / blobdiff