hFileSize, hIsEOF, isEOF,
hSetBuffering, hGetBuffering, hFlush,
hGetPosn, hSetPosn, hSeek,
- hReady, hGetChar, hLookAhead, hGetContents,
+ hWaitForInput, hReady, hGetChar, hGetLine, hLookAhead, hGetContents,
hPutChar, hPutStr, hPutStrLn, hPrint,
hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable,
isFullError, isEOFError,
isIllegalOperation, isPermissionError, isUserError,
ioeGetErrorString,
- ioeGetHandle, ioeGetFileName
+ ioeGetHandle, ioeGetFileName,
+ try, bracket, bracket_
) where
import Ix
import STBase
+import UnsafeST ( unsafePerformPrimIO, unsafeInterleavePrimIO )
import IOBase
import ArrBase ( MutableByteArray(..), newCharArray )
import IOHandle -- much of the real stuff is in here
-import PackedString ( nilPS, packCBytesST, unpackPS )
+import PackBase ( unpackNBytesST )
import PrelBase
import GHC
-import Foreign ( makeForeignObj, writeForeignObj )
+import Foreign ( ForeignObj, Addr, makeForeignObj, writeForeignObj )
+import Char ( ord, chr )
\end{code}
%*********************************************************
hPutStr :: Handle -> String -> IO ()
hPutStrLn :: Handle -> String -> IO ()
hReady :: Handle -> IO Bool
+hWaitForInput :: Handle -> Int -> IO Bool
+
--IOHandle:hSeek :: Handle -> SeekMode -> Integer -> IO ()
--IOHandle:hSetBuffering :: Handle -> BufferMode -> IO ()
--IOHandle:hSetPosn :: HandlePosn -> IO ()
--IOHandle:stdin, stdout, stderr :: Handle
\end{code}
+Standard instances for @Handle@:
+
+\begin{code}
+instance Eq IOError where
+ (IOError h1 e1 str1) == (IOError h2 e2 str2) =
+ e1==e2 && str1==str2 && h1==h2
+
+instance Eq Handle where
+ h1 == h2 =
+ unsafePerformPrimIO (
+ ioToPrimIO (readHandle h1) >>= \ h1_ ->
+ ioToPrimIO (writeHandle h1 h1_) >>
+ ioToPrimIO (readHandle h2) >>= \ h2_ ->
+ ioToPrimIO (writeHandle h2 h2_) >>
+ return (
+ case (h1_,h2_) of
+ (ErrorHandle (IOError h1 _ _), ErrorHandle (IOError h2 _ _)) -> h1 == h2
+ (ClosedHandle, ClosedHandle) -> True
+ (SemiClosedHandle v1 _, SemiClosedHandle v2 _) -> v1 == v2
+ (ReadHandle v1 _ _ , ReadHandle v2 _ _) -> v1 == v2
+ (WriteHandle v1 _ _ , WriteHandle v2 _ _) -> v1 == v2
+ (AppendHandle v1 _ _ , AppendHandle v2 _ _) -> v1 == v2
+ (ReadWriteHandle v1 _ _ , ReadWriteHandle v2 _ _) -> v1 == v2
+ _ -> False))
+
+instance Show Handle where {showsPrec p h = showString "<<Handle>>"}
+
+--Type declared in IOHandle, instance here because it depends on Eq.Handle
+instance Eq HandlePosn where
+ (HandlePosn h1 p1) == (HandlePosn h2 p2) = p1==p2 && h1==h2
+
+\end{code}
+
%*********************************************************
%* *
\subsection{Simple input operations}
%* *
%*********************************************************
-Computation $hReady hdl$ indicates whether at least
+Computation @hReady hdl@ indicates whether at least
one item is available for input from handle {\em hdl}.
+@hWaitForInput@ is the generalisation, wait for \tr{n} seconds
+before deciding whether the Handle has run dry or not.
+
\begin{code}
---hReady :: Handle -> IO Bool
-hReady handle =
+--hReady :: Handle -> IO Bool
+hReady h = hWaitForInput h 0
+
+--hWaitForInput :: Handle -> Int -> IO Bool
+hWaitForInput handle nsecs =
readHandle handle >>= \ htype ->
case htype of
ErrorHandle ioError ->
writeHandle handle htype >>
fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
other ->
- _ccall_ inputReady (filePtr other) `thenIO_Prim` \ rc ->
- writeHandle handle (markHandle htype) >>
+ _ccall_ inputReady (filePtr other) nsecs `thenIO_Prim` \ rc ->
+ writeHandle handle (markHandle htype) >>
case rc of
0 -> return False
1 -> return True
- _ -> constructErrorAndFail "hReady"
+ _ -> constructErrorAndFail "hWaitForInput"
\end{code}
Computation $hGetChar hdl$ reads the next character from handle
return (chr intc)
else
constructErrorAndFail "hGetChar"
+
+hGetLine :: Handle -> IO String
+hGetLine h =
+ hGetChar h >>= \ c ->
+ if c == '\n' then
+ return ""
+ else
+ hGetLine h >>= \ s -> return (c:s)
\end{code}
Computation $hLookahead hdl$ returns the next character from handle
SemiClosedHandle fp (buf, size) ->
_ccall_ readBlock buf fp size >>= \ bytes ->
(if bytes <= 0
- then return nilPS
- else packCBytesST bytes buf) >>= \ some ->
+ then return ""
+ else unpackNBytesST buf bytes) >>= \ some ->
if bytes < 0 then
_ccall_ free buf >>= \ () ->
_ccall_ closeFile fp >>
-#ifndef PAR
+#ifndef __PARALLEL_HASKELL__
writeForeignObj fp ``NULL'' >>
ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
#else
ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
#endif
- returnPrimIO (unpackPS some)
+ returnPrimIO some
else
ioToST (writeHandle handle htype) >>
unsafeInterleavePrimIO (lazyReadBlock handle)
>>= \ more ->
- returnPrimIO (unpackPS some ++ more)
+ returnPrimIO (some ++ more)
lazyReadLine handle =
ioToST (readHandle handle) >>= \ htype ->
SemiClosedHandle fp (buf, size) ->
_ccall_ readLine buf fp size >>= \ bytes ->
(if bytes <= 0
- then return nilPS
- else packCBytesST bytes buf) >>= \ some ->
+ then return ""
+ else unpackNBytesST buf bytes) >>= \ some ->
if bytes < 0 then
_ccall_ free buf >>= \ () ->
_ccall_ closeFile fp >>
-#ifndef PAR
+#ifndef __PARALLEL_HASKELL__
writeForeignObj fp ``NULL'' >>
ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
#else
ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0))) >>
#endif
- returnPrimIO (unpackPS some)
+ return some
else
ioToST (writeHandle handle htype) >>
unsafeInterleavePrimIO (lazyReadLine handle)
>>= \ more ->
- returnPrimIO (unpackPS some ++ more)
+ return (some ++ more)
lazyReadChar handle =
ioToST (readHandle handle) >>= \ htype ->
_ccall_ readChar fp >>= \ char ->
if char == ``EOF'' then
_ccall_ closeFile fp >>
-#ifndef PAR
+#ifndef __PARALLEL_HASKELL__
writeForeignObj fp ``NULL'' >>
ioToST (writeHandle handle (SemiClosedHandle fp (``NULL'', 0))) >>
#else
else
constructErrorAndFail "hPutStr"
where
-#ifndef PAR
+#ifndef __PARALLEL_HASKELL__
writeLines :: ForeignObj -> String -> PrimIO Bool
#else
writeLines :: Addr -> String -> PrimIO Bool
#endif
writeLines = writeChunks ``BUFSIZ'' True
-#ifndef PAR
+#ifndef __PARALLEL_HASKELL__
writeBlocks :: ForeignObj -> Int -> String -> PrimIO Bool
#else
writeBlocks :: Addr -> Int -> String -> PrimIO Bool
a whole lot quicker. -- SOF 3/96
-}
-#ifndef PAR
+#ifndef __PARALLEL_HASKELL__
writeChunks :: Int -> Bool -> ForeignObj -> String -> PrimIO Bool
#else
writeChunks :: Int -> Bool -> Addr -> String -> PrimIO Bool
in
shoveString 0# s
-#ifndef PAR
+#ifndef __PARALLEL_HASKELL__
writeChars :: ForeignObj -> String -> PrimIO Bool
#else
writeChars :: Addr -> String -> PrimIO Bool
hPutChar hndl '\n'
\end{code}
+
+
+%*********************************************************
+%* *
+\subsection{Try and bracket}
+%* *
+%*********************************************************
+
+The construct $try comp$ exposes errors which occur within a
+computation, and which are not fully handled. It always succeeds.
+
+\begin{code}
+try :: IO a -> IO (Either IOError a)
+try f = catch (do r <- f
+ return (Right r))
+ (return . Left)
+
+bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
+bracket before after m = do
+ x <- before
+ rs <- try (m x)
+ after x
+ case rs of
+ Right r -> return r
+ Left e -> fail e
+
+-- variant of the above where middle computation doesn't want x
+bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c
+bracket_ before after m = do
+ x <- before
+ rs <- try m
+ after x
+ case rs of
+ Right r -> return r
+ Left e -> fail e
+\end{code}
+
projects / ghc-hetmet.git / blobdiff