IO.lhs 16.8 KB
Newer Older
1 2 3 4 5 6 7
%
% (c) The AQUA Project, Glasgow University, 1994-1996
%

\section[IO]{Module @IO@}

\begin{code}
sof's avatar
sof committed
8
{-# OPTIONS -fno-implicit-prelude -#include "cbits/stgio.h" #-}
9

10 11
module IO (
    Handle, HandlePosn,
12

13 14 15
    IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
    BufferMode(NoBuffering,LineBuffering,BlockBuffering),
    SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
16 17 18

    stdin, stdout, stderr, 

sof's avatar
sof committed
19 20 21 22 23 24 25 26 27 28
    openFile, hClose, 
    hFileSize, hIsEOF, isEOF,
    hSetBuffering, hGetBuffering, hFlush, 
    hGetPosn, hSetPosn, hSeek, 
    hReady, hGetChar, hLookAhead, hGetContents, 
    hPutChar, hPutStr, hPutStrLn, hPrint,
    hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable,

    isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError, 
    isFullError, isEOFError,
29
    isIllegalOperation, isPermissionError, isUserError, 
sof's avatar
sof committed
30
    ioeGetErrorString, 
31 32
    ioeGetHandle, ioeGetFileName
  ) where
33 34

import Ix
35 36 37 38 39 40 41
import STBase
import IOBase
import ArrBase		( MutableByteArray(..), newCharArray )
import IOHandle		-- much of the real stuff is in here
import PackedString	( nilPS, packCBytesST, unpackPS )
import PrelBase
import GHC
sof's avatar
sof committed
42
import Foreign          ( makeForeignObj )
43 44 45 46 47 48 49 50 51 52 53 54 55
\end{code}

%*********************************************************
%*							*
\subsection{Signatures}
%*							*
%*********************************************************

\begin{code}
--IOHandle:hClose                :: Handle -> IO () 
--IOHandle:hFileSize             :: Handle -> IO Integer
--IOHandle:hFlush                :: Handle -> IO () 
--IOHandle:hGetBuffering         :: Handle -> IO BufferMode
56 57
hGetChar              :: Handle -> IO Char
hGetContents          :: Handle -> IO String
58 59 60 61 62 63 64
--IOHandle:hGetPosn              :: Handle -> IO HandlePosn
--IOHandle:hIsClosed             :: Handle -> IO Bool
--IOHandle:hIsEOF                :: Handle -> IO Bool
--IOHandle:hIsOpen               :: Handle -> IO Bool
--IOHandle:hIsReadable           :: Handle -> IO Bool
--IOHandle:hIsSeekable           :: Handle -> IO Bool
--IOHandle:hIsWritable           :: Handle -> IO Bool
65 66 67 68
hLookAhead            :: Handle -> IO Char
hPrint                :: Show a => Handle -> a -> IO ()
hPutChar              :: Handle -> Char -> IO ()
hPutStr               :: Handle -> String -> IO ()
sof's avatar
sof committed
69
hPutStrLn             :: Handle -> String -> IO ()
70
hReady                :: Handle -> IO Bool 
71 72 73 74
--IOHandle:hSeek                 :: Handle -> SeekMode -> Integer -> IO () 
--IOHandle:hSetBuffering         :: Handle -> BufferMode -> IO ()
--IOHandle:hSetPosn              :: HandlePosn -> IO () 
-- ioeGetFileName        :: IOError -> Maybe FilePath
sof's avatar
sof committed
75
-- ioeGetErrorString     :: IOError -> Maybe String
76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98
-- ioeGetHandle          :: IOError -> Maybe Handle
-- isAlreadyExistsError  :: IOError -> Bool
-- isAlreadyInUseError   :: IOError -> Bool
--IOHandle:isEOF                 :: IO Bool
-- isEOFError            :: IOError -> Bool
-- isFullError           :: IOError -> Bool
-- isIllegalOperation    :: IOError -> Bool
-- isPermissionError     :: IOError -> Bool
-- isUserError           :: IOError -> Maybe String
--IOHandle:openFile              :: FilePath -> IOMode -> IO Handle
--IOHandle:stdin, stdout, stderr :: Handle
\end{code}

%*********************************************************
%*							*
\subsection{Simple input operations}
%*							*
%*********************************************************

Computation $hReady hdl$ indicates whether at least
one item is available for input from handle {\em hdl}.

\begin{code}
99 100 101 102 103 104 105 106 107
--hReady :: Handle -> IO Bool 
hReady handle = 
    readHandle handle				    >>= \ htype ->
    case htype of 
      ErrorHandle ioError ->
	  writeHandle handle htype		    >>
          fail ioError
      ClosedHandle ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
108
	  ioe_closedHandle handle
109 110
      SemiClosedHandle _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
111
	  ioe_closedHandle handle
112 113
      AppendHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
114
	  fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
115 116
      WriteHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
117
	  fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
118
      other -> 
119
	  _ccall_ inputReady (filePtr other)  	    `thenIO_Prim` \ rc ->
120 121 122 123 124
	  writeHandle handle (markHandle htype)   >>
          case rc of
            0 -> return False
            1 -> return True
            _ -> constructErrorAndFail "hReady"
125
\end{code}
126

127 128
Computation $hGetChar hdl$ reads the next character from handle 
{\em hdl}, blocking until a character is available.
129

130
\begin{code}
131 132 133 134 135 136 137 138 139 140
--hGetChar :: Handle -> IO Char

hGetChar handle = 
    readHandle handle				    >>= \ htype ->
    case htype of 
      ErrorHandle ioError ->
	  writeHandle handle htype		    >>
          fail ioError
      ClosedHandle ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
141
	  ioe_closedHandle handle
142 143
      SemiClosedHandle _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
144
	  ioe_closedHandle handle
145 146
      AppendHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
147
	  fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
148 149
      WriteHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
150
	  fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
151
      other -> 
152
	  _ccall_ fileGetc (filePtr other)  	    `thenIO_Prim` \ intc ->
153 154 155 156 157
	  writeHandle handle (markHandle htype)   >>
          if intc /= ``EOF'' then
              return (chr intc)
          else
              constructErrorAndFail "hGetChar"
158
\end{code}
159

160 161 162
Computation $hLookahead hdl$ returns the next character from handle
{\em hdl} without removing it from the input buffer, blocking until a
character is available.
163

164
\begin{code}
165 166 167 168 169 170 171 172 173 174
--hLookAhead :: Handle -> IO Char

hLookAhead handle = 
    readHandle handle				    >>= \ htype ->
    case htype of 
      ErrorHandle ioError ->
	  writeHandle handle htype		    >>
          fail ioError
      ClosedHandle ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
175
	  ioe_closedHandle handle
176 177
      SemiClosedHandle _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
178
	  ioe_closedHandle handle
179 180
      AppendHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
181
	  fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
182 183
      WriteHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
184
	  fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
185
      other -> 
186
	  _ccall_ fileLookAhead (filePtr other)    `thenIO_Prim` \ intc ->
187 188 189 190 191
	  writeHandle handle (markHandle htype)   >>
          if intc /= ``EOF'' then
              return (chr intc)
          else
              constructErrorAndFail "hLookAhead"
192 193 194 195 196 197 198 199
\end{code}


%*********************************************************
%*							*
\subsection{Getting the entire contents of a handle}
%*							*
%*********************************************************
200

201 202 203
Computation $hGetContents hdl$ returns the list of characters
corresponding to the unread portion of the channel or file managed by
{\em hdl}, which is made semi-closed.
204

205
\begin{code}
206 207 208 209 210 211 212 213 214 215
--hGetContents :: Handle -> IO String

hGetContents handle =
    readHandle handle				    >>= \ htype ->
    case htype of 
      ErrorHandle ioError ->
	  writeHandle handle htype		    >>
          fail ioError
      ClosedHandle ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
216
	  ioe_closedHandle handle
217 218
      SemiClosedHandle _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
219
	  ioe_closedHandle handle
220 221
      AppendHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
222
	  fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
223 224
      WriteHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
225
	  fail (IOError (Just handle) IllegalOperation "handle is not open for reading")
226 227 228 229 230 231 232 233 234 235 236 237 238
      other -> 
	  {- 
             To avoid introducing an extra layer of buffering here,
             we provide three lazy read methods, based on character,
             line, and block buffering.
          -}
	  stToIO (getBufferMode other)	>>= \ other ->
          case (bufferMode other) of
            Just LineBuffering ->
		allocBuf Nothing		    >>= \ buf_info ->
	        writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
                                          	    >>
                unsafeInterleavePrimIO (lazyReadLine handle)
239
						    `thenIO_Prim` \ contents ->
240 241 242 243 244 245 246
	        return contents

            Just (BlockBuffering size) ->
		allocBuf size			    >>= \ buf_info ->
	        writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
                                          	    >>
                unsafeInterleavePrimIO (lazyReadBlock handle)
247
						    `thenIO_Prim` \ contents ->
248 249 250 251 252
	        return contents
            _ -> -- Nothing is treated pessimistically as NoBuffering
	        writeHandle handle (SemiClosedHandle (filePtr other) (``NULL'', 0))
                                          	    >>
                unsafeInterleavePrimIO (lazyReadChar handle)
253
						    `thenIO_Prim` \ contents ->
254 255 256 257
	        return contents
  where
    allocBuf :: Maybe Int -> IO (Addr, Int)
    allocBuf msize =
258
	_ccall_ malloc size		    	    `thenIO_Prim` \ buf ->
259 260 261
	if buf /= ``NULL'' then
	    return (buf, size)
	else
sof's avatar
sof committed
262
	    fail (IOError Nothing ResourceExhausted "not enough virtual memory")
263 264 265 266 267
      where
        size = 
	    case msize of
	      Just x -> x
	      Nothing -> ``BUFSIZ''
268
\end{code}
269

270 271 272
Note that someone may yank our handle out from under us, and then re-use
the same FILE * for something else.  Therefore, we have to re-examine the
handle every time through.
273

274
\begin{code}
275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291
lazyReadBlock :: Handle -> PrimIO String
lazyReadLine  :: Handle -> PrimIO String
lazyReadChar  :: Handle -> PrimIO String

lazyReadBlock handle =
    ioToST (readHandle handle)		    >>= \ htype ->
    case htype of 
      -- There cannae be an ErrorHandle here
      ClosedHandle ->
	  ioToST (writeHandle handle htype)	>>
	  returnPrimIO ""
      SemiClosedHandle fp (buf, size) ->
	  _ccall_ readBlock buf fp size		    >>= \ bytes ->
	  (if bytes <= 0
	  then return nilPS
	  else packCBytesST bytes buf)		    >>= \ some ->
          if bytes < 0 then
sof's avatar
sof committed
292 293
	      makeForeignObj ``NULL'' ``&freeFile'' >>= \ null_fp ->
	      ioToST (writeHandle handle (SemiClosedHandle null_fp (``NULL'', 0)))
294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316
						    >>
              _ccall_ free buf			    >>= \ () ->
              _ccall_ closeFile fp	            >>
	      returnPrimIO (unpackPS some)
	  else
	      ioToST (writeHandle handle htype)	    >>
              unsafeInterleavePrimIO (lazyReadBlock handle)
						    >>= \ more ->
	      returnPrimIO (unpackPS some ++ more)

lazyReadLine handle =
    ioToST (readHandle handle) >>= \ htype ->
    case htype of 
      -- There cannae be an ErrorHandle here
      ClosedHandle ->
	  ioToST (writeHandle handle htype) >>
	  returnPrimIO ""
      SemiClosedHandle fp (buf, size) ->
	  _ccall_ readLine buf fp size		    >>= \ bytes ->
	  (if bytes <= 0
	  then return nilPS
	  else packCBytesST bytes buf)		    >>= \ some ->
          if bytes < 0 then
sof's avatar
sof committed
317 318
	      makeForeignObj ``NULL'' ``&freeFile'' >>= \ null_fp ->
	      ioToST (writeHandle handle (SemiClosedHandle null_fp (``NULL'', 0)))
319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338
						    >>
              _ccall_ free buf			    >>= \ () ->
              _ccall_ closeFile fp	            >>
	      returnPrimIO (unpackPS some)
	  else
	      ioToST (writeHandle handle htype)	    >>
              unsafeInterleavePrimIO (lazyReadLine handle)
						    >>= \ more ->
	      returnPrimIO (unpackPS some ++ more)

lazyReadChar handle =
    ioToST (readHandle handle) >>= \ htype ->
    case htype of 
      -- There cannae be an ErrorHandle here
      ClosedHandle ->
	  ioToST (writeHandle handle htype)	    >>
	  returnPrimIO ""
      SemiClosedHandle fp buf_info ->
	  _ccall_ readChar fp			    >>= \ char ->
          if char == ``EOF'' then
sof's avatar
sof committed
339 340
	      makeForeignObj ``NULL'' ``&freeFile'' >>= \ null_fp ->
	      ioToST (writeHandle handle (SemiClosedHandle null_fp buf_info))
341 342 343 344 345 346 347 348
						    >>
              _ccall_ closeFile fp	            >>
	      returnPrimIO ""
	  else
	      ioToST (writeHandle handle htype)	    >>
              unsafeInterleavePrimIO (lazyReadChar handle)
						    >>= \ more ->
	      returnPrimIO (chr char : more)
349 350 351 352 353 354 355 356
\end{code}


%*********************************************************
%*							*
\subsection{Simple output functions}
%*							*
%*********************************************************
357

358 359 360
Computation $hPutChar hdl c$ writes the character {\em c} to the file
or channel managed by {\em hdl}.  Characters may be buffered if
buffering is enabled for {\em hdl}.
361

362
\begin{code}
363 364 365 366 367 368 369 370 371 372
--hPutChar :: Handle -> Char -> IO ()

hPutChar handle c =
    readHandle handle				    >>= \ htype ->
    case htype of 
      ErrorHandle ioError ->
	  writeHandle handle htype		    >>
          fail ioError
      ClosedHandle ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
373
	  ioe_closedHandle handle
374 375
      SemiClosedHandle _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
376
	  ioe_closedHandle handle
377 378
      ReadHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
379
	  fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
380
      other -> 
381
	  _ccall_ filePutc (filePtr other) (ord c) `thenIO_Prim` \ rc ->
382 383 384 385 386
	  writeHandle handle (markHandle htype)   >>
          if rc == 0 then
              return ()
          else
              constructErrorAndFail "hPutChar"
387
\end{code}
388

389 390
Computation $hPutStr hdl s$ writes the string {\em s} to the file or
channel managed by {\em hdl}.
391

392
\begin{code}
393 394 395 396 397 398 399 400 401 402
--hPutStr :: Handle -> String -> IO ()

hPutStr handle str = 
    readHandle handle				    >>= \ htype ->
    case htype of 
      ErrorHandle ioError ->
	  writeHandle handle htype		    >>
          fail ioError
      ClosedHandle ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
403
	  ioe_closedHandle handle
404 405
      SemiClosedHandle _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
406
	  ioe_closedHandle handle
407 408
      ReadHandle _ _ _ ->
	  writeHandle handle htype		    >>
sof's avatar
sof committed
409
	  fail (IOError (Just handle) IllegalOperation "handle is not open for writing")
410
      other -> 
411
          getBufferMode other			    `thenIO_Prim` \ other ->
412 413 414 415 416 417 418 419 420
          (case bufferMode other of
            Just LineBuffering ->
		writeLines (filePtr other) str
            Just (BlockBuffering (Just size)) ->
	        writeBlocks (filePtr other) size str
            Just (BlockBuffering Nothing) ->
	        writeBlocks (filePtr other) ``BUFSIZ'' str
            _ -> -- Nothing is treated pessimistically as NoBuffering
	        writeChars (filePtr other) str
421
	  )    					    `thenIO_Prim` \ success ->
422 423 424 425 426 427
	  writeHandle handle (markHandle other) >>
          if success then
              return ()
          else
              constructErrorAndFail "hPutStr"
  where
sof's avatar
sof committed
428
    writeLines :: ForeignObj -> String -> PrimIO Bool
429 430
    writeLines = writeChunks ``BUFSIZ'' True 

sof's avatar
sof committed
431
    writeBlocks :: ForeignObj -> Int -> String -> PrimIO Bool
432 433 434 435 436 437 438 439 440 441 442 443 444 445
    writeBlocks fp size s = writeChunks size False fp s
 
    {-
      The breaking up of output into lines along \n boundaries
      works fine as long as there are newlines to split by.
      Avoid the splitting up into lines alltogether (doesn't work
      for overly long lines like the stuff that showsPrec instances
      normally return). Instead, we split them up into fixed size
      chunks before blasting them off to the Real World.

      Hacked to avoid multiple passes over the strings - unsightly, but
      a whole lot quicker. -- SOF 3/96
    -}

sof's avatar
sof committed
446
    writeChunks :: Int -> Bool -> ForeignObj -> String -> PrimIO Bool
447 448 449 450 451 452 453 454 455 456 457 458 459

    writeChunks (I# bufLen) chopOnNewLine fp s =
     newCharArray (0,I# bufLen) >>= \ arr@(MutableByteArray _ arr#) ->
     let
      write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> PrimIO ()
      write_char arr# n x = ST $ \ (S# s#) ->
	  case (writeCharArray# arr# n x s#) of { s1# ->
	  ( (), S# s1# ) }

      shoveString :: Int# -> [Char] -> PrimIO Bool
      shoveString n ls = 
       case ls of
         [] ->   
460
	   if n ==# 0# then
461 462 463 464 465 466 467 468 469
	      returnPrimIO True
	   else
             _ccall_ writeFile arr fp (I# n) >>= \rc ->
             returnPrimIO (rc==0)

         ((C# x):xs) ->
	   write_char arr# n x	>>
	   
	   {- Flushing lines - should we bother? -}
470 471
	   if n ==# bufLen {- || (chopOnNewLine && (x `eqChar#` '\n'#)) -} then
	      _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \ rc ->
472 473 474 475 476
	      if rc == 0 then
		 shoveString 0# xs
	       else
		 return False
	    else
477
	       shoveString (n +# 1#) xs
478 479 480
     in
     shoveString 0# s

sof's avatar
sof committed
481
    writeChars :: ForeignObj -> String -> PrimIO Bool
482 483 484 485 486 487 488
    writeChars fp "" = returnPrimIO True
    writeChars fp (c:cs) =
	_ccall_ filePutc fp (ord c) >>= \ rc ->
        if rc == 0 then
	    writeChars fp cs
	else
	    returnPrimIO False
489
\end{code}
490

491 492 493
Computation $hPrint hdl t$ writes the string representation of {\em t}
given by the $shows$ function to the file or channel managed by {\em
hdl}.
494

sof's avatar
sof committed
495 496
SOF 2/97: Seem to have disappeared in 1.4 libs.

497
\begin{code}
498 499
--hPrint :: Show a => Handle -> a -> IO ()
hPrint hdl = hPutStr hdl . show
500
\end{code}
sof's avatar
sof committed
501 502 503 504 505 506 507 508 509 510 511

Derived action @hPutStrLn hdl str@ writes the string \tr{str} to
the handle \tr{hdl}, adding a newline at the end.

\begin{code}
--hPutStrLn :: Handle -> String -> IO ()
hPutStrLn hndl str = do
 hPutStr  hndl str
 hPutChar hndl '\n'

\end{code}