2 % (c) The AQUA Project, Glasgow University, 1994-1998
4 \section[IO]{Module @IO@}
6 Implementation of the standard Haskell IO interface, see
7 @http://haskell.org/onlinelibrary/io.html@ for the official
12 Handle, -- abstract, instance of: Eq, Show.
13 HandlePosn(..), -- abstract, instance of: Eq, Show.
15 IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
16 BufferMode(NoBuffering,LineBuffering,BlockBuffering),
17 SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
19 stdin, stdout, stderr, -- :: Handle
21 openFile, -- :: FilePath -> IOMode -> IO Handle
22 hClose, -- :: Handle -> IO ()
23 hFileSize, -- :: Handle -> IO Integer
24 hIsEOF, -- :: Handle -> IO Bool
27 hSetBuffering, -- :: Handle -> BufferMode -> IO ()
28 hGetBuffering, -- :: Handle -> IO BufferMode
29 hFlush, -- :: Handle -> IO ()
30 hGetPosn, -- :: Handle -> IO HandlePosn
31 hSetPosn, -- :: Handle -> HandlePosn -> IO ()
32 hSeek, -- :: Handle -> SeekMode -> Integer -> IO ()
33 hWaitForInput, -- :: Handle -> Int -> IO Bool
34 hReady, -- :: Handle -> IO Bool
35 hGetChar, -- :: Handle -> IO Char
36 hGetLine, -- :: Handle -> IO [Char]
37 hLookAhead, -- :: Handle -> IO Char
38 hGetContents, -- :: Handle -> IO [Char]
39 hPutChar, -- :: Handle -> Char -> IO ()
40 hPutStr, -- :: Handle -> [Char] -> IO ()
41 hPutStrLn, -- :: Handle -> [Char] -> IO ()
42 hPrint, -- :: Show a => Handle -> a -> IO ()
43 hIsOpen, hIsClosed, -- :: Handle -> IO Bool
44 hIsReadable, hIsWritable, -- :: Handle -> IO Bool
45 hIsSeekable, -- :: Handle -> IO Bool
47 isAlreadyExistsError, isDoesNotExistError, -- :: IOError -> Bool
48 isAlreadyInUseError, isFullError,
49 isEOFError, isIllegalOperation,
50 isPermissionError, isUserError,
52 ioeGetErrorString, -- :: IOError -> String
53 ioeGetHandle, -- :: IOError -> Maybe Handle
54 ioeGetFileName, -- :: IOError -> Maybe FilePath
56 try, -- :: IO a -> IO (Either IOError a)
57 bracket, -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
58 bracket_, -- :: IO a -> (a -> IO b) -> IO c -> IO c
60 -- Non-standard extension (but will hopefully become standard with 1.5) is
61 -- to export the Prelude io functions via IO (in addition to exporting them
62 -- from the prelude...for now.)
64 FilePath, -- :: String
66 ioError, -- :: IOError -> IO a
67 userError, -- :: String -> IOError
68 catch, -- :: IO a -> (IOError -> IO a) -> IO a
69 interact, -- :: (String -> String) -> IO ()
71 putChar, -- :: Char -> IO ()
72 putStr, -- :: String -> IO ()
73 putStrLn, -- :: String -> IO ()
74 print, -- :: Show a => a -> IO ()
75 getChar, -- :: IO Char
76 getLine, -- :: IO String
77 getContents, -- :: IO String
78 readFile, -- :: FilePath -> IO String
79 writeFile, -- :: FilePath -> String -> IO ()
80 appendFile, -- :: FilePath -> String -> IO ()
81 readIO, -- :: Read a => String -> IO a
82 readLn, -- :: Read a => IO a
87 import PrelIOBase -- Together these four Prelude modules define
88 import PrelHandle -- all the stuff exported by IO for the GHC version
93 -- The entire rest of this module is just Hugs
95 #else /* ifndef __HUGS__ */
98 import PrelPrim ( IORef
100 , prelCleanupAfterRunAction
101 , copy_String_to_cstring
103 , primWriteCharOffAddr
124 %*********************************************************
126 \subsection{The HUGS version of IO
128 %*********************************************************
135 unimp s = error ("IO library: function not implemented: " ++ s)
137 type FILE_STAR = Addr
142 = Handle { name :: FilePath,
143 file :: FILE_STAR, -- C handle
144 mut :: IORef Handle_Mut, -- open/closed/semiclosed
150 = Handle_Mut { state :: HState
154 set_state :: Handle -> HState -> IO ()
155 set_state hdl new_state
156 = writeIORef (mut hdl) (Handle_Mut { state = new_state })
157 get_state :: Handle -> IO HState
159 = readIORef (mut hdl) >>= \m -> return (state m)
161 mkErr :: Handle -> String -> IO a
163 = do mut <- readIORef (mut h)
164 when (state mut /= HClosed)
165 (nh_close (file h) >> set_state h HClosed)
167 ioError (IOError msg)
172 file = unsafePerformIO nh_stdin,
173 mut = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
180 file = unsafePerformIO nh_stdout,
181 mut = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
188 file = unsafePerformIO nh_stderr,
189 mut = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
194 instance Eq Handle where
195 h1 == h2 = file h1 == file h2
197 instance Show Handle where
198 showsPrec _ h = showString ("`" ++ name h ++ "'")
205 data IOMode = ReadMode | WriteMode | AppendMode | ReadWriteMode
206 deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
208 data BufferMode = NoBuffering | LineBuffering
209 | BlockBuffering (Maybe Int)
210 deriving (Eq, Ord, Read, Show)
212 data SeekMode = AbsoluteSeek | RelativeSeek | SeekFromEnd
213 deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
215 data HState = HOpen | HSemiClosed | HClosed
219 -- A global variable holding a list of all open handles.
220 -- Each handle is present as many times as it has been opened.
221 -- Any given file is allowed to have _either_ one writeable handle
222 -- or many readable handles in this list. The list is used to
223 -- enforce single-writer multiple reader semantics. It also
224 -- provides a list of handles for System.exitWith to flush and
225 -- close. In order not to have to put all this stuff in the
226 -- Prelude, System.exitWith merely runs prelExitWithAction,
227 -- which is originally Nothing, but which we set to Just ...
228 -- once handles appear in the list.
230 allHandles :: IORef [Handle]
231 allHandles = unsafePerformIO (newIORef [])
233 elemWriterHandles :: FilePath -> IO Bool
234 elemAllHandles :: FilePath -> IO Bool
235 addHandle :: Handle -> IO ()
236 delHandle :: Handle -> IO ()
237 cleanupHandles :: IO ()
240 = do hdls <- readIORef allHandles
241 mapM_ cleanupHandle hdls
246 >> nh_errno >>= \_ -> return ()
248 = nh_flush (file h) >> nh_close (file h)
249 >> nh_errno >>= \_ -> return ()
251 elemWriterHandles fname
252 = do hdls <- readIORef allHandles
253 let hdls_w = filter ((/= ReadMode).mode) hdls
254 return (fname `elem` (map name hdls_w))
257 = do hdls <- readIORef allHandles
258 return (fname `elem` (map name hdls))
261 = do cleanup_action <- readIORef prelCleanupAfterRunAction
262 case cleanup_action of
264 -> writeIORef prelCleanupAfterRunAction (Just cleanupHandles)
267 hdls <- readIORef allHandles
268 writeIORef allHandles (hdl : hdls)
271 = do hdls <- readIORef allHandles
272 let hdls' = takeWhile (/= hdl) hdls
273 ++ drop 1 (dropWhile (/= hdl) hdls)
274 writeIORef allHandles hdls'
278 openFile :: FilePath -> IOMode -> IO Handle
282 = (ioError.IOError) "openFile: empty file name"
285 = do not_ok <- elemWriterHandles f
287 then (ioError.IOError)
288 ("openFile: `" ++ f ++ "' in " ++ show mode
289 ++ ": is already open for writing")
290 else openFile_main f mode
293 = do not_ok <- elemAllHandles f
295 then (ioError.IOError)
296 ("openFile: `" ++ f ++ "' in " ++ show mode
297 ++ ": is already open for reading or writing")
298 else openFile_main f mode
301 = openFile_main f mode
304 = copy_String_to_cstring f >>= \nameptr ->
305 nh_open nameptr (mode2num mode) >>= \fh ->
308 then (ioError.IOError)
309 ("openFile: can't open <<" ++ f ++ ">> in " ++ show mode)
310 else do r <- newIORef (Handle_Mut { state = HOpen })
311 let hdl = Handle { name = f, file = fh,
312 mut = r, mode = mode }
316 mode2num :: IOMode -> Int
317 mode2num ReadMode = 0
318 mode2num WriteMode = 1
319 mode2num AppendMode = 2
320 mode2num ReadWriteMode
322 ("openFile <<" ++ f ++ ">>: ReadWriteMode not supported")
324 hClose :: Handle -> IO ()
326 = do mut <- readIORef (mut h)
327 if state mut == HClosed
329 ("hClose on closed handle " ++ show h)
331 do set_state h HClosed
338 ("hClose: error closing " ++ name h)
340 hGetContents :: Handle -> IO String
343 = mkErr h ("hGetContents on non-ReadMode handle " ++ show h)
345 = do mut <- readIORef (mut h)
346 if state mut /= HOpen
348 ("hGetContents on closed/semiclosed handle " ++ show h)
350 do set_state h HSemiClosed
354 = nh_read f >>= \ci ->
357 else read_all f >>= \rest ->
358 return ((primIntToChar ci):rest)
360 hPutStr :: Handle -> String -> IO ()
363 = mkErr h ("hPutStr on ReadMode handle " ++ show h)
365 = do mut <- readIORef (mut h)
366 if state mut /= HOpen
368 ("hPutStr on closed/semiclosed handle " ++ show h)
369 else write_all (file h) s
374 = nh_write f c >> write_all f cs
376 hFileSize :: Handle -> IO Integer
378 = do sz <- nh_filesize (file h)
381 then return (fromIntegral sz)
382 else mkErr h ("hFileSize on " ++ show h)
384 hIsEOF :: Handle -> IO Bool
386 = do iseof <- nh_iseof (file h)
389 then return (iseof /= 0)
390 else mkErr h ("hIsEOF on " ++ show h)
395 hSetBuffering :: Handle -> BufferMode -> IO ()
396 hSetBuffering = unimp "IO.hSetBuffering"
397 hGetBuffering :: Handle -> IO BufferMode
398 hGetBuffering = unimp "IO.hGetBuffering"
400 hFlush :: Handle -> IO ()
402 = do mut <- readIORef (mut h)
403 if state mut /= HOpen
405 ("hFlush on closed/semiclosed file " ++ name h)
406 else nh_flush (file h)
408 hGetPosn :: Handle -> IO HandlePosn
409 hGetPosn = unimp "IO.hGetPosn"
410 hSetPosn :: HandlePosn -> IO ()
411 hSetPosn = unimp "IO.hSetPosn"
412 hSeek :: Handle -> SeekMode -> Integer -> IO ()
413 hSeek = unimp "IO.hSeek"
414 hWaitForInput :: Handle -> Int -> IO Bool
415 hWaitForInput = unimp "hWaitForInput"
416 hReady :: Handle -> IO Bool
417 hReady h = unimp "hReady" -- hWaitForInput h 0
419 hGetChar :: Handle -> IO Char
421 = nh_read (file h) >>= \ci ->
422 return (primIntToChar ci)
424 hGetLine :: Handle -> IO String
425 hGetLine h = do c <- hGetChar h
426 if c=='\n' then return ""
427 else do cs <- hGetLine h
430 hLookAhead :: Handle -> IO Char
431 hLookAhead = unimp "IO.hLookAhead"
434 hPutChar :: Handle -> Char -> IO ()
435 hPutChar h c = hPutStr h [c]
437 hPutStrLn :: Handle -> String -> IO ()
438 hPutStrLn h s = do { hPutStr h s; hPutChar h '\n' }
440 hPrint :: Show a => Handle -> a -> IO ()
441 hPrint h = hPutStrLn h . show
443 hIsOpen, hIsClosed, hIsReadable, hIsWritable :: Handle -> IO Bool
444 hIsOpen h = do { s <- get_state h; return (s == HOpen) }
445 hIsClosed h = do { s <- get_state h; return (s == HClosed) }
446 hIsReadable h = return (mode h == ReadMode)
447 hIsWritable h = return (mode h `elem` [WriteMode, AppendMode])
449 hIsSeekable :: Handle -> IO Bool
450 hIsSeekable = unimp "IO.hIsSeekable"
453 isAlreadyExistsError,
459 isUserError :: IOError -> Bool
461 isIllegalOperation = unimp "IO.isIllegalOperation"
462 isAlreadyExistsError = unimp "IO.isAlreadyExistsError"
463 isDoesNotExistError = unimp "IO.isDoesNotExistError"
464 isAlreadyInUseError = unimp "IO.isAlreadyInUseError"
465 isFullError = unimp "IO.isFullError"
466 isEOFError = unimp "IO.isEOFError"
467 isPermissionError = unimp "IO.isPermissionError"
468 isUserError = unimp "IO.isUserError"
471 ioeGetErrorString :: IOError -> String
472 ioeGetErrorString = unimp "IO.ioeGetErrorString"
473 ioeGetHandle :: IOError -> Maybe Handle
474 ioeGetHandle = unimp "IO.ioeGetHandle"
475 ioeGetFileName :: IOError -> Maybe FilePath
476 ioeGetFileName = unimp "IO.ioeGetFileName"
478 try :: IO a -> IO (Either IOError a)
479 try p = catch (p >>= (return . Right)) (return . Left)
481 bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
482 bracket before after m = do
490 -- variant of the above where middle computation doesn't want x
491 bracket_ :: IO a -> (a -> IO b) -> IO c -> IO c
492 bracket_ before after m = do
500 -- TODO: Hugs/slurpFile
501 slurpFile = unimp "IO.slurpFile"
504 #endif /* #ifndef __HUGS__ */