ghc/lib/required/IO.hs

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