module GHC.Handle (
withHandle, withHandle', withHandle_,
wantWritableHandle, wantReadableHandle, wantSeekableHandle,
module GHC.Handle (
withHandle, withHandle', withHandle_,
wantWritableHandle, wantReadableHandle, wantSeekableHandle,
newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
newEmptyBuffer, allocateBuffer, readCharFromBuffer, writeCharIntoBuffer,
fillReadBuffer, fillReadBufferWithoutBlocking,
readRawBuffer, readRawBufferPtr,
readRawBufferNoBlock, readRawBufferPtrNoBlock,
fillReadBuffer, fillReadBufferWithoutBlocking,
readRawBuffer, readRawBufferPtr,
readRawBufferNoBlock, readRawBufferPtrNoBlock,
-- ---------------------------------------------------------------------------
-- Are files opened by default in text or binary mode, if the user doesn't
-- ---------------------------------------------------------------------------
-- Are files opened by default in text or binary mode, if the user doesn't
If the operation generates an error or an exception is raised, the
original handle is always replaced [ this is the case at the moment,
If the operation generates an error or an exception is raised, the
original handle is always replaced [ this is the case at the moment,
- (h',v) <- catchException (act h_)
- (\ err -> putMVar m h_ >>
- case err of
- IOException ex -> ioError (augmentIOError ex fun h)
- _ -> throw err)
+ (h',v) <- catchException (act h_)
+ (\ err -> putMVar m h_ >>
+ case err of
+ IOException ex -> ioError (augmentIOError ex fun h)
+ _ -> throw err)
- v <- catchException (act h_)
- (\ err -> putMVar m h_ >>
- case err of
- IOException ex -> ioError (augmentIOError ex fun h)
- _ -> throw err)
+ v <- catchException (act h_)
+ (\ err -> putMVar m h_ >>
+ case err of
+ IOException ex -> ioError (augmentIOError ex fun h)
+ _ -> throw err)
- | Just _ <- fp = fp
- | otherwise = case h of
- FileHandle fp _ -> Just fp
- DuplexHandle fp _ _ -> Just fp
+ | Just _ <- fp = fp
+ | otherwise = case h of
+ FileHandle fp _ -> Just fp
+ DuplexHandle fp _ _ -> Just fp
wantWritableHandle' fun h m act
= withHandle_' fun h m (checkWritableHandle act)
checkWritableHandle act handle_
wantWritableHandle' fun h m act
= withHandle_' fun h m (checkWritableHandle act)
checkWritableHandle act handle_
- = case haType handle_ of
- ClosedHandle -> ioe_closedHandle
- SemiClosedHandle -> ioe_closedHandle
- ReadHandle -> ioe_notWritable
- ReadWriteHandle -> do
- let ref = haBuffer handle_
- buf <- readIORef ref
- new_buf <-
- if not (bufferIsWritable buf)
- then do b <- flushReadBuffer (haFD handle_) buf
- return b{ bufState=WriteBuffer }
- else return buf
- writeIORef ref new_buf
- act handle_
- _other -> act handle_
+ = case haType handle_ of
+ ClosedHandle -> ioe_closedHandle
+ SemiClosedHandle -> ioe_closedHandle
+ ReadHandle -> ioe_notWritable
+ ReadWriteHandle -> do
+ let ref = haBuffer handle_
+ buf <- readIORef ref
+ new_buf <-
+ if not (bufferIsWritable buf)
+ then do b <- flushReadBuffer (haFD handle_) buf
+ return b{ bufState=WriteBuffer }
+ else return buf
+ writeIORef ref new_buf
+ act handle_
+ _other -> act handle_
-checkReadableHandle act handle_ =
- case haType handle_ of
- ClosedHandle -> ioe_closedHandle
- SemiClosedHandle -> ioe_closedHandle
- AppendHandle -> ioe_notReadable
- WriteHandle -> ioe_notReadable
- ReadWriteHandle -> do
- let ref = haBuffer handle_
- buf <- readIORef ref
- when (bufferIsWritable buf) $ do
- new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
- writeIORef ref new_buf{ bufState=ReadBuffer }
- act handle_
- _other -> act handle_
+checkReadableHandle act handle_ =
+ case haType handle_ of
+ ClosedHandle -> ioe_closedHandle
+ SemiClosedHandle -> ioe_closedHandle
+ AppendHandle -> ioe_notReadable
+ WriteHandle -> ioe_notReadable
+ ReadWriteHandle -> do
+ let ref = haBuffer handle_
+ buf <- readIORef ref
+ when (bufferIsWritable buf) $ do
+ new_buf <- flushWriteBuffer (haFD handle_) (haIsStream handle_) buf
+ writeIORef ref new_buf{ bufState=ReadBuffer }
+ act handle_
+ _other -> act handle_
-- ---------------------------------------------------------------------------
-- Wrapper for seek operations.
wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
-- ---------------------------------------------------------------------------
-- Wrapper for seek operations.
wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun h@(DuplexHandle _ _ _) _act =
-
-checkSeekableHandle act handle_ =
- case haType handle_ of
- ClosedHandle -> ioe_closedHandle
- SemiClosedHandle -> ioe_closedHandle
+
+checkSeekableHandle act handle_ =
+ case haType handle_ of
+ ClosedHandle -> ioe_closedHandle
+ SemiClosedHandle -> ioe_closedHandle
AppendHandle -> ioe_notSeekable
_ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
| otherwise -> ioe_notSeekable_notBin
AppendHandle -> ioe_notSeekable
_ | haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED -> act handle_
| otherwise -> ioe_notSeekable_notBin
-ioe_closedHandle, ioe_EOF,
- ioe_notReadable, ioe_notWritable,
+ioe_closedHandle, ioe_EOF,
+ ioe_notReadable, ioe_notWritable,
-ioe_closedHandle = ioException
- (IOError Nothing IllegalOperation ""
- "handle is closed" Nothing)
-ioe_EOF = ioException
+ioe_closedHandle = ioException
+ (IOError Nothing IllegalOperation ""
+ "handle is closed" Nothing)
+ioe_EOF = ioException
-ioe_notReadable = ioException
- (IOError Nothing IllegalOperation ""
- "handle is not open for reading" Nothing)
-ioe_notWritable = ioException
- (IOError Nothing IllegalOperation ""
- "handle is not open for writing" Nothing)
-ioe_notSeekable = ioException
+ioe_notReadable = ioException
- "seek operations on text-mode handles are not allowed on this platform"
+ "handle is not open for writing" Nothing)
+ioe_notSeekable = ioException
+ (IOError Nothing IllegalOperation ""
+ "handle is not seekable" Nothing)
+ioe_notSeekable_notBin = ioException
+ (IOError Nothing IllegalOperation ""
+ "seek operations on text-mode handles are not allowed on this platform"
- size > 0
- && r <= w
- && w <= size
- && ( r /= w || (r == 0 && w == 0) )
- && ( state /= WriteBuffer || r == 0 )
- && ( state /= WriteBuffer || w < size ) -- write buffer is never full
+ size > 0
+ && r <= w
+ && w <= size
+ && ( r /= w || (r == 0 && w == 0) )
+ && ( state /= WriteBuffer || r == 0 )
+ && ( state /= WriteBuffer || w < size ) -- write buffer is never full
writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
writeCharIntoBuffer slab (I# off) (C# c)
= IO $ \s -> case writeCharArray# slab off c s of
writeCharIntoBuffer :: RawBuffer -> Int -> Char -> IO Int
writeCharIntoBuffer slab (I# off) (C# c)
= IO $ \s -> case writeCharArray# slab off c s of
readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
readCharFromBuffer slab (I# off)
= IO $ \s -> case readCharArray# slab off s of
readCharFromBuffer :: RawBuffer -> Int -> IO (Char, Int)
readCharFromBuffer slab (I# off)
= IO $ \s -> case readCharArray# slab off s of
asyncReadRawBuffer loc fd is_stream buf off len = do
(l, rc) <- asyncReadBA (fromIntegral fd) (if is_stream then 1 else 0)
asyncReadRawBuffer loc fd is_stream buf off len = do
(l, rc) <- asyncReadBA (fromIntegral fd) (if is_stream then 1 else 0)
else return (fromIntegral l)
asyncReadRawBufferPtr loc fd is_stream buf off len = do
(l, rc) <- asyncRead (fromIntegral fd) (if is_stream then 1 else 0)
else return (fromIntegral l)
asyncReadRawBufferPtr loc fd is_stream buf off len = do
(l, rc) <- asyncRead (fromIntegral fd) (if is_stream then 1 else 0)
asyncWriteRawBuffer loc fd is_stream buf off len = do
(l, rc) <- asyncWriteBA (fromIntegral fd) (if is_stream then 1 else 0)
asyncWriteRawBuffer loc fd is_stream buf off len = do
(l, rc) <- asyncWriteBA (fromIntegral fd) (if is_stream then 1 else 0)
asyncWriteRawBufferPtr loc fd is_stream buf off len = do
(l, rc) <- asyncWrite (fromIntegral fd) (if is_stream then 1 else 0)
asyncWriteRawBufferPtr loc fd is_stream buf off len = do
(l, rc) <- asyncWrite (fromIntegral fd) (if is_stream then 1 else 0)
-- always returns EISDIR if the file is a directory and was opened
-- for writing, so I think we're ok with a single open() here...
fd <- throwErrnoIfMinus1Retry "openFile"
-- always returns EISDIR if the file is a directory and was opened
-- for writing, so I think we're ok with a single open() here...
fd <- throwErrnoIfMinus1Retry "openFile"
stat@(fd_type,_,_) <- fdStat fd
h <- fdToHandle_stat fd (Just stat) False filepath mode binary
`catchException` \e -> do c_close fd; throw e
stat@(fd_type,_,_) <- fdStat fd
h <- fdToHandle_stat fd (Just stat) False filepath mode binary
`catchException` \e -> do c_close fd; throw e
- -- NB. don't forget to close the FD if fdToHandle' fails, otherwise
- -- this FD leaks.
- -- ASSERT: if we just created the file, then fdToHandle' won't fail
- -- (so we don't need to worry about removing the newly created file
- -- in the event of an error).
+ -- NB. don't forget to close the FD if fdToHandle' fails, otherwise
+ -- this FD leaks.
+ -- ASSERT: if we just created the file, then fdToHandle' won't fail
+ -- (so we don't need to worry about removing the newly created file
+ -- in the event of an error).
- -- we want to truncate() if this is an open in WriteMode, but only
- -- if the target is a RegularFile. ftruncate() fails on special files
- -- like /dev/null.
+ -- we want to truncate() if this is an open in WriteMode, but only
+ -- if the target is a RegularFile. ftruncate() fails on special files
+ -- like /dev/null.
- case mode of
- ReadMode -> ( ReadHandle, False )
- WriteMode -> ( WriteHandle, True )
- ReadWriteMode -> ( ReadWriteHandle, True )
- AppendMode -> ( AppendHandle, True )
+ case mode of
+ ReadMode -> ( ReadHandle, False )
+ WriteMode -> ( WriteHandle, True )
+ ReadWriteMode -> ( ReadWriteHandle, True )
+ AppendMode -> ( AppendHandle, True )
- r <- lockFile fd dev ino (fromBool write)
- when (r == -1) $
- ioException (IOError Nothing ResourceBusy "openFile"
- "file is locked" Nothing)
+ r <- lockFile fd dev ino (fromBool write)
+ when (r == -1) $
+ ioException (IOError Nothing ResourceBusy "openFile"
+ "file is locked" Nothing)
- Stream
- -- only *Streams* can be DuplexHandles. Other read/write
- -- Handles must share a buffer.
- | ReadWriteHandle <- ha_type ->
- mkDuplexHandle fd is_stream filepath binary
- | otherwise ->
- mkFileHandle fd is_stream filepath ha_type binary
+ Stream
+ -- only *Streams* can be DuplexHandles. Other read/write
+ -- Handles must share a buffer.
+ | ReadWriteHandle <- ha_type ->
+ mkDuplexHandle fd is_stream filepath binary
+ | otherwise ->
+ mkFileHandle fd is_stream filepath ha_type binary
mkStdHandle fd filepath ha_type buf bmode = do
spares <- newIORef BufferListNil
newFileHandle filepath (stdHandleFinalizer filepath)
mkStdHandle fd filepath ha_type buf bmode = do
spares <- newIORef BufferListNil
newFileHandle filepath (stdHandleFinalizer filepath)
mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
mkDuplexHandle fd is_stream filepath binary = do
(w_buf, w_bmode) <- getBuffer fd WriteBuffer
w_spares <- newIORef BufferListNil
let w_handle_ =
mkDuplexHandle :: FD -> Bool -> FilePath -> Bool -> IO Handle
mkDuplexHandle fd is_stream filepath binary = do
(w_buf, w_bmode) <- getBuffer fd WriteBuffer
w_spares <- newIORef BufferListNil
let w_handle_ =
- haIsStream = is_stream,
- haBufferMode = w_bmode,
- haBuffer = w_buf,
- haBuffers = w_spares,
- haOtherSide = Nothing
- }
+ haIsStream = is_stream,
+ haBufferMode = w_bmode,
+ haBuffer = w_buf,
+ haBuffers = w_spares,
+ haOtherSide = Nothing
+ }
write_side <- newMVar w_handle_
(r_buf, r_bmode) <- getBuffer fd ReadBuffer
r_spares <- newIORef BufferListNil
let r_handle_ =
write_side <- newMVar w_handle_
(r_buf, r_bmode) <- getBuffer fd ReadBuffer
r_spares <- newIORef BufferListNil
let r_handle_ =
- haIsStream = is_stream,
- haBufferMode = r_bmode,
- haBuffer = r_buf,
- haBuffers = r_spares,
- haOtherSide = Just write_side
- }
+ haIsStream = is_stream,
+ haBufferMode = r_bmode,
+ haBuffer = r_buf,
+ haBuffers = r_spares,
+ haOtherSide = Just write_side
+ }
-- we must set the fd to -1, because the finalizer is going
-- to run eventually and try to close/unlock it.
return (handle_{ haFD = -1,
-- we must set the fd to -1, because the finalizer is going
-- to run eventually and try to close/unlock it.
return (handle_{ haFD = -1,
- r <- fdFileSize (haFD handle_)
- if r /= -1
- then return r
- else ioException (IOError Nothing InappropriateType "hFileSize"
- "not a regular file" Nothing)
+ r <- fdFileSize (haFD handle_)
+ if r /= -1
+ then return r
+ else ioException (IOError Nothing InappropriateType "hFileSize"
+ "not a regular file" Nothing)
- {- 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]
- -}
- flushBuffer handle_
-
- let state = initBufferState (haType handle_)
- new_buf <-
- case mode of
- -- we always have a 1-character read buffer for
- -- unbuffered handles: it's needed to
- -- support hLookAhead.
- NoBuffering -> allocateBuffer 1 ReadBuffer
- LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
- BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
- BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
- | otherwise -> allocateBuffer n state
- writeIORef (haBuffer handle_) new_buf
-
- -- for input terminals we need to put the terminal into
- -- cooked or raw mode depending on the type of buffering.
- is_tty <- fdIsTTY (haFD handle_)
- when (is_tty && isReadableHandleType (haType handle_)) $
- case mode of
+ {- 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]
+ -}
+ flushBuffer handle_
+
+ let state = initBufferState (haType handle_)
+ new_buf <-
+ case mode of
+ -- we always have a 1-character read buffer for
+ -- unbuffered handles: it's needed to
+ -- support hLookAhead.
+ NoBuffering -> allocateBuffer 1 ReadBuffer
+ LineBuffering -> allocateBuffer dEFAULT_BUFFER_SIZE state
+ BlockBuffering Nothing -> allocateBuffer dEFAULT_BUFFER_SIZE state
+ BlockBuffering (Just n) | n <= 0 -> ioe_bufsiz n
+ | otherwise -> allocateBuffer n state
+ writeIORef (haBuffer handle_) new_buf
+
+ -- for input terminals we need to put the terminal into
+ -- cooked or raw mode depending on the type of buffering.
+ is_tty <- fdIsTTY (haFD handle_)
+ when (is_tty && isReadableHandleType (haType handle_)) $
+ case mode of
- -- 'raw' mode under win32 is a bit too specialised (and troublesome
- -- for most common uses), so simply disable its use here.
- NoBuffering -> setCooked (haFD handle_) False
+ -- 'raw' mode under win32 is a bit too specialised (and troublesome
+ -- for most common uses), so simply disable its use here.
+ NoBuffering -> setCooked (haFD handle_) False
wantWritableHandle "hFlush" handle $ \ handle_ -> do
buf <- readIORef (haBuffer handle_)
if bufferIsWritable buf && not (bufferEmpty buf)
wantWritableHandle "hFlush" handle $ \ handle_ -> do
buf <- readIORef (haBuffer handle_)
if bufferIsWritable buf && not (bufferEmpty buf)
- = AbsoluteSeek -- ^ the position of @hdl@ is set to @i@.
- | RelativeSeek -- ^ the position of @hdl@ is set to offset @i@
- -- from the current position.
- | SeekFromEnd -- ^ the position of @hdl@ is set to offset @i@
- -- from the end of the file.
+ = AbsoluteSeek -- ^ the position of @hdl@ is set to @i@.
+ | RelativeSeek -- ^ the position of @hdl@ is set to offset @i@
+ -- from the current position.
+ | SeekFromEnd -- ^ the position of @hdl@ is set to offset @i@
+ -- from the end of the file.
deriving (Eq, Ord, Ix, Enum, Read, Show)
{- Note:
deriving (Eq, Ord, Ix, Enum, Read, Show)
{- Note:
- -- urgh, on Windows we have to worry about \n -> \r\n translation,
- -- so we can't easily calculate the file position using the
- -- current buffer size. Just flush instead.
+ -- urgh, on Windows we have to worry about \n -> \r\n translation,
+ -- so we can't easily calculate the file position using the
+ -- current buffer size. Just flush instead.
# ifdef DEBUG_DUMP
puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
# ifdef DEBUG_DUMP
puts ("\nhGetPosn: (fd, posn, real_posn) = " ++ show (fd, posn, real_posn) ++ "\n")
puts (" (bufWPtr, bufRPtr) = " ++ show (bufWPtr buf, bufRPtr buf) ++ "\n")
{- not defined, nor exported, but mentioned
here for documentation purposes:
{- not defined, nor exported, but mentioned
here for documentation purposes:
- ClosedHandle -> ioe_closedHandle
- SemiClosedHandle -> ioe_closedHandle
- htype -> return (isReadableHandleType htype)
+ ClosedHandle -> ioe_closedHandle
+ SemiClosedHandle -> ioe_closedHandle
+ htype -> return (isReadableHandleType htype)
hIsWritable :: Handle -> IO Bool
hIsWritable (DuplexHandle _ _ _) = return True
hIsWritable handle =
withHandle_ "hIsWritable" handle $ \ handle_ -> do
case haType handle_ of
hIsWritable :: Handle -> IO Bool
hIsWritable (DuplexHandle _ _ _) = return True
hIsWritable handle =
withHandle_ "hIsWritable" handle $ \ handle_ -> do
case haType handle_ of
- ClosedHandle -> ioe_closedHandle
- SemiClosedHandle -> ioe_closedHandle
- htype -> return (isWritableHandleType htype)
+ ClosedHandle -> ioe_closedHandle
+ SemiClosedHandle -> ioe_closedHandle
+ htype -> return (isWritableHandleType htype)
- -- We're being non-standard here, and allow the buffering
- -- of a semi-closed handle to be queried. -- sof 6/98
- return (haBufferMode handle_) -- could be stricter..
+ -- We're being non-standard here, and allow the buffering
+ -- of a semi-closed handle to be queried. -- sof 6/98
+ return (haBufferMode handle_) -- could be stricter..
- ClosedHandle -> ioe_closedHandle
- SemiClosedHandle -> ioe_closedHandle
- AppendHandle -> return False
+ ClosedHandle -> ioe_closedHandle
+ SemiClosedHandle -> ioe_closedHandle
+ AppendHandle -> return False
_ -> do t <- fdType (haFD handle_)
return ((t == RegularFile || t == RawDevice)
&& (haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED))
_ -> do t <- fdType (haFD handle_)
return ((t == RegularFile || t == RawDevice)
&& (haIsBin handle_ || tEXT_MODE_SEEK_ALLOWED))
- (showString "loc=" . showString filepath . showChar ',' .
- showString "type=" . showType . showChar ',' .
- showString "binary=" . shows (haIsBin hdl_) . showChar ',' .
- showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
+ (showString "loc=" . showString filepath . showChar ',' .
+ showString "type=" . showType . showChar ',' .
+ showString "binary=" . shows (haIsBin hdl_) . showChar ',' .
+ showString "buffering=" . showBufMode (unsafePerformIO (readIORef (haBuffer hdl_))) (haBufferMode hdl_) . showString "}" )
- LineBuffering -> showString "line"
- BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
- BlockBuffering Nothing -> showString "block " . showParen True (shows def)
+ LineBuffering -> showString "line"
+ BlockBuffering (Just n) -> showString "block " . showParen True (shows n)
+ BlockBuffering Nothing -> showString "block " . showParen True (shows def)