which are supported for them.
\begin{code}
+{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
#include "error.h"
+
module IOHandle where
-import Prelude ()
import ST
import STBase
-import ArrBase ( ByteArray(..) )
+import ArrBase ( ByteArray(..), newVar, readVar, writeVar )
import PrelRead ( Read )
+import PrelList (span)
import Ix
import IOBase
+import Unsafe ( unsafePerformIO )
import PrelTup
+import PrelMaybe
import PrelBase
import GHC
+import Addr
+import Error
+
+#ifndef __PARALLEL_HASKELL__
+import Foreign ( ForeignObj, makeForeignObj, writeForeignObj )
+#endif
+#if defined(__CONCURRENT_HASKELL__)
+import ConcBase
+#endif
\end{code}
%* *
%*********************************************************
+The @Handle@ and @Handle__@ types are defined in @IOBase@.
+
\begin{code}
type FilePath = String
-#if defined(__CONCURRENT_HASKELL__)
-type Handle = MVar Handle__
+{-# INLINE newHandle #-}
+{-# INLINE readHandle #-}
+{-# INLINE writeHandle #-}
+newHandle :: Handle__ -> IO Handle
+readHandle :: Handle -> IO Handle__
+writeHandle :: Handle -> Handle__ -> IO ()
+#if defined(__CONCURRENT_HASKELL__)
newHandle = newMVar
readHandle = takeMVar
writeHandle = putMVar
-
-#else
-type Handle = MutableVar RealWorld Handle__
-
+#else
newHandle v = stToIO (newVar v)
readHandle h = stToIO (readVar h)
writeHandle h v = stToIO (writeVar h v)
+#endif
-#endif {- __CONCURRENT_HASKELL__ -}
-
-data Handle__
- = ErrorHandle IOError
- | ClosedHandle
- | SemiClosedHandle Addr (Addr, Int)
- | ReadHandle Addr (Maybe BufferMode) Bool
- | WriteHandle Addr (Maybe BufferMode) Bool
- | AppendHandle Addr (Maybe BufferMode) Bool
- | ReadWriteHandle Addr (Maybe BufferMode) Bool
-
-instance Eq Handle{-partain:????-}
-
-{-# INLINE newHandle #-}
-{-# INLINE readHandle #-}
-{-# INLINE writeHandle #-}
-
-newHandle :: Handle__ -> IO Handle
-readHandle :: Handle -> IO Handle__
-writeHandle :: Handle -> Handle__ -> IO ()
\end{code}
%*********************************************************
%*********************************************************
\begin{code}
+#ifndef __PARALLEL_HASKELL__
+filePtr :: Handle__ -> ForeignObj
+#else
filePtr :: Handle__ -> Addr
+#endif
filePtr (SemiClosedHandle fp _) = fp
filePtr (ReadHandle fp _ _) = fp
filePtr (WriteHandle fp _ _) = fp
\begin{code}
stdin, stdout, stderr :: Handle
-stdin = unsafePerformPrimIO (
- _ccall_ getLock (``stdin''::Addr) 0 >>= \ rc ->
- (case rc of
- 0 -> new_handle ClosedHandle
- 1 -> new_handle (ReadHandle ``stdin'' Nothing False)
- _ -> constructError "stdin" >>= \ ioError ->
- new_handle (ErrorHandle ioError)
- ) >>= \ handle ->
- returnPrimIO handle
+stdin = unsafePerformIO (do
+ rc <- _ccall_ getLock (``stdin''::Addr) 0
+ case rc of
+ 0 -> newHandle ClosedHandle
+ 1 -> do
+#ifndef __PARALLEL_HASKELL__
+ fp <- makeForeignObj (``stdin''::Addr) (``&freeStdFile''::Addr)
+ newHandle (ReadHandle fp Nothing False)
+#else
+ newHandle (ReadHandle ``stdin'' Nothing False)
+#endif
+ _ -> do ioError <- constructError "stdin"
+ newHandle (ErrorHandle ioError)
)
- where
- new_handle x = ioToST (newHandle x)
-
-stdout = unsafePerformPrimIO (
- _ccall_ getLock (``stdout''::Addr) 1 >>= \ rc ->
- (case rc of
- 0 -> new_handle ClosedHandle
- 1 -> new_handle (WriteHandle ``stdout'' Nothing False)
- _ -> constructError "stdout" >>= \ ioError ->
- new_handle (ErrorHandle ioError)
- ) >>= \ handle ->
- returnPrimIO handle
+
+stdout = unsafePerformIO (do
+ rc <- _ccall_ getLock (``stdout''::Addr) 1
+ case rc of
+ 0 -> newHandle ClosedHandle
+ 1 -> do
+#ifndef __PARALLEL_HASKELL__
+ fp <- makeForeignObj (``stdout''::Addr) (``&freeStdFile''::Addr)
+ newHandle (WriteHandle fp Nothing False)
+#else
+ newHandle (WriteHandle ``stdout'' Nothing False)
+#endif
+ _ -> do ioError <- constructError "stdout"
+ newHandle (ErrorHandle ioError)
)
- where
- new_handle x = ioToST (newHandle x)
-
-stderr = unsafePerformPrimIO (
- _ccall_ getLock (``stderr''::Addr) 1 >>= \ rc ->
- (case rc of
- 0 -> new_handle ClosedHandle
- 1 -> new_handle (WriteHandle ``stderr'' (Just NoBuffering) False)
- _ -> constructError "stderr" >>= \ ioError ->
- new_handle (ErrorHandle ioError)
- ) >>= \ handle ->
- returnPrimIO handle
+
+stderr = unsafePerformIO (do
+ rc <- _ccall_ getLock (``stderr''::Addr) 1
+ case rc of
+ 0 -> newHandle ClosedHandle
+ 1 -> do
+#ifndef __PARALLEL_HASKELL__
+ fp <- makeForeignObj (``stderr''::Addr) (``&freeStdFile''::Addr)
+ newHandle (WriteHandle fp (Just NoBuffering) False)
+#else
+ newHandle (WriteHandle ``stderr'' (Just NoBuffering) False)
+#endif
+ _ -> do ioError <- constructError "stderr"
+ newHandle (ErrorHandle ioError)
)
- where
- new_handle x = ioToST (newHandle x)
\end{code}
%*********************************************************
openFile :: FilePath -> IOMode -> IO Handle
-openFile f m =
- stToIO (_ccall_ openFile f m') >>= \ ptr ->
- if ptr /= ``NULL'' then
- newHandle (htype ptr Nothing False)
- else
- stToIO (constructError "openFile") >>= \ ioError ->
+openFile f m = do
+ ptr <- _ccall_ openFile f m'
+ if ptr /= ``NULL'' then do
+#ifndef __PARALLEL_HASKELL__
+ fp <- makeForeignObj ptr ((``&freeFile'')::Addr)
+ newHandle (htype fp Nothing False)
+#else
+ newHandle (htype ptr Nothing False)
+#endif
+ else do
+ ioError@(IOError hn iot msg) <- constructError "openFile"
let
improved_error -- a HACK, I guess
- = case ioError of
- AlreadyExists msg -> AlreadyExists (msg ++ ": " ++ f)
- NoSuchThing msg -> NoSuchThing (msg ++ ": " ++ f)
- PermissionDenied msg -> PermissionDenied (msg ++ ": " ++ f)
- _ -> ioError
- in
+ = case iot of
+ AlreadyExists -> IOError hn AlreadyExists (msg ++ ": " ++ f)
+ NoSuchThing -> IOError hn NoSuchThing (msg ++ ": " ++ f)
+ PermissionDenied -> IOError hn PermissionDenied (msg ++ ": " ++ f)
+ _ -> ioError
fail improved_error
where
m' = case m of
\begin{code}
hClose :: Handle -> IO ()
-hClose handle =
- readHandle handle >>= \ htype ->
- writeHandle handle ClosedHandle >>
+hClose handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle fp (buf,_) ->
- (if buf /= ``NULL'' then
- _ccall_ free buf
- else
- returnPrimIO ()) `thenIO_Prim` \ () ->
- if fp /= ``NULL'' then
- _ccall_ closeFile fp `thenIO_Prim` \ rc ->
- if rc == 0 then
- return ()
- else
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle fp (buf,_) -> do
+ (if buf /= ``NULL'' then
+ _ccall_ free buf
+ else
+ return ())
+ fp_a <- _casm_ `` %r = (char *)%0; '' fp
+ if fp_a /= (``NULL''::Addr) then do
+ -- Under what condition can this be NULL?
+ rc <- _ccall_ closeFile fp
+ {- We explicitly close a file object so that we can be told
+ if there were any errors. Note that after @hClose@
+ has been performed, the ForeignObj embedded in the Handle
+ is still lying around in the heap, so care is taken
+ to avoid closing the file object when the ForeignObj
+ is finalised. -}
+ if rc == 0 then do
+#ifndef __PARALLEL_HASKELL__
+ -- Mark the foreign object data value as
+ -- gone to the finaliser (freeFile())
+ writeForeignObj fp ``NULL''
+#endif
+ writeHandle handle ClosedHandle
+ else do
+ writeHandle handle htype
constructErrorAndFail "hClose"
- else
- return ()
- other ->
- _ccall_ closeFile (filePtr other) `thenIO_Prim` \ rc ->
- if rc == 0 then
- return ()
- else
- constructErrorAndFail "hClose"
+
+ else writeHandle handle htype
+
+ other -> do
+ let fp = filePtr other
+ rc <- _ccall_ closeFile fp
+ if rc == 0 then do
+#ifndef __PARALLEL_HASKELL__
+ -- Mark the foreign object data
+ writeForeignObj fp ``NULL''
+#endif
+ writeHandle handle ClosedHandle
+ else do
+ writeHandle handle htype
+ constructErrorAndFail "hClose"
\end{code}
Computation $hClose hdl$ makes handle {\em hdl} closed. Before the
\begin{code}
hFileSize :: Handle -> IO Integer
-hFileSize handle =
- readHandle handle >>= \ htype ->
+hFileSize handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
other ->
-- HACK! We build a unique MP_INT of the right shape to hold
- -- a single unsigned word, and we let the C routine change the data bits
- _casm_ ``%r = 1;'' `thenIO_Prim` \ (I# hack#) ->
+ -- a single unsigned word, and we let the C routine
+ -- change the data bits
+ --
+ -- For some reason, this fails to typecheck if converted to a do
+ -- expression --SDM
+ _casm_ ``%r = 1;'' >>= \(I# hack#) ->
case int2Integer# hack# of
- result@(J# _ _ d#) ->
- let
- bogus_bounds = (error "fileSize"::(Int,Int))
- in
- _ccall_ fileSize (filePtr other) (ByteArray bogus_bounds d#)
- `thenIO_Prim` \ rc ->
- writeHandle handle htype >>
- if rc == 0 then
+ result@(J# _ _ d#) -> do
+ let bogus_bounds = (error "fileSize"::(Int,Int))
+ rc <- _ccall_ fileSize (filePtr other)
+ (ByteArray bogus_bounds d#)
+ writeHandle handle htype
+ if rc == 0 then
return result
- else
- constructErrorAndFail "hFileSize"
+ else
+ constructErrorAndFail "hFileSize"
\end{code}
For a readable handle {\em hdl}, computation $hIsEOF hdl$ returns
\begin{code}
hIsEOF :: Handle -> IO Bool
-hIsEOF handle =
- readHandle handle >>= \ htype ->
+hIsEOF handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- WriteHandle _ _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is not open for reading")
- AppendHandle _ _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is not open for reading")
- other ->
- _ccall_ fileEOF (filePtr other) `thenIO_Prim` \ rc ->
- writeHandle handle (markHandle htype) >>
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ WriteHandle _ _ _ -> do
+ writeHandle handle htype
+ fail (IOError (Just handle) IllegalOperation
+ "handle is not open for reading")
+ AppendHandle _ _ _ -> do
+ writeHandle handle htype
+ fail (IOError (Just handle) IllegalOperation
+ "handle is not open for reading")
+ other -> do
+ rc <- _ccall_ fileEOF (filePtr other)
+ writeHandle handle (markHandle htype)
case rc of
0 -> return False
1 -> return True
%*********************************************************
Three kinds of buffering are supported: line-buffering,
-block-buffering or no-buffering. These modes have the following effects.
-For output, items are written out from the internal buffer
-according to the buffer mode:
-\begin{itemize}
-\item[line-buffering] the entire output buffer is written
-out whenever a newline is output, the output buffer overflows,
-a flush is issued, or the handle is closed.
-
-\item[block-buffering] the entire output buffer is written out whenever
-it overflows, a flush is issued, or the handle
-is closed.
-
-\item[no-buffering] output is written immediately, and never stored
-in the output buffer.
-\end{itemize}
-
-The output buffer is emptied as soon as it has been written out.
-
-Similarly, input occurs according to the buffer mode for handle {\em hdl}.
-\begin{itemize}
-\item[line-buffering] when the input buffer for {\em hdl} is not empty,
-the next item is obtained from the buffer;
-otherwise, when the input buffer is empty,
-characters up to and including the next newline
-character are read into the buffer. No characters
-are available until the newline character is
-available.
-\item[block-buffering] when the input buffer for {\em hdl} becomes empty,
-the next block of data is read into this buffer.
-\item[no-buffering] the next input item is read and returned.
-\end{itemize}
-For most implementations, physical files will normally be block-buffered
-and terminals will normally be line-buffered.
+block-buffering or no-buffering. See @IOBase@ for definition
+and further explanation of what the type represent.
-\begin{code}
-data BufferMode = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
- deriving (Eq, Ord, Read, Show)
-\end{code}
-
-Computation $hSetBuffering hdl mode$ sets the mode of buffering for
+Computation @hSetBuffering hdl mode@ sets the mode of buffering for
handle {\em hdl} on subsequent reads and writes.
\begin{itemize}
\item
-If {\em mode} is $LineBuffering$, line-buffering should be
+If {\em mode} is @LineBuffering@, line-buffering should be
enabled if possible.
\item
-If {\em mode} is $BlockBuffering$ {\em size}, then block-buffering
+If {\em mode} is @BlockBuffering@ {\em size}, then block-buffering
should be enabled if possible. The size of the buffer is {\em n} items
-if {\em size} is $Just${\em n} and is otherwise implementation-dependent.
+if {\em size} is @Just@~{\em n} and is otherwise implementation-dependent.
\item
-If {\em mode} is $NoBuffering$, then buffering is disabled if possible.
+If {\em mode} is @NoBuffering@, then buffering is disabled if possible.
\end{itemize}
-If the buffer mode is changed from $BlockBuffering$ or $LineBuffering$
-to $NoBuffering$, then any items in the output buffer are written to
+If the buffer mode is changed from @BlockBuffering@ or @LineBuffering@
+to @NoBuffering@, then any items in the output buffer are written to
the device, and any items in the input buffer are discarded. The
default buffering mode when a handle is opened is
implementation-dependent and may depend on the object which is
hSetBuffering handle mode =
case mode of
- (BlockBuffering (Just n))
- | n <= 0 -> fail (InvalidArgument "illegal buffer size")
- other ->
- readHandle handle >>= \ htype ->
- if isMarked htype then
- writeHandle handle htype >>
- fail (UnsupportedOperation "can't set buffering for a dirty handle")
- else
+ BlockBuffering (Just n)
+ | n <= 0 -> fail (IOError (Just handle) InvalidArgument
+ "illegal buffer size")
+ other -> do
+ htype <- readHandle handle
+ if isMarked htype then do
+ writeHandle handle htype
+ fail (IOError (Just handle)
+ UnsupportedOperation
+ "can't set buffering for a dirty handle")
+ else
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- other ->
- _ccall_ setBuffering (filePtr other) bsize
- `thenIO_Prim` \ rc ->
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ other -> do
+ rc <- _ccall_ setBuffering (filePtr other) bsize
if rc == 0 then
- writeHandle handle ((hcon other) (filePtr other) (Just mode) True)
- >>
- return ()
- else
- writeHandle handle htype >>
+ writeHandle handle ((hcon other) (filePtr other)
+ (Just mode) True)
+ else do
+ writeHandle handle htype
constructErrorAndFail "hSetBuffering"
where
BlockBuffering Nothing -> -2
BlockBuffering (Just n) -> n
+#ifndef __PARALLEL_HASKELL__
+ hcon :: Handle__ -> (ForeignObj -> (Maybe BufferMode) -> Bool -> Handle__)
+#else
hcon :: Handle__ -> (Addr -> (Maybe BufferMode) -> Bool -> Handle__)
+#endif
hcon (ReadHandle _ _ _) = ReadHandle
hcon (WriteHandle _ _ _) = WriteHandle
hcon (AppendHandle _ _ _) = AppendHandle
\begin{code}
hFlush :: Handle -> IO ()
-hFlush handle =
- readHandle handle >>= \ htype ->
+hFlush handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- other ->
- _ccall_ flushFile (filePtr other) `thenIO_Prim` \ rc ->
- writeHandle handle (markHandle htype) >>
- if rc == 0 then
- return ()
- else
- constructErrorAndFail "hFlush"
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ other -> do
+ rc <- _ccall_ flushFile (filePtr other)
+ writeHandle handle (markHandle htype)
+ if rc == 0 then
+ return ()
+ else
+ constructErrorAndFail "hFlush"
\end{code}
\begin{code}
data HandlePosn = HandlePosn Handle Int
-instance Eq HandlePosn{-partain-}
-
data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
deriving (Eq, Ord, Ix, Enum, Read, Show)
\end{code}
\begin{code}
hGetPosn :: Handle -> IO HandlePosn
-hGetPosn handle =
- readHandle handle >>= \ htype ->
+hGetPosn handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- other ->
- _ccall_ getFilePosn (filePtr other) `thenIO_Prim` \ posn ->
- writeHandle handle htype >>
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ other -> do
+ posn <- _ccall_ getFilePosn (filePtr other)
+ writeHandle handle htype
if posn /= -1 then
return (HandlePosn handle posn)
- else
+ else
constructErrorAndFail "hGetPosn"
hSetPosn :: HandlePosn -> IO ()
-hSetPosn (HandlePosn handle posn) =
- readHandle handle >>= \ htype ->
+hSetPosn (HandlePosn handle posn) = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- AppendHandle _ _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is not seekable")
- other ->
- _ccall_ setFilePosn (filePtr other) posn `thenIO_Prim` \ rc ->
- writeHandle handle (markHandle htype) >>
- if rc == 0 then
- return ()
- else
- constructErrorAndFail "hSetPosn"
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ AppendHandle _ _ _ -> do
+ writeHandle handle htype
+ fail (IOError (Just handle) IllegalOperation "handle is not seekable")
+ other -> do
+ rc <- _ccall_ setFilePosn (filePtr other) posn
+ writeHandle handle (markHandle htype)
+ if rc == 0 then
+ return ()
+ else
+ constructErrorAndFail "hSetPosn"
\end{code}
Computation $hSeek hdl mode i$ sets the position of handle
\begin{code}
hSeek :: Handle -> SeekMode -> Integer -> IO ()
-hSeek handle mode offset@(J# _ s# d#) =
- readHandle handle >>= \ htype ->
+hSeek handle mode offset@(J# _ s# d#) = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- AppendHandle _ _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is not seekable")
- other ->
- _ccall_ seekFile (filePtr other) whence (I# s#) (ByteArray (0,0) d#)
- `thenIO_Prim` \ rc ->
- writeHandle handle (markHandle htype) >>
- if rc == 0 then
- return ()
- else
- constructErrorAndFail "hSeek"
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ AppendHandle _ _ _ -> do
+ writeHandle handle htype
+ fail (IOError (Just handle) IllegalOperation "handle is not seekable")
+ other -> do
+ rc <- _ccall_ seekFile (filePtr other) whence (I# s#)
+ (ByteArray (0,0) d#)
+ writeHandle handle (markHandle htype)
+ if rc == 0 then
+ return ()
+ else
+ constructErrorAndFail "hSeek"
where
whence :: Int
whence = case mode of
AbsoluteSeek -> ``SEEK_SET''
RelativeSeek -> ``SEEK_CUR''
- SeekFromEnd -> ``SEEK_END''
+ SeekFromEnd -> ``SEEK_END''
\end{code}
%*********************************************************
\begin{code}
hIsOpen :: Handle -> IO Bool
-hIsOpen handle =
- readHandle handle >>= \ htype ->
+hIsOpen handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
+ ClosedHandle -> do
+ writeHandle handle htype
return False
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
return False
- other ->
- writeHandle handle htype >>
+ other -> do
+ writeHandle handle htype
return True
hIsClosed :: Handle -> IO Bool
-hIsClosed handle =
- readHandle handle >>= \ htype ->
+hIsClosed handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
+ ClosedHandle -> do
+ writeHandle handle htype
return True
- other ->
- writeHandle handle htype >>
+ other -> do
+ writeHandle handle htype
return False
hIsReadable :: Handle -> IO Bool
-hIsReadable handle =
- readHandle handle >>= \ htype ->
+hIsReadable handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- other ->
- writeHandle handle htype >>
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ other -> do
+ writeHandle handle htype
return (isReadable other)
where
isReadable (ReadHandle _ _ _) = True
isReadable _ = False
hIsWritable :: Handle -> IO Bool
-hIsWritable handle =
- readHandle handle >>= \ htype ->
+hIsWritable handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- other ->
- writeHandle handle htype >>
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ other -> do
+ writeHandle handle htype
return (isWritable other)
where
isWritable (AppendHandle _ _ _) = True
isWritable (ReadWriteHandle _ _ _) = True
isWritable _ = False
-getBufferMode :: Handle__ -> PrimIO Handle__
+getBufferMode :: Handle__ -> IO Handle__
getBufferMode htype =
case bufferMode htype of
- Just x -> returnPrimIO htype
- Nothing ->
- _ccall_ getBufferMode (filePtr htype) `thenPrimIO` \ rc ->
+ Just x -> return htype
+ Nothing -> do
+ rc <- _ccall_ getBufferMode (filePtr htype)
let
mode =
case rc of
-2 -> Just (BlockBuffering Nothing)
-3 -> Nothing
n -> Just (BlockBuffering (Just n))
- in
- returnPrimIO (case htype of
+ return (case htype of
ReadHandle fp _ b -> ReadHandle fp mode b
WriteHandle fp _ b -> WriteHandle fp mode b
AppendHandle fp _ b -> AppendHandle fp mode b
ReadWriteHandle fp _ b -> ReadWriteHandle fp mode b)
hIsBlockBuffered :: Handle -> IO (Bool,Maybe Int)
-hIsBlockBuffered handle =
- readHandle handle >>= \ htype ->
+hIsBlockBuffered handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- other ->
- getBufferMode other `thenIO_Prim` \ other ->
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ other -> do
+ other <- getBufferMode other
case bufferMode other of
- Just (BlockBuffering size) ->
- writeHandle handle other >>
+ Just (BlockBuffering size) -> do
+ writeHandle handle other
return (True, size)
- Just _ ->
- writeHandle handle other >>
+ Just _ -> do
+ writeHandle handle other
return (False, Nothing)
Nothing ->
constructErrorAndFail "hIsBlockBuffered"
hIsLineBuffered :: Handle -> IO Bool
-hIsLineBuffered handle =
- readHandle handle >>= \ htype ->
+hIsLineBuffered handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- other ->
- getBufferMode other `thenIO_Prim` \ other ->
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ other -> do
+ other <- getBufferMode other
case bufferMode other of
- Just LineBuffering ->
- writeHandle handle other >>
+ Just LineBuffering -> do
+ writeHandle handle other
return True
- Just _ ->
- writeHandle handle other >>
+ Just _ -> do
+ writeHandle handle other
return False
Nothing ->
constructErrorAndFail "hIsLineBuffered"
hIsNotBuffered :: Handle -> IO Bool
-hIsNotBuffered handle =
- readHandle handle >>= \ htype ->
+hIsNotBuffered handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- other ->
- getBufferMode other `thenIO_Prim` \ other ->
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ other -> do
+ other <- getBufferMode other
case bufferMode other of
- Just NoBuffering ->
- writeHandle handle other >>
+ Just NoBuffering -> do
+ writeHandle handle other
return True
- Just _ ->
- writeHandle handle other >>
+ Just _ -> do
+ writeHandle handle other
return False
Nothing ->
constructErrorAndFail "hIsNotBuffered"
hGetBuffering :: Handle -> IO BufferMode
-hGetBuffering hndl =
- readHandle hndl >>= \ htype ->
+hGetBuffering handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle hndl htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle hndl htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle hndl htype >>
- fail (IllegalOperation "handle is closed")
- other ->
- getBufferMode other `thenIO_Prim` \ other ->
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ other -> do
+ other <- getBufferMode other
case bufferMode other of
- Just v ->
- writeHandle hndl other >>
+ Just v -> do
+ writeHandle handle other
return v
Nothing ->
constructErrorAndFail "hGetBuffering"
hIsSeekable :: Handle -> IO Bool
-hIsSeekable handle =
- readHandle handle >>= \ htype ->
+hIsSeekable handle = do
+ htype <- readHandle handle
case htype of
- ErrorHandle ioError ->
- writeHandle handle htype >>
+ ErrorHandle ioError -> do
+ writeHandle handle htype
fail ioError
- ClosedHandle ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- SemiClosedHandle _ _ ->
- writeHandle handle htype >>
- fail (IllegalOperation "handle is closed")
- AppendHandle _ _ _ ->
- writeHandle handle htype >>
+ ClosedHandle -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ SemiClosedHandle _ _ -> do
+ writeHandle handle htype
+ ioe_closedHandle handle
+ AppendHandle _ _ _ -> do
+ writeHandle handle htype
return False
- other ->
- _ccall_ seekFileP (filePtr other) `thenIO_Prim` \ rc ->
- writeHandle handle htype >>
+ other -> do
+ rc <- _ccall_ seekFileP (filePtr other)
+ writeHandle handle htype
case rc of
0 -> return False
1 -> return True
\begin{code}
ioeGetFileName :: IOError -> Maybe FilePath
+ioeGetErrorString :: IOError -> String
ioeGetHandle :: IOError -> Maybe Handle
+ioeGetHandle (IOError h _ _) = h
+ioeGetErrorString (IOError _ iot str) =
+ case iot of
+ EOF -> "end of file"
+ _ -> str
+
+ioeGetFileName (IOError _ _ str) =
+ case span (/=':') str of
+ (fs,[]) -> Nothing
+ (fs,_) -> Just fs
-ioeGetHandle _ = Nothing -- a stub, essentially
-ioeGetFileName _ = Nothing -- a stub, essentially
\end{code}
+Internal function for creating an @IOError@ representing the
+access of a closed file.
+
+\begin{code}
+
+ioe_closedHandle :: Handle -> IO a
+ioe_closedHandle h = fail (IOError (Just h) IllegalOperation "handle is closed")
+
+\end{code}
projects / ghc-hetmet.git / blobdiff