ghc/interpreter/lib/IO.hs

   1
   2 -----------------------------------------------------------------------------
   3 -- Standard Library: IO operations, beyond those included in the prelude
   4 --
   5 -- WARNING: The names and semantics of functions defined in this module
   6 -- may change as the details of the IO standard are clarified.
   7 --
   8 -- WARNING: extremely kludgey, incomplete and just plain wrong.
   9 -----------------------------------------------------------------------------
  10
  11 module IO (
  12 --  Handle, HandlePosn,
  13     Handle,
  14 --  IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
  15     IOMode(ReadMode,WriteMode,AppendMode),
  16     BufferMode(NoBuffering,LineBuffering,BlockBuffering),
  17     SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
  18     stdin, stdout, stderr,
  19     openFile, hClose,
  20 --  hFileSize, hIsEOF, isEOF,
  21 --  hSetBuffering, hGetBuffering, hFlush,
  22     hFlush,
  23     hGetPosn, hSetPosn,
  24 --  hSeek, hIsSeekable,
  25 --  hReady, hGetChar, hLookAhead, hGetContents,
  26     hGetChar, hGetLine, hGetContents,
  27     hPutChar, hPutStr, hPutStrLn, hPrint,
  28     hIsOpen, hIsClosed, hIsReadable, hIsWritable,
  29     isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
  30     isFullError, isEOFError,
  31     isIllegalOperation, isPermissionError, isUserError,
  32     ioeGetErrorString, ioeGetHandle, ioeGetFileName,
  33     try, bracket, bracket_,
  34
  35     -- ... and what the Prelude exports
  36     IO,
  37     FilePath, IOError, ioError, userError, catch,
  38     putChar, putStr, putStrLn, print,
  39     getChar, getLine, getContents, interact,
  40     readFile, writeFile, appendFile, readIO, readLn
  41     ) where
  42
  43 import Ix(Ix)
  44
  45 unimp :: String -> a
  46 unimp s = error ("function not implemented: " ++ s)
  47
  48 type FILE_STAR = Int
  49 type Ptr       = Int
  50 nULL = 0 :: Int
  51
  52 data Handle
  53    = Handle { name     :: FilePath,
  54               file     :: FILE_STAR,    -- C handle
  55               state    :: HState,       -- open/closed/semiclosed
  56               mode     :: IOMode,
  57               --seekable :: Bool,
  58               bmode    :: BufferMode,
  59               buff     :: Ptr,
  60               buffSize :: Int
  61             }
  62
  63 instance Eq Handle where
  64    h1 == h2   = file h1 == file h2
  65
  66 instance Show Handle where
  67    showsPrec _ h = showString ("<<handle " ++ name h ++ "=" ++ show (file h) ++ ">>")
  68
  69 data HandlePosn
  70    = HandlePosn
  71      deriving (Eq, Show)
  72
  73
  74 data IOMode      = ReadMode | WriteMode | AppendMode
  75                     deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
  76
  77 data BufferMode  =  NoBuffering | LineBuffering
  78                  |  BlockBuffering
  79                     deriving (Eq, Ord, Read, Show)
  80
  81 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
  82                     deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
  83
  84 data HState = HOpen | HSemiClosed | HClosed
  85               deriving Eq
  86
  87 stdin  = Handle "stdin"  (primRunST nh_stdin)  HOpen ReadMode  NoBuffering   nULL 0
  88 stdout = Handle "stdout" (primRunST nh_stdout) HOpen WriteMode LineBuffering nULL 0
  89 stderr = Handle "stderr" (primRunST nh_stderr) HOpen WriteMode NoBuffering   nULL 0
  90
  91 openFile :: FilePath -> IOMode -> IO Handle
  92 openFile f mode
  93    = copy_String_to_cstring f >>= \nameptr ->
  94      nh_open nameptr (mode2num mode) >>= \fh ->
  95      nh_free nameptr >>
  96      if   fh == nULL
  97      then (ioError.IOError) ("openFile: can't open " ++ f ++ " in " ++ show mode)
  98      else return (Handle f fh HOpen mode BlockBuffering nULL 0)
  99      where
 100         mode2num :: IOMode -> Int
 101         mode2num ReadMode   = 0
 102         mode2num WriteMode  = 1
 103         mode2num AppendMode = 2
 104
 105 hClose :: Handle -> IO ()
 106 hClose h
 107    | not (state h == HOpen)
 108    = (ioError.IOError) ("hClose on non-open handle " ++ show h)
 109    | otherwise
 110    = nh_close (file h) >>
 111      nh_errno >>= \err ->
 112      if   err == 0
 113      then return ()
 114      else (ioError.IOError) ("hClose: error closing " ++ name h)
 115
 116 hFileSize             :: Handle -> IO Integer
 117 hFileSize              = unimp "IO.hFileSize"
 118 hIsEOF                :: Handle -> IO Bool
 119 hIsEOF                 = unimp "IO.hIsEOF"
 120 isEOF                 :: IO Bool
 121 isEOF                  = hIsEOF stdin
 122
 123 hSetBuffering         :: Handle  -> BufferMode -> IO ()
 124 hSetBuffering          = unimp "IO.hSetBuffering"
 125 hGetBuffering         :: Handle  -> IO BufferMode
 126 hGetBuffering          = unimp "IO.hGetBuffering"
 127
 128 hFlush :: Handle -> IO ()
 129 hFlush h
 130    = if   state h /= HOpen
 131      then (ioError.IOError) ("hFlush on closed/semiclosed file " ++ name h)
 132      else nh_flush (file h)
 133
 134 hGetPosn              :: Handle -> IO HandlePosn
 135 hGetPosn               = unimp "IO.hGetPosn"
 136 hSetPosn              :: HandlePosn -> IO ()
 137 hSetPosn               = unimp "IO.hSetPosn"
 138 hSeek                 :: Handle -> SeekMode -> Integer -> IO ()
 139 hSeek                  = unimp "IO.hSeek"
 140 hWaitForInput         :: Handle -> Int -> IO Bool
 141 hWaitForInput          = unimp "hWaitForInput"
 142 hReady                :: Handle -> IO Bool
 143 hReady h               = hWaitForInput h 0
 144
 145 hGetChar    :: Handle -> IO Char
 146 hGetChar h
 147    = nh_read (file h) >>= \ci ->
 148      return (primIntToChar ci)
 149
 150 hGetLine              :: Handle -> IO String
 151 hGetLine h             = do c <- hGetChar h
 152                             if c=='\n' then return ""
 153                               else do cs <- hGetLine h
 154                                       return (c:cs)
 155
 156 hLookAhead            :: Handle -> IO Char
 157 hLookAhead             = unimp "IO.hLookAhead"
 158
 159 hGetContents :: Handle -> IO String
 160 hGetContents h
 161    | not (state h == HOpen && mode h == ReadMode)
 162    = (ioError.IOError) ("hGetContents on invalid handle " ++ show h)
 163    | otherwise
 164    = read_all (file h)
 165      where
 166         read_all f
 167            = unsafeInterleaveIO (
 168              nh_read f >>= \ci ->
 169              if   ci == -1
 170              then hClose h >> return []
 171              else read_all f >>= \rest ->
 172                   return ((primIntToChar ci):rest)
 173              )
 174
 175 hPutStr :: Handle -> String -> IO ()
 176 hPutStr h s
 177    | not (state h == HOpen && mode h /= ReadMode)
 178    = (ioError.IOError) ("hPutStr on invalid handle " ++ show h)
 179    | otherwise
 180    = write_all (file h) s
 181      where
 182         write_all f []
 183            = return ()
 184         write_all f (c:cs)
 185            = nh_write f (primCharToInt c) >>
 186              write_all f cs
 187
 188 hPutChar              :: Handle -> Char -> IO ()
 189 hPutChar h c           = hPutStr h [c]
 190
 191 hPutStrLn             :: Handle -> String -> IO ()
 192 hPutStrLn h s          = do { hPutStr h s; hPutChar h '\n' }
 193
 194 hPrint                :: Show a => Handle -> a -> IO ()
 195 hPrint h               = hPutStrLn h . show
 196
 197 hIsOpen, hIsClosed, hIsReadable, hIsWritable :: Handle -> IO Bool
 198 hIsOpen h              = return (state h == HOpen)
 199 hIsClosed h            = return (state h == HClosed)
 200 hIsReadable h          = return (mode h == ReadMode)
 201 hIsWritable h          = return (mode h == WriteMode)
 202
 203 hIsSeekable           :: Handle -> IO Bool
 204 hIsSeekable            = unimp "IO.hIsSeekable"
 205
 206 isIllegalOperation,
 207           isAlreadyExistsError,
 208           isDoesNotExistError,
 209           isAlreadyInUseError,
 210           isFullError,
 211           isEOFError,
 212           isPermissionError,
 213           isUserError        :: IOError -> Bool
 214
 215 isIllegalOperation    = unimp "IO.isIllegalOperation"
 216 isAlreadyExistsError  = unimp "IO.isAlreadyExistsError"
 217 isDoesNotExistError   = unimp "IO.isDoesNotExistError"
 218 isAlreadyInUseError   = unimp "IO.isAlreadyInUseError"
 219 isFullError           = unimp "IO.isFullError"
 220 isEOFError            = unimp "IO.isEOFError"
 221 isPermissionError     = unimp "IO.isPermissionError"
 222 isUserError           = unimp "IO.isUserError"
 223
 224
 225 ioeGetErrorString :: IOError -> String
 226 ioeGetErrorString = unimp "ioeGetErrorString"
 227 ioeGetHandle      :: IOError -> Maybe Handle
 228 ioeGetHandle      = unimp "ioeGetHandle"
 229 ioeGetFileName    :: IOError -> Maybe FilePath
 230 ioeGetFileName    = unimp "ioeGetFileName"
 231
 232 try       :: IO a -> IO (Either IOError a)
 233 try p      = catch (p >>= (return . Right)) (return . Left)
 234
 235 bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 236 bracket before after m = do
 237         x  <- before
 238         rs <- try (m x)
 239         after x
 240         case rs of
 241            Right r -> return r
 242            Left  e -> ioError e
 243
 244 -- variant of the above where middle computation doesn't want x
 245 bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
 246 bracket_ before after m = do
 247          x  <- before
 248          rs <- try m
 249          after x
 250          case rs of
 251             Right r -> return r
 252             Left  e -> ioError e
 253
 254 -----------------------------------------------------------------------------
 255