readIO
)
import PrelShow
-import PrelMaybe ( Either(..) )
+import PrelMaybe ( Either(..), Maybe(..) )
import PrelAddr ( Addr(..), nullAddr )
import PrelArr ( ByteArray )
import PrelPack ( unpackNBytesAccST )
hWaitForInput handle msecs =
wantReadableHandle "hWaitForInput" handle $ \ handle_ -> do
rc <- CCALL(inputReady) (haFO__ handle_) (msecs::Int) -- ConcHask: SAFE, won't block
- writeHandle handle handle_
case (rc::Int) of
0 -> return False
1 -> return True
wantReadableHandle "hGetChar" handle $ \ handle_ -> do
let fo = haFO__ handle_
intc <- mayBlock fo (CCALL(fileGetc) fo) -- ConcHask: UNSAFE, may block
- writeHandle handle handle_
if intc /= ((-1)::Int)
then return (chr intc)
else constructErrorAndFail "hGetChar"
wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
let fo = haFO__ handle_
intc <- mayBlock fo (CCALL(fileLookAhead) fo) -- ConcHask: UNSAFE, may block
- writeHandle handle handle_
if intc /= (-1)
then return (chr intc)
else constructErrorAndFail "hLookAhead"
\begin{code}
hGetContents :: Handle -> IO String
hGetContents handle =
- wantReadableHandle "hGetContents" handle $ \ handle_ -> do
- {-
- To avoid introducing an extra layer of buffering here,
- we provide three lazy read methods, based on character,
- line, and block buffering.
- -}
- writeHandle handle (handle_{ haType__ = SemiClosedHandle })
- case (haBufferMode__ handle_) of
- LineBuffering -> unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_))
- BlockBuffering _ -> unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_))
- NoBuffering -> unsafeInterleaveIO (lazyReadChar handle (haFO__ handle_))
-
+ -- can't use wantReadableHandle here, because we want to side effect
+ -- the handle.
+ withHandle handle $ \ handle_ -> do
+ case haType__ handle_ of
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hGetContents" handle
+ SemiClosedHandle -> ioe_closedHandle "hGetContents" handle
+ AppendHandle -> ioError not_readable_error
+ WriteHandle -> ioError not_readable_error
+ _ -> do
+ {-
+ To avoid introducing an extra layer of buffering here,
+ we provide three lazy read methods, based on character,
+ line, and block buffering.
+ -}
+ let handle_' = handle_{ haType__ = SemiClosedHandle }
+ case (haBufferMode__ handle_) of
+ LineBuffering -> do
+ str <- unsafeInterleaveIO (lazyReadLine handle (haFO__ handle_))
+ return (handle_', str)
+ BlockBuffering _ -> do
+ str <- unsafeInterleaveIO (lazyReadBlock handle (haFO__ handle_))
+ return (handle_', str)
+ NoBuffering -> do
+ str <- unsafeInterleaveIO (lazyReadChar handle (haFO__ handle_))
+ return (handle_', str)
+ where
+ not_readable_error =
+ IOError (Just handle) IllegalOperation "hGetContents"
+ ("handle is not open for reading")
\end{code}
Note that someone may close the semi-closed handle (or change its buffering),
-1 -> -- an error occurred, close the handle
withHandle handle $ \ handle_ -> do
CCALL(closeFile) (haFO__ handle_) (0::Int){-don't bother flushing-} -- ConcHask: SAFE, won't block.
- writeHandle handle (handle_ { haType__ = ClosedHandle,
- haFO__ = nullFile__ })
- return ""
+ return (handle_ { haType__ = ClosedHandle,
+ haFO__ = nullFile__ },
+ "")
_ -> do
more <- unsafeInterleaveIO (lazyReadBlock handle fo)
stToIO (unpackNBytesAccST buf bytes more)
-1 -> -- an error occurred, close the handle
withHandle handle $ \ handle_ -> do
CCALL(closeFile) (haFO__ handle_) (0::Int){- don't bother flushing-} -- ConcHask: SAFE, won't block
- writeHandle handle (handle_ { haType__ = ClosedHandle,
- haFO__ = nullFile__ })
- return ""
+ return (handle_ { haType__ = ClosedHandle,
+ haFO__ = nullFile__ },
+ "")
_ -> do
more <- unsafeInterleaveIO (lazyReadLine handle fo)
buf <- CCALL(getBufStart) fo bytes -- ConcHask: won't block
-1 -> -- error, silently close handle.
withHandle handle $ \ handle_ -> do
CCALL(closeFile) (haFO__ handle_) (0::Int){-don't bother flusing-} -- ConcHask: SAFE, won't block
- writeHandle handle (handle_{ haType__ = ClosedHandle,
- haFO__ = nullFile__ })
- return ""
+ return (handle_{ haType__ = ClosedHandle,
+ haFO__ = nullFile__ },
+ "")
_ -> do
more <- unsafeInterleaveIO (lazyReadChar handle fo)
return (chr char : more)
let fo = haFO__ handle_
flushConnectedBuf fo
rc <- mayBlock fo (CCALL(filePutc) fo c) -- ConcHask: UNSAFE, may block.
- writeHandle handle handle_
if rc == 0
then return ()
else constructErrorAndFail "hPutChar"
writeBlocks fo buf bsz pos str
NoBuffering -> do
writeChars fo str
- writeHandle handle handle_
-
\end{code}
Going across the border between Haskell and C is relatively costly,
\begin{code}
{-# INLINE newHandle #-}
{-# INLINE withHandle #-}
-{-# INLINE writeHandle #-}
newHandle :: Handle__ -> IO Handle
-withHandle :: Handle -> (Handle__ -> IO a) -> IO a
-writeHandle :: Handle -> Handle__ -> IO ()
#if defined(__CONCURRENT_HASKELL__)
-- Use MVars for concurrent Haskell
newHandle hc = newMVar hc >>= \ h ->
return (Handle h)
-
- -- withHandle grabs the handle lock, performs
- -- some operation over it, making sure that we
- -- unlock & reset the handle state should an
- -- exception occur while performing said op.
-withHandle (Handle h) act = do
- h_ <- takeMVar h
- v <- catchNonIO (act h_) (\ ex -> putMVar h h_ >> throw ex)
- return v
-
-writeHandle (Handle h) hc = putMVar h hc
#else
-- Use ordinary MutableVars for non-concurrent Haskell
newHandle hc = stToIO (newVar hc >>= \ h ->
return (Handle h))
+#endif
+\end{code}
+
+%*********************************************************
+%* *
+\subsection{@withHandle@ operations}
+%* *
+%*********************************************************
+
+In the concurrent world, handles are locked during use. This is done
+by wrapping an MVar around the handle which acts as a mutex over
+operations on the handle.
+
+To avoid races, we use the following bracketing operations. The idea
+is to obtain the lock, do some operation and replace the lock again,
+whether the operation succeeded or failed. We also want to handle the
+case where the thread receives an exception while processing the IO
+operation: in these cases we also want to relinquish the lock.
+There are three versions of @withHandle@: corresponding to the three
+possible combinations of:
+
+ - the operation may side-effect the handle
+ - the operation may return a result
+
+If the operation generates an error or an exception is raised, the
+orignal handle is always replaced [ this is the case at the moment,
+but we might want to revisit this in the future --SDM ].
+
+\begin{code}
+#ifdef __CONCURRENT_HASKELL__
+withHandle :: Handle -> (Handle__ -> IO (Handle__,a)) -> IO a
+withHandle (Handle h) act = do
+ h_ <- takeMVar h
+ (h',v) <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
+ putMVar h h'
+ return v
+
+withHandle_ :: Handle -> (Handle__ -> IO a) -> IO a
+withHandle_ (Handle h) act = do
+ h_ <- takeMVar h
+ v <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
+ putMVar h h_
+ return v
+
+withHandle__ :: Handle -> (Handle__ -> IO Handle__) -> IO ()
+withHandle__ (Handle h) act = do
+ h_ <- takeMVar h
+ h' <- catchException (act h_) (\ ex -> putMVar h h_ >> throw ex)
+ putMVar h h'
+ return ()
+
+#else
-- of questionable value to install this exception
-- handler, but let's do it in the non-concurrent
-- case too, for now.
v <- catchException (act h_) (\ ex -> stToIO (writeVar h h_) >> throw ex)
return v
-writeHandle (Handle h) hc = stToIO (writeVar h hc)
#endif
\end{code}
hClose :: Handle -> IO ()
hClose handle =
- withHandle handle $ \ handle_ -> do
+ withHandle__ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- return ()
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> return handle_
_ -> do
rc <- CCALL(closeFile) (haFO__ handle_) (1::Int){-flush if you can-} -- ConcHask: SAFE, won't block
{- We explicitly close a file object so that we can be told
FileObject with a NULL as part of closeFile())
-}
if rc == (0::Int)
- then
- writeHandle handle (handle_{ haType__ = ClosedHandle,
- haFO__ = nullFile__ })
- else do
- writeHandle handle handle_
- constructErrorAndFail "hClose"
+ then return (handle_{ haType__ = ClosedHandle,
+ haFO__ = nullFile__ })
+ else constructErrorAndFail "hClose"
\end{code}
\begin{code}
hFileSize :: Handle -> IO Integer
hFileSize handle =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hFileSize" handle
- SemiClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hFileSize" handle
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hFileSize" handle
+ SemiClosedHandle -> ioe_closedHandle "hFileSize" handle
#ifdef __HUGS__
_ -> do
mem <- primNewByteArray sizeof_int64
rc <- CCALL(fileSize_int64) (haFO__ handle_) mem -- ConcHask: SAFE, won't block
- writeHandle handle handle_
if rc == 0 then do
result <- primReadInt64Array mem 0
return (primInt64ToInteger result)
case int2Integer# hack# of
(# s, d #) -> do
rc <- CCALL(fileSize) (haFO__ handle_) d -- ConcHask: SAFE, won't block
- writeHandle handle handle_
if rc == (0::Int) then
return (J# s d)
else
wantReadableHandle "hIsEOF" handle $ \ handle_ -> do
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(fileEOF) fo) -- ConcHask: UNSAFE, may block
- writeHandle handle handle_
case rc of
0 -> return False
1 -> return True
"hSetBuffering"
("illegal buffer size " ++ showsPrec 9 n [])) -- 9 => should be parens'ified.
_ ->
- withHandle handle $ \ handle_ -> do
+ withHandle__ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hSetBuffering" handle
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hSetBuffering" handle
_ -> do
{- Note:
- we flush the old buffer regardless of whether
rc <- mayBlock fo (CCALL(setBuffering) fo bsize) -- ConcHask: UNSAFE, may block
if rc == 0
then do
- writeHandle handle (handle_{ haBufferMode__ = mode })
+ return (handle_{ haBufferMode__ = mode })
else do
-- Note: failure to change the buffer size will cause old buffer to be flushed.
- writeHandle handle handle_
constructErrorAndFail "hSetBuffering"
where
bsize :: Int
wantWriteableHandle "hFlush" handle $ \ handle_ -> do
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(flushFile) fo) -- ConcHask: UNSAFE, may block
- writeHandle handle handle_
if rc == 0 then
return ()
else
hGetPosn handle =
wantSeekableHandle "hGetPosn" handle $ \ handle_ -> do
posn <- CCALL(getFilePosn) (haFO__ handle_) -- ConcHask: SAFE, won't block
- writeHandle handle handle_
- if posn /= -1 then
+ if posn /= -1 then do
return (HandlePosn handle posn)
else
constructErrorAndFail "hGetPosn"
wantSeekableHandle "hSetPosn" handle $ \ handle_ -> do -- not as silly as it looks: the handle may have been closed in the meantime.
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(setFilePosn) fo posn) -- ConcHask: UNSAFE, may block
- writeHandle handle handle_
- if rc == 0 then
+ if rc == 0 then do
return ()
else
constructErrorAndFail "hSetPosn"
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(seekFile) fo whence (I# s#) d#) -- ConcHask: UNSAFE, may block
#endif
- writeHandle handle handle_
- if rc == 0 then
+ if rc == 0 then do
return ()
else
constructErrorAndFail "hSeek"
\begin{code}
hIsOpen :: Handle -> IO Bool
hIsOpen handle =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- return False
- SemiClosedHandle -> do
- writeHandle handle handle_
- return False
- _ -> do
- writeHandle handle handle_
- return True
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> return False
+ SemiClosedHandle -> return False
+ _ -> return True
hIsClosed :: Handle -> IO Bool
hIsClosed handle =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- return True
- _ -> do
- writeHandle handle handle_
- return False
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> return True
+ _ -> return False
{- not defined, nor exported, but mentioned
here for documentation purposes:
hIsReadable :: Handle -> IO Bool
hIsReadable handle =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hIsReadable" handle
- SemiClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hIsReadable" handle
- htype -> do
- writeHandle handle handle_
- return (isReadable htype)
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hIsReadable" handle
+ SemiClosedHandle -> ioe_closedHandle "hIsReadable" handle
+ htype -> return (isReadable htype)
where
isReadable ReadHandle = True
isReadable ReadWriteHandle = True
hIsWritable :: Handle -> IO Bool
hIsWritable handle =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hIsWritable" handle
- SemiClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hIsWritable" handle
- htype -> do
- writeHandle handle handle_
- return (isWritable htype)
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hIsWritable" handle
+ SemiClosedHandle -> ioe_closedHandle "hIsWritable" handle
+ htype -> return (isWritable htype)
where
isWritable AppendHandle = True
isWritable WriteHandle = True
\begin{code}
hGetBuffering :: Handle -> IO BufferMode
hGetBuffering handle =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hGetBuffering" handle
- _ -> do
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hGetBuffering" handle
+ _ ->
{-
We're being non-standard here, and allow the buffering
of a semi-closed handle to be queried. -- sof 6/98
-}
- let v = haBufferMode__ handle_
- writeHandle handle handle_
- return v -- could be stricter..
-
+ return (haBufferMode__ handle_) -- could be stricter..
\end{code}
\begin{code}
hIsSeekable :: Handle -> IO Bool
hIsSeekable handle =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hIsSeekable" handle
- SemiClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hIsSeekable" handle
- AppendHandle -> do
- writeHandle handle handle_
- return False
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hIsSeekable" handle
+ SemiClosedHandle -> ioe_closedHandle "hIsSeekable" handle
+ AppendHandle -> return False
_ -> do
rc <- CCALL(seekFileP) (haFO__ handle_) -- ConcHask: SAFE, won't block
- writeHandle handle handle_
case (rc::Int) of
0 -> return False
1 -> return True
if not isT
then return ()
else
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hSetEcho" handle
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hSetEcho" handle
_ -> do
rc <- CCALL(setTerminalEcho) (haFO__ handle_) ((if on then 1 else 0)::Int) -- ConcHask: SAFE, won't block
- writeHandle handle handle_
if rc /= ((-1)::Int)
then return ()
else constructErrorAndFail "hSetEcho"
if not isT
then return False
else
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hGetEcho" handle
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hGetEcho" handle
_ -> do
rc <- CCALL(getTerminalEcho) (haFO__ handle_) -- ConcHask: SAFE, won't block
- writeHandle handle handle_
case (rc::Int) of
1 -> return True
0 -> return False
hIsTerminalDevice :: Handle -> IO Bool
hIsTerminalDevice handle = do
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "hIsTerminalDevice" handle
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "hIsTerminalDevice" handle
_ -> do
rc <- CCALL(isTerminalDevice) (haFO__ handle_) -- ConcHask: SAFE, won't block
- writeHandle handle handle_
case (rc::Int) of
1 -> return True
0 -> return False
wantRWHandle "hConnectTo" hW $ \ hW_ ->
wantRWHandle "hConnectTo" hR $ \ hR_ -> do
CCALL(setConnectedTo) (haFO__ hR_) (haFO__ hW_) is_tty -- ConcHask: SAFE, won't block
- writeHandle hR hR_
- writeHandle hW hW_
#ifndef __PARALLEL_HASKELL__
#define FILE_OBJECT ForeignObj
hUngetChar handle c =
wantReadableHandle "hLookAhead" handle $ \ handle_ -> do
rc <- CCALL(ungetChar) (haFO__ handle_) c -- ConcHask: SAFE, won't block
- writeHandle handle handle_
if rc == ((-1)::Int)
then constructErrorAndFail "hUngetChar"
else return ()
then do
hClose handle
constructErrorAndFail "slurpFile"
- else
- withHandle handle $ \ handle_ -> do
- let fo = haFO__ handle_
- rc <- mayBlock fo (CCALL(readChunk) fo chunk sz_i) -- ConcHask: UNSAFE, may block.
- writeHandle handle handle_
+ else do
+ rc <- withHandle_ handle ( \ handle_ -> do
+ let fo = haFO__ handle_
+ mayBlock fo (CCALL(readChunk) fo chunk sz_i) -- ConcHask: UNSAFE, may block.
+ )
hClose handle
if rc < (0::Int)
then constructErrorAndFail "slurpFile"
#else
rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
#endif
- writeHandle handle handle_
if rc >= (0::Int)
then return rc
else constructErrorAndFail "hFillBufBA"
wantReadableHandle "hFillBuf" handle $ \ handle_ -> do
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(readChunk) fo buf sz) -- ConcHask: UNSAFE, may block.
- writeHandle handle handle_
if rc >= 0
then return rc
else constructErrorAndFail "hFillBuf"
wantWriteableHandle "hPutBuf" handle $ \ handle_ -> do
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(writeBuf) fo buf len) -- ConcHask: UNSAFE, may block.
- writeHandle handle handle_
if rc == (0::Int)
then return ()
else constructErrorAndFail "hPutBuf"
wantWriteableHandle "hPutBufBA" handle $ \ handle_ -> do
let fo = haFO__ handle_
rc <- mayBlock fo (CCALL(writeBufBA) fo buf len) -- ConcHask: UNSAFE, may block.
- writeHandle handle handle_
if rc == (0::Int)
then return ()
else constructErrorAndFail "hPutBuf"
\begin{code}
getHandleFd :: Handle -> IO Int
getHandleFd handle =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case (haType__ handle_) of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle "getHandleFd" handle
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle "getHandleFd" handle
_ -> do
fd <- CCALL(getFileFd) (haFO__ handle_)
- writeHandle handle handle_
return fd
\end{code}
\begin{code}
wantReadableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantReadableHandle fun handle act =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle fun handle
- SemiClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle fun handle
- AppendHandle -> do
- writeHandle handle handle_
- ioError not_readable_error
- WriteHandle -> do
- writeHandle handle handle_
- ioError not_readable_error
- _ -> act handle_
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle fun handle
+ SemiClosedHandle -> ioe_closedHandle fun handle
+ AppendHandle -> ioError not_readable_error
+ WriteHandle -> ioError not_readable_error
+ _ -> act handle_
where
not_readable_error =
IOError (Just handle) IllegalOperation fun
wantWriteableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantWriteableHandle fun handle act =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle fun handle
- SemiClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle fun handle
- ReadHandle -> do
- writeHandle handle handle_
- ioError not_writeable_error
- _ -> act handle_
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle fun handle
+ SemiClosedHandle -> ioe_closedHandle fun handle
+ ReadHandle -> ioError not_writeable_error
+ _ -> act handle_
where
not_writeable_error =
IOError (Just handle) IllegalOperation fun
wantRWHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantRWHandle fun handle act =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle fun handle
- SemiClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle fun handle
- _ -> act handle_
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle fun handle
+ SemiClosedHandle -> ioe_closedHandle fun handle
+ _ -> act handle_
where
not_rw_error =
IOError (Just handle) IllegalOperation fun
wantSeekableHandle :: String -> Handle -> (Handle__ -> IO a) -> IO a
wantSeekableHandle fun handle act =
- withHandle handle $ \ handle_ -> do
+ withHandle_ handle $ \ handle_ -> do
case haType__ handle_ of
- ErrorHandle theError -> do
- writeHandle handle handle_
- ioError theError
- ClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle fun handle
- SemiClosedHandle -> do
- writeHandle handle handle_
- ioe_closedHandle fun handle
- AppendHandle -> do
- writeHandle handle handle_
- ioError not_seekable_error
- _ -> act handle_
+ ErrorHandle theError -> ioError theError
+ ClosedHandle -> ioe_closedHandle fun handle
+ SemiClosedHandle -> ioe_closedHandle fun handle
+ AppendHandle -> ioError not_seekable_error
+ _ -> act handle_
where
not_seekable_error =
IOError (Just handle)
projects / ghc-hetmet.git / commitdiff