ghc/lib/required/IO.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[IO]{Module @IO@}
   6
   7 \begin{code}
   8 {-# OPTIONS -fno-implicit-prelude #-}
   9
  10 module IO (
  11     Handle, HandlePosn,
  12
  13     IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
  14     BufferMode(NoBuffering,LineBuffering,BlockBuffering),
  15     SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
  16
  17     stdin, stdout, stderr,
  18     openFile, hClose, hFileSize, hIsEOF, isEOF,
  19     hSetBuffering, hGetBuffering, hFlush, hGetPosn, hSetPosn, hSeek,
  20     hIsOpen, hIsClosed, hIsReadable, hIsWritable, hIsSeekable, hReady,
  21     hGetChar, hLookAhead, hGetContents, hPutChar, hPutStr, hPrint,
  22
  23     isAlreadyExistsError, isAlreadyInUseError, isFullError, isEOFError,
  24     isIllegalOperation, isPermissionError, isUserError,
  25     ioeGetHandle, ioeGetFileName
  26   ) where
  27
  28 import Ix
  29 import STBase
  30 import IOBase
  31 import ArrBase          ( MutableByteArray(..), newCharArray )
  32 import IOHandle         -- much of the real stuff is in here
  33 import PackedString     ( nilPS, packCBytesST, unpackPS )
  34 import PrelBase
  35 import GHC
  36 \end{code}
  37
  38 %*********************************************************
  39 %*                                                      *
  40 \subsection{Signatures}
  41 %*                                                      *
  42 %*********************************************************
  43
  44 \begin{code}
  45 --IOHandle:hClose                :: Handle -> IO ()
  46 --IOHandle:hFileSize             :: Handle -> IO Integer
  47 --IOHandle:hFlush                :: Handle -> IO ()
  48 --IOHandle:hGetBuffering         :: Handle -> IO BufferMode
  49 hGetChar              :: Handle -> IO Char
  50 hGetContents          :: Handle -> IO String
  51 --IOHandle:hGetPosn              :: Handle -> IO HandlePosn
  52 --IOHandle:hIsClosed             :: Handle -> IO Bool
  53 --IOHandle:hIsEOF                :: Handle -> IO Bool
  54 --IOHandle:hIsOpen               :: Handle -> IO Bool
  55 --IOHandle:hIsReadable           :: Handle -> IO Bool
  56 --IOHandle:hIsSeekable           :: Handle -> IO Bool
  57 --IOHandle:hIsWritable           :: Handle -> IO Bool
  58 hLookAhead            :: Handle -> IO Char
  59 hPrint                :: Show a => Handle -> a -> IO ()
  60 hPutChar              :: Handle -> Char -> IO ()
  61 hPutStr               :: Handle -> String -> IO ()
  62 hReady                :: Handle -> IO Bool
  63 --IOHandle:hSeek                 :: Handle -> SeekMode -> Integer -> IO ()
  64 --IOHandle:hSetBuffering         :: Handle -> BufferMode -> IO ()
  65 --IOHandle:hSetPosn              :: HandlePosn -> IO ()
  66 -- ioeGetFileName        :: IOError -> Maybe FilePath
  67 -- ioeGetHandle          :: IOError -> Maybe Handle
  68 -- isAlreadyExistsError  :: IOError -> Bool
  69 -- isAlreadyInUseError   :: IOError -> Bool
  70 --IOHandle:isEOF                 :: IO Bool
  71 -- isEOFError            :: IOError -> Bool
  72 -- isFullError           :: IOError -> Bool
  73 -- isIllegalOperation    :: IOError -> Bool
  74 -- isPermissionError     :: IOError -> Bool
  75 -- isUserError           :: IOError -> Maybe String
  76 --IOHandle:openFile              :: FilePath -> IOMode -> IO Handle
  77 --IOHandle:stdin, stdout, stderr :: Handle
  78 \end{code}
  79
  80 %*********************************************************
  81 %*                                                      *
  82 \subsection{Simple input operations}
  83 %*                                                      *
  84 %*********************************************************
  85
  86 Computation $hReady hdl$ indicates whether at least
  87 one item is available for input from handle {\em hdl}.
  88
  89 \begin{code}
  90 --hReady :: Handle -> IO Bool
  91 hReady handle =
  92     readHandle handle                               >>= \ htype ->
  93     case htype of
  94       ErrorHandle ioError ->
  95           writeHandle handle htype                  >>
  96           fail ioError
  97       ClosedHandle ->
  98           writeHandle handle htype                  >>
  99           fail (IllegalOperation "handle is closed")
 100       SemiClosedHandle _ _ ->
 101           writeHandle handle htype                  >>
 102           fail (IllegalOperation "handle is closed")
 103       AppendHandle _ _ _ ->
 104           writeHandle handle htype                  >>
 105           fail (IllegalOperation "handle is not open for reading")
 106       WriteHandle _ _ _ ->
 107           writeHandle handle htype                  >>
 108           fail (IllegalOperation "handle is not open for reading")
 109       other ->
 110           _ccall_ inputReady (filePtr other)        `thenIO_Prim` \ rc ->
 111           writeHandle handle (markHandle htype)   >>
 112           case rc of
 113             0 -> return False
 114             1 -> return True
 115             _ -> constructErrorAndFail "hReady"
 116 \end{code}
 117
 118 Computation $hGetChar hdl$ reads the next character from handle
 119 {\em hdl}, blocking until a character is available.
 120
 121 \begin{code}
 122 --hGetChar :: Handle -> IO Char
 123
 124 hGetChar handle =
 125     readHandle handle                               >>= \ htype ->
 126     case htype of
 127       ErrorHandle ioError ->
 128           writeHandle handle htype                  >>
 129           fail ioError
 130       ClosedHandle ->
 131           writeHandle handle htype                  >>
 132           fail (IllegalOperation "handle is closed")
 133       SemiClosedHandle _ _ ->
 134           writeHandle handle htype                  >>
 135           fail (IllegalOperation "handle is closed")
 136       AppendHandle _ _ _ ->
 137           writeHandle handle htype                  >>
 138           fail (IllegalOperation "handle is not open for reading")
 139       WriteHandle _ _ _ ->
 140           writeHandle handle htype                  >>
 141           fail (IllegalOperation "handle is not open for reading")
 142       other ->
 143           _ccall_ fileGetc (filePtr other)          `thenIO_Prim` \ intc ->
 144           writeHandle handle (markHandle htype)   >>
 145           if intc /= ``EOF'' then
 146               return (chr intc)
 147           else
 148               constructErrorAndFail "hGetChar"
 149 \end{code}
 150
 151 Computation $hLookahead hdl$ returns the next character from handle
 152 {\em hdl} without removing it from the input buffer, blocking until a
 153 character is available.
 154
 155 \begin{code}
 156 --hLookAhead :: Handle -> IO Char
 157
 158 hLookAhead handle =
 159     readHandle handle                               >>= \ htype ->
 160     case htype of
 161       ErrorHandle ioError ->
 162           writeHandle handle htype                  >>
 163           fail ioError
 164       ClosedHandle ->
 165           writeHandle handle htype                  >>
 166           fail (IllegalOperation "handle is closed")
 167       SemiClosedHandle _ _ ->
 168           writeHandle handle htype                  >>
 169           fail (IllegalOperation "handle is closed")
 170       AppendHandle _ _ _ ->
 171           writeHandle handle htype                  >>
 172           fail (IllegalOperation "handle is not open for reading")
 173       WriteHandle _ _ _ ->
 174           writeHandle handle htype                  >>
 175           fail (IllegalOperation "handle is not open for reading")
 176       other ->
 177           _ccall_ fileLookAhead (filePtr other)    `thenIO_Prim` \ intc ->
 178           writeHandle handle (markHandle htype)   >>
 179           if intc /= ``EOF'' then
 180               return (chr intc)
 181           else
 182               constructErrorAndFail "hLookAhead"
 183 \end{code}
 184
 185
 186 %*********************************************************
 187 %*                                                      *
 188 \subsection{Getting the entire contents of a handle}
 189 %*                                                      *
 190 %*********************************************************
 191
 192 Computation $hGetContents hdl$ returns the list of characters
 193 corresponding to the unread portion of the channel or file managed by
 194 {\em hdl}, which is made semi-closed.
 195
 196 \begin{code}
 197 --hGetContents :: Handle -> IO String
 198
 199 hGetContents handle =
 200     readHandle handle                               >>= \ htype ->
 201     case htype of
 202       ErrorHandle ioError ->
 203           writeHandle handle htype                  >>
 204           fail ioError
 205       ClosedHandle ->
 206           writeHandle handle htype                  >>
 207           fail (IllegalOperation "handle is closed")
 208       SemiClosedHandle _ _ ->
 209           writeHandle handle htype                  >>
 210           fail (IllegalOperation "handle is closed")
 211       AppendHandle _ _ _ ->
 212           writeHandle handle htype                  >>
 213           fail (IllegalOperation "handle is not open for reading")
 214       WriteHandle _ _ _ ->
 215           writeHandle handle htype                  >>
 216           fail (IllegalOperation "handle is not open for reading")
 217       other ->
 218           {-
 219              To avoid introducing an extra layer of buffering here,
 220              we provide three lazy read methods, based on character,
 221              line, and block buffering.
 222           -}
 223           stToIO (getBufferMode other)  >>= \ other ->
 224           case (bufferMode other) of
 225             Just LineBuffering ->
 226                 allocBuf Nothing                    >>= \ buf_info ->
 227                 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
 228                                                     >>
 229                 unsafeInterleavePrimIO (lazyReadLine handle)
 230                                                     `thenIO_Prim` \ contents ->
 231                 return contents
 232
 233             Just (BlockBuffering size) ->
 234                 allocBuf size                       >>= \ buf_info ->
 235                 writeHandle handle (SemiClosedHandle (filePtr other) buf_info)
 236                                                     >>
 237                 unsafeInterleavePrimIO (lazyReadBlock handle)
 238                                                     `thenIO_Prim` \ contents ->
 239                 return contents
 240             _ -> -- Nothing is treated pessimistically as NoBuffering
 241                 writeHandle handle (SemiClosedHandle (filePtr other) (``NULL'', 0))
 242                                                     >>
 243                 unsafeInterleavePrimIO (lazyReadChar handle)
 244                                                     `thenIO_Prim` \ contents ->
 245                 return contents
 246   where
 247     allocBuf :: Maybe Int -> IO (Addr, Int)
 248     allocBuf msize =
 249         _ccall_ malloc size                         `thenIO_Prim` \ buf ->
 250         if buf /= ``NULL'' then
 251             return (buf, size)
 252         else
 253             fail (ResourceExhausted "not enough virtual memory")
 254       where
 255         size =
 256             case msize of
 257               Just x -> x
 258               Nothing -> ``BUFSIZ''
 259 \end{code}
 260
 261 Note that someone may yank our handle out from under us, and then re-use
 262 the same FILE * for something else.  Therefore, we have to re-examine the
 263 handle every time through.
 264
 265 \begin{code}
 266 lazyReadBlock :: Handle -> PrimIO String
 267 lazyReadLine  :: Handle -> PrimIO String
 268 lazyReadChar  :: Handle -> PrimIO String
 269
 270 lazyReadBlock handle =
 271     ioToST (readHandle handle)              >>= \ htype ->
 272     case htype of
 273       -- There cannae be an ErrorHandle here
 274       ClosedHandle ->
 275           ioToST (writeHandle handle htype)     >>
 276           returnPrimIO ""
 277       SemiClosedHandle fp (buf, size) ->
 278           _ccall_ readBlock buf fp size             >>= \ bytes ->
 279           (if bytes <= 0
 280           then return nilPS
 281           else packCBytesST bytes buf)              >>= \ some ->
 282           if bytes < 0 then
 283               ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0)))
 284                                                     >>
 285               _ccall_ free buf                      >>= \ () ->
 286               _ccall_ closeFile fp                  >>
 287               returnPrimIO (unpackPS some)
 288           else
 289               ioToST (writeHandle handle htype)     >>
 290               unsafeInterleavePrimIO (lazyReadBlock handle)
 291                                                     >>= \ more ->
 292               returnPrimIO (unpackPS some ++ more)
 293
 294 lazyReadLine handle =
 295     ioToST (readHandle handle) >>= \ htype ->
 296     case htype of
 297       -- There cannae be an ErrorHandle here
 298       ClosedHandle ->
 299           ioToST (writeHandle handle htype) >>
 300           returnPrimIO ""
 301       SemiClosedHandle fp (buf, size) ->
 302           _ccall_ readLine buf fp size              >>= \ bytes ->
 303           (if bytes <= 0
 304           then return nilPS
 305           else packCBytesST bytes buf)              >>= \ some ->
 306           if bytes < 0 then
 307               ioToST (writeHandle handle (SemiClosedHandle ``NULL'' (``NULL'', 0)))
 308                                                     >>
 309               _ccall_ free buf                      >>= \ () ->
 310               _ccall_ closeFile fp                  >>
 311               returnPrimIO (unpackPS some)
 312           else
 313               ioToST (writeHandle handle htype)     >>
 314               unsafeInterleavePrimIO (lazyReadLine handle)
 315                                                     >>= \ more ->
 316               returnPrimIO (unpackPS some ++ more)
 317
 318 lazyReadChar handle =
 319     ioToST (readHandle handle) >>= \ htype ->
 320     case htype of
 321       -- There cannae be an ErrorHandle here
 322       ClosedHandle ->
 323           ioToST (writeHandle handle htype)         >>
 324           returnPrimIO ""
 325       SemiClosedHandle fp buf_info ->
 326           _ccall_ readChar fp                       >>= \ char ->
 327           if char == ``EOF'' then
 328               ioToST (writeHandle handle (SemiClosedHandle ``NULL'' buf_info))
 329                                                     >>
 330               _ccall_ closeFile fp                  >>
 331               returnPrimIO ""
 332           else
 333               ioToST (writeHandle handle htype)     >>
 334               unsafeInterleavePrimIO (lazyReadChar handle)
 335                                                     >>= \ more ->
 336               returnPrimIO (chr char : more)
 337 \end{code}
 338
 339
 340 %*********************************************************
 341 %*                                                      *
 342 \subsection{Simple output functions}
 343 %*                                                      *
 344 %*********************************************************
 345
 346 Computation $hPutChar hdl c$ writes the character {\em c} to the file
 347 or channel managed by {\em hdl}.  Characters may be buffered if
 348 buffering is enabled for {\em hdl}.
 349
 350 \begin{code}
 351 --hPutChar :: Handle -> Char -> IO ()
 352
 353 hPutChar handle c =
 354     readHandle handle                               >>= \ htype ->
 355     case htype of
 356       ErrorHandle ioError ->
 357           writeHandle handle htype                  >>
 358           fail ioError
 359       ClosedHandle ->
 360           writeHandle handle htype                  >>
 361           fail (IllegalOperation "handle is closed")
 362       SemiClosedHandle _ _ ->
 363           writeHandle handle htype                  >>
 364           fail (IllegalOperation "handle is closed")
 365       ReadHandle _ _ _ ->
 366           writeHandle handle htype                  >>
 367           fail (IllegalOperation "handle is not open for writing")
 368       other ->
 369           _ccall_ filePutc (filePtr other) (ord c) `thenIO_Prim` \ rc ->
 370           writeHandle handle (markHandle htype)   >>
 371           if rc == 0 then
 372               return ()
 373           else
 374               constructErrorAndFail "hPutChar"
 375 \end{code}
 376
 377 Computation $hPutStr hdl s$ writes the string {\em s} to the file or
 378 channel managed by {\em hdl}.
 379
 380 \begin{code}
 381 --hPutStr :: Handle -> String -> IO ()
 382
 383 hPutStr handle str =
 384     readHandle handle                               >>= \ htype ->
 385     case htype of
 386       ErrorHandle ioError ->
 387           writeHandle handle htype                  >>
 388           fail ioError
 389       ClosedHandle ->
 390           writeHandle handle htype                  >>
 391           fail (IllegalOperation "handle is closed")
 392       SemiClosedHandle _ _ ->
 393           writeHandle handle htype                  >>
 394           fail (IllegalOperation "handle is closed")
 395       ReadHandle _ _ _ ->
 396           writeHandle handle htype                  >>
 397           fail (IllegalOperation "handle is not open for writing")
 398       other ->
 399           getBufferMode other                       `thenIO_Prim` \ other ->
 400           (case bufferMode other of
 401             Just LineBuffering ->
 402                 writeLines (filePtr other) str
 403             Just (BlockBuffering (Just size)) ->
 404                 writeBlocks (filePtr other) size str
 405             Just (BlockBuffering Nothing) ->
 406                 writeBlocks (filePtr other) ``BUFSIZ'' str
 407             _ -> -- Nothing is treated pessimistically as NoBuffering
 408                 writeChars (filePtr other) str
 409           )                                         `thenIO_Prim` \ success ->
 410           writeHandle handle (markHandle other) >>
 411           if success then
 412               return ()
 413           else
 414               constructErrorAndFail "hPutStr"
 415   where
 416     writeLines :: Addr -> String -> PrimIO Bool
 417     writeLines = writeChunks ``BUFSIZ'' True
 418
 419     writeBlocks :: Addr -> Int -> String -> PrimIO Bool
 420     writeBlocks fp size s = writeChunks size False fp s
 421
 422     {-
 423       The breaking up of output into lines along \n boundaries
 424       works fine as long as there are newlines to split by.
 425       Avoid the splitting up into lines alltogether (doesn't work
 426       for overly long lines like the stuff that showsPrec instances
 427       normally return). Instead, we split them up into fixed size
 428       chunks before blasting them off to the Real World.
 429
 430       Hacked to avoid multiple passes over the strings - unsightly, but
 431       a whole lot quicker. -- SOF 3/96
 432     -}
 433
 434     writeChunks :: Int -> Bool -> Addr -> String -> PrimIO Bool
 435
 436     writeChunks (I# bufLen) chopOnNewLine fp s =
 437      newCharArray (0,I# bufLen) >>= \ arr@(MutableByteArray _ arr#) ->
 438      let
 439       write_char :: MutableByteArray# RealWorld -> Int# -> Char# -> PrimIO ()
 440       write_char arr# n x = ST $ \ (S# s#) ->
 441           case (writeCharArray# arr# n x s#) of { s1# ->
 442           ( (), S# s1# ) }
 443
 444       shoveString :: Int# -> [Char] -> PrimIO Bool
 445       shoveString n ls =
 446        case ls of
 447          [] ->
 448            if n ==# 0# then
 449               returnPrimIO True
 450            else
 451              _ccall_ writeFile arr fp (I# n) >>= \rc ->
 452              returnPrimIO (rc==0)
 453
 454          ((C# x):xs) ->
 455            write_char arr# n x  >>
 456
 457            {- Flushing lines - should we bother? -}
 458            if n ==# bufLen {- || (chopOnNewLine && (x `eqChar#` '\n'#)) -} then
 459               _ccall_ writeFile arr fp (I# (n +# 1#)) >>= \ rc ->
 460               if rc == 0 then
 461                  shoveString 0# xs
 462                else
 463                  return False
 464             else
 465                shoveString (n +# 1#) xs
 466      in
 467      shoveString 0# s
 468
 469     writeChars :: Addr -> String -> PrimIO Bool
 470     writeChars fp "" = returnPrimIO True
 471     writeChars fp (c:cs) =
 472         _ccall_ filePutc fp (ord c) >>= \ rc ->
 473         if rc == 0 then
 474             writeChars fp cs
 475         else
 476             returnPrimIO False
 477 \end{code}
 478
 479 Computation $hPrint hdl t$ writes the string representation of {\em t}
 480 given by the $shows$ function to the file or channel managed by {\em
 481 hdl}.
 482
 483 \begin{code}
 484 --hPrint :: Show a => Handle -> a -> IO ()
 485 hPrint hdl = hPutStr hdl . show
 486 \end{code}