ghc/lib/std/IO.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: IO.lhs,v 1.40 2000/06/30 13:39:35 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[IO]{Module @IO@}
   8
   9 Implementation of the standard Haskell IO interface, see
  10 @http://haskell.org/onlinelibrary/io.html@ for the official
  11 definition.
  12
  13 \begin{code}
  14 module IO (
  15     Handle,             -- abstract, instance of: Eq, Show.
  16     HandlePosn(..),     -- abstract, instance of: Eq, Show.
  17
  18     IOMode(ReadMode,WriteMode,AppendMode,ReadWriteMode),
  19     BufferMode(NoBuffering,LineBuffering,BlockBuffering),
  20     SeekMode(AbsoluteSeek,RelativeSeek,SeekFromEnd),
  21
  22     stdin, stdout, stderr,   -- :: Handle
  23
  24     openFile,                  -- :: FilePath -> IOMode -> IO Handle
  25     hClose,                    -- :: Handle -> IO ()
  26     hFileSize,                 -- :: Handle -> IO Integer
  27     hIsEOF,                    -- :: Handle -> IO Bool
  28     isEOF,                     -- :: IO Bool
  29
  30     hSetBuffering,             -- :: Handle -> BufferMode -> IO ()
  31     hGetBuffering,             -- :: Handle -> IO BufferMode
  32     hFlush,                    -- :: Handle -> IO ()
  33     hGetPosn,                  -- :: Handle -> IO HandlePosn
  34     hSetPosn,                  -- :: Handle -> HandlePosn -> IO ()
  35     hSeek,                     -- :: Handle -> SeekMode -> Integer -> IO ()
  36     hWaitForInput,             -- :: Handle -> Int -> IO Bool
  37     hReady,                    -- :: Handle -> IO Bool
  38     hGetChar,                  -- :: Handle -> IO Char
  39     hGetLine,                  -- :: Handle -> IO [Char]
  40     hLookAhead,                -- :: Handle -> IO Char
  41     hGetContents,              -- :: Handle -> IO [Char]
  42     hPutChar,                  -- :: Handle -> Char -> IO ()
  43     hPutStr,                   -- :: Handle -> [Char] -> IO ()
  44     hPutStrLn,                 -- :: Handle -> [Char] -> IO ()
  45     hPrint,                    -- :: Show a => Handle -> a -> IO ()
  46     hIsOpen, hIsClosed,        -- :: Handle -> IO Bool
  47     hIsReadable, hIsWritable,  -- :: Handle -> IO Bool
  48     hIsSeekable,               -- :: Handle -> IO Bool
  49
  50     isAlreadyExistsError, isDoesNotExistError,  -- :: IOError -> Bool
  51     isAlreadyInUseError, isFullError,
  52     isEOFError, isIllegalOperation,
  53     isPermissionError, isUserError,
  54
  55     ioeGetErrorString,         -- :: IOError -> String
  56     ioeGetHandle,              -- :: IOError -> Maybe Handle
  57     ioeGetFileName,            -- :: IOError -> Maybe FilePath
  58
  59     try,                       -- :: IO a -> IO (Either IOError a)
  60     bracket,                   -- :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
  61     bracket_,                  -- :: IO a -> (a -> IO b) -> IO c -> IO c
  62
  63     -- Non-standard extension (but will hopefully become standard with 1.5) is
  64     -- to export the Prelude io functions via IO (in addition to exporting them
  65     -- from the prelude...for now.)
  66     IO,
  67     FilePath,                  -- :: String
  68     IOError,
  69     ioError,                   -- :: IOError -> IO a
  70     userError,                 -- :: String  -> IOError
  71     catch,                     -- :: IO a    -> (IOError -> IO a) -> IO a
  72     interact,                  -- :: (String -> String) -> IO ()
  73
  74     putChar,                   -- :: Char   -> IO ()
  75     putStr,                    -- :: String -> IO ()
  76     putStrLn,                  -- :: String -> IO ()
  77     print,                     -- :: Show a => a -> IO ()
  78     getChar,                   -- :: IO Char
  79     getLine,                   -- :: IO String
  80     getContents,               -- :: IO String
  81     readFile,                  -- :: FilePath -> IO String
  82     writeFile,                 -- :: FilePath -> String -> IO ()
  83     appendFile,                -- :: FilePath -> String -> IO ()
  84     readIO,                    -- :: Read a => String -> IO a
  85     readLn,                    -- :: Read a => IO a
  86
  87   ) where
  88
  89 #ifndef __HUGS__
  90 import PrelIOBase       -- Together these four Prelude modules define
  91 import PrelHandle       -- all the stuff exported by IO for the GHC version
  92 import PrelIO
  93 import PrelException
  94
  95
  96 -- The entire rest of this module is just Hugs
  97
  98 #else /* ifndef __HUGS__ */
  99
 100 import Ix(Ix)
 101 import PrelPrim ( IORef
 102                 , unsafePerformIO
 103                 , prelCleanupAfterRunAction
 104                 , copy_String_to_cstring
 105                 , primIntToChar
 106                 , primWriteCharOffAddr
 107                 , nullAddr
 108                 , newIORef
 109                 , writeIORef
 110                 , readIORef
 111                 , nh_close
 112                 , nh_errno
 113                 , nh_stdin
 114                 , nh_stdout
 115                 , nh_stderr
 116                 , nh_flush
 117                 , nh_open
 118                 , nh_free
 119                 , nh_read
 120                 , nh_write
 121                 , nh_filesize
 122                 , nh_iseof
 123                 )
 124 \end{code}
 125
 126
 127 %*********************************************************
 128 %*                                                      *
 129 \subsection{The HUGS version of IO
 130 %*                                                      *
 131 %*********************************************************
 132
 133 \begin{code}
 134 import Ix(Ix)
 135 import Monad(when)
 136
 137 unimp :: String -> a
 138 unimp s = error ("IO library: function not implemented: " ++ s)
 139
 140 type FILE_STAR = Addr
 141 type Ptr       = Addr
 142 nULL           = nullAddr
 143
 144 data Handle
 145    = Handle { name     :: FilePath,
 146               file     :: FILE_STAR,         -- C handle
 147               mut      :: IORef Handle_Mut,  -- open/closed/semiclosed
 148               mode     :: IOMode,
 149               seekable :: Bool
 150             }
 151
 152 data Handle_Mut
 153    = Handle_Mut { state :: HState
 154                 }
 155      deriving Show
 156
 157 set_state :: Handle -> HState -> IO ()
 158 set_state hdl new_state
 159    = writeIORef (mut hdl) (Handle_Mut { state = new_state })
 160 get_state :: Handle -> IO HState
 161 get_state hdl
 162    = readIORef (mut hdl) >>= \m -> return (state m)
 163
 164 mkErr :: Handle -> String -> IO a
 165 mkErr h msg
 166    = do mut <- readIORef (mut h)
 167         when (state mut /= HClosed)
 168              (nh_close (file h) >> set_state h HClosed)
 169         dummy <- nh_errno
 170         ioError (IOError msg)
 171
 172 stdin
 173    = Handle {
 174         name = "stdin",
 175         file = unsafePerformIO nh_stdin,
 176         mut  = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
 177         mode = ReadMode
 178      }
 179
 180 stdout
 181    = Handle {
 182         name = "stdout",
 183         file = unsafePerformIO nh_stdout,
 184         mut  = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
 185         mode = WriteMode
 186      }
 187
 188 stderr
 189    = Handle {
 190         name = "stderr",
 191         file = unsafePerformIO nh_stderr,
 192         mut  = unsafePerformIO (newIORef (Handle_Mut { state = HOpen })),
 193         mode = WriteMode
 194      }
 195
 196
 197 instance Eq Handle where
 198    h1 == h2   = file h1 == file h2
 199
 200 instance Show Handle where
 201    showsPrec _ h = showString ("`" ++ name h ++ "'")
 202
 203 data HandlePosn
 204    = HandlePosn
 205      deriving (Eq, Show)
 206
 207
 208 data IOMode      = ReadMode | WriteMode | AppendMode | ReadWriteMode
 209                     deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
 210
 211 data BufferMode  =  NoBuffering | LineBuffering
 212                  |  BlockBuffering (Maybe Int)
 213                     deriving (Eq, Ord, Read, Show)
 214
 215 data SeekMode    =  AbsoluteSeek | RelativeSeek | SeekFromEnd
 216                     deriving (Eq, Ord, Ix, Bounded, Enum, Read, Show)
 217
 218 data HState = HOpen | HSemiClosed | HClosed
 219               deriving (Show, Eq)
 220
 221
 222 -- A global variable holding a list of all open handles.
 223 -- Each handle is present as many times as it has been opened.
 224 -- Any given file is allowed to have _either_ one writeable handle
 225 -- or many readable handles in this list.  The list is used to
 226 -- enforce single-writer multiple reader semantics.  It also
 227 -- provides a list of handles for System.exitWith to flush and
 228 -- close.  In order not to have to put all this stuff in the
 229 -- Prelude, System.exitWith merely runs prelExitWithAction,
 230 -- which is originally Nothing, but which we set to Just ...
 231 -- once handles appear in the list.
 232
 233 allHandles :: IORef [Handle]
 234 allHandles  = unsafePerformIO (newIORef [])
 235
 236 elemWriterHandles :: FilePath -> IO Bool
 237 elemAllHandles    :: FilePath -> IO Bool
 238 addHandle         :: Handle -> IO ()
 239 delHandle         :: Handle -> IO ()
 240 cleanupHandles    :: IO ()
 241
 242 cleanupHandles
 243    = do hdls <- readIORef allHandles
 244         mapM_ cleanupHandle hdls
 245      where
 246         cleanupHandle h
 247            | mode h == ReadMode
 248            = nh_close (file h)
 249              >> nh_errno >>= \_ -> return ()
 250            | otherwise
 251            = nh_flush (file h) >> nh_close (file h)
 252              >> nh_errno >>= \_ -> return ()
 253
 254 elemWriterHandles fname
 255    = do hdls <- readIORef allHandles
 256         let hdls_w = filter ((/= ReadMode).mode) hdls
 257         return (fname `elem` (map name hdls_w))
 258
 259 elemAllHandles fname
 260    = do hdls <- readIORef allHandles
 261         return (fname `elem` (map name hdls))
 262
 263 addHandle hdl
 264    = do cleanup_action <- readIORef prelCleanupAfterRunAction
 265         case cleanup_action of
 266            Nothing
 267               -> writeIORef prelCleanupAfterRunAction (Just cleanupHandles)
 268            Just xx
 269               -> return ()
 270         hdls <- readIORef allHandles
 271         writeIORef allHandles (hdl : hdls)
 272
 273 delHandle hdl
 274    = do hdls <- readIORef allHandles
 275         let hdls' = takeWhile (/= hdl) hdls
 276                     ++ drop 1 (dropWhile (/= hdl) hdls)
 277         writeIORef allHandles hdls'
 278
 279
 280
 281 openFile :: FilePath -> IOMode -> IO Handle
 282 openFile f mode
 283
 284    | null f
 285    =  (ioError.IOError) "openFile: empty file name"
 286
 287    | mode == ReadMode
 288    = do not_ok <- elemWriterHandles f
 289         if    not_ok
 290          then (ioError.IOError)
 291                  ("openFile: `" ++ f ++ "' in " ++ show mode
 292                   ++ ": is already open for writing")
 293          else openFile_main f mode
 294
 295    | mode /= ReadMode
 296    = do not_ok <- elemAllHandles f
 297         if    not_ok
 298          then (ioError.IOError)
 299                  ("openFile: `" ++ f ++ "' in " ++ show mode
 300                   ++ ": is already open for reading or writing")
 301          else openFile_main f mode
 302
 303    | otherwise
 304    = openFile_main f mode
 305
 306 openFile_main f mode
 307    = copy_String_to_cstring f >>= \nameptr ->
 308      nh_open nameptr (mode2num mode) >>= \fh ->
 309      nh_free nameptr >>
 310      if   fh == nULL
 311      then (ioError.IOError)
 312              ("openFile: can't open <<" ++ f ++ ">> in " ++ show mode)
 313      else do r   <- newIORef (Handle_Mut { state = HOpen })
 314              let hdl = Handle { name = f, file = fh,
 315                                 mut  = r, mode = mode }
 316              addHandle hdl
 317              return hdl
 318      where
 319         mode2num :: IOMode -> Int
 320         mode2num ReadMode   = 0
 321         mode2num WriteMode  = 1
 322         mode2num AppendMode = 2
 323         mode2num ReadWriteMode
 324            = error
 325                 ("openFile <<" ++ f ++ ">>: ReadWriteMode not supported")
 326
 327 hClose :: Handle -> IO ()
 328 hClose h
 329    = do mut <- readIORef (mut h)
 330         if    state mut == HClosed
 331          then mkErr h
 332                  ("hClose on closed handle " ++ show h)
 333          else
 334          do set_state h HClosed
 335             delHandle h
 336             nh_close (file h)
 337             err <- nh_errno
 338             if    err == 0
 339              then return ()
 340              else mkErr h
 341                      ("hClose: error closing " ++ name h)
 342
 343 hGetContents :: Handle -> IO String
 344 hGetContents h
 345    | mode h /= ReadMode
 346    = mkErr h ("hGetContents on non-ReadMode handle " ++ show h)
 347    | otherwise
 348    = do mut <- readIORef (mut h)
 349         if    state mut /= HOpen
 350          then mkErr h
 351                  ("hGetContents on closed/semiclosed handle " ++ show h)
 352          else
 353          do set_state h HSemiClosed
 354             read_all (file h)
 355             where
 356                read_all f
 357                   = nh_read f >>= \ci ->
 358                     if   ci == -1
 359                     then return []
 360                     else read_all f >>= \rest ->
 361                          return ((primIntToChar ci):rest)
 362
 363 hPutStr :: Handle -> String -> IO ()
 364 hPutStr h s
 365    | mode h == ReadMode
 366    = mkErr h ("hPutStr on ReadMode handle " ++ show h)
 367    | otherwise
 368    = do mut <- readIORef (mut h)
 369         if    state mut /= HOpen
 370          then mkErr h
 371                  ("hPutStr on closed/semiclosed handle " ++ show h)
 372          else write_all (file h) s
 373               where
 374                  write_all f []
 375                     = return ()
 376                  write_all f (c:cs)
 377                     = nh_write f c >> write_all f cs
 378
 379 hFileSize :: Handle -> IO Integer
 380 hFileSize h
 381    = do sz <- nh_filesize (file h)
 382         er <- nh_errno
 383         if    er == 0
 384          then return (fromIntegral sz)
 385          else mkErr h ("hFileSize on " ++ show h)
 386
 387 hIsEOF :: Handle -> IO Bool
 388 hIsEOF h
 389    = do iseof <- nh_iseof (file h)
 390         er    <- nh_errno
 391         if    er == 0
 392          then return (iseof /= 0)
 393          else mkErr h ("hIsEOF on " ++ show h)
 394
 395 isEOF :: IO Bool
 396 isEOF = hIsEOF stdin
 397
 398 hSetBuffering         :: Handle  -> BufferMode -> IO ()
 399 hSetBuffering          = unimp "IO.hSetBuffering"
 400 hGetBuffering         :: Handle  -> IO BufferMode
 401 hGetBuffering          = unimp "IO.hGetBuffering"
 402
 403 hFlush :: Handle -> IO ()
 404 hFlush h
 405    = do mut <- readIORef (mut h)
 406         if    state mut /= HOpen
 407          then mkErr h
 408                  ("hFlush on closed/semiclosed file " ++ name h)
 409          else nh_flush (file h)
 410
 411 hGetPosn              :: Handle -> IO HandlePosn
 412 hGetPosn               = unimp "IO.hGetPosn"
 413 hSetPosn              :: HandlePosn -> IO ()
 414 hSetPosn               = unimp "IO.hSetPosn"
 415 hSeek                 :: Handle -> SeekMode -> Integer -> IO ()
 416 hSeek                  = unimp "IO.hSeek"
 417 hWaitForInput         :: Handle -> Int -> IO Bool
 418 hWaitForInput          = unimp "hWaitForInput"
 419 hReady                :: Handle -> IO Bool
 420 hReady h               = unimp "hReady" -- hWaitForInput h 0
 421
 422 hGetChar    :: Handle -> IO Char
 423 hGetChar h
 424    = nh_read (file h) >>= \ci ->
 425      return (primIntToChar ci)
 426
 427 hGetLine              :: Handle -> IO String
 428 hGetLine h             = do c <- hGetChar h
 429                             if c=='\n' then return ""
 430                               else do cs <- hGetLine h
 431                                       return (c:cs)
 432
 433 hLookAhead            :: Handle -> IO Char
 434 hLookAhead             = unimp "IO.hLookAhead"
 435
 436
 437 hPutChar              :: Handle -> Char -> IO ()
 438 hPutChar h c           = hPutStr h [c]
 439
 440 hPutStrLn             :: Handle -> String -> IO ()
 441 hPutStrLn h s          = do { hPutStr h s; hPutChar h '\n' }
 442
 443 hPrint                :: Show a => Handle -> a -> IO ()
 444 hPrint h               = hPutStrLn h . show
 445
 446 hIsOpen, hIsClosed, hIsReadable, hIsWritable :: Handle -> IO Bool
 447 hIsOpen h              = do { s <- get_state h; return (s == HOpen) }
 448 hIsClosed h            = do { s <- get_state h; return (s == HClosed) }
 449 hIsReadable h          = return (mode h == ReadMode)
 450 hIsWritable h          = return (mode h `elem` [WriteMode, AppendMode])
 451
 452 hIsSeekable           :: Handle -> IO Bool
 453 hIsSeekable            = unimp "IO.hIsSeekable"
 454
 455 isIllegalOperation,
 456           isAlreadyExistsError,
 457           isDoesNotExistError,
 458           isAlreadyInUseError,
 459           isFullError,
 460           isEOFError,
 461           isPermissionError,
 462           isUserError        :: IOError -> Bool
 463
 464 isIllegalOperation    = unimp "IO.isIllegalOperation"
 465 isAlreadyExistsError  = unimp "IO.isAlreadyExistsError"
 466 isDoesNotExistError   = unimp "IO.isDoesNotExistError"
 467 isAlreadyInUseError   = unimp "IO.isAlreadyInUseError"
 468 isFullError           = unimp "IO.isFullError"
 469 isEOFError            = unimp "IO.isEOFError"
 470 isPermissionError     = unimp "IO.isPermissionError"
 471 isUserError           = unimp "IO.isUserError"
 472
 473
 474 ioeGetErrorString :: IOError -> String
 475 ioeGetErrorString = unimp "IO.ioeGetErrorString"
 476 ioeGetHandle      :: IOError -> Maybe Handle
 477 ioeGetHandle      = unimp "IO.ioeGetHandle"
 478 ioeGetFileName    :: IOError -> Maybe FilePath
 479 ioeGetFileName    = unimp "IO.ioeGetFileName"
 480
 481 try       :: IO a -> IO (Either IOError a)
 482 try p      = catch (p >>= (return . Right)) (return . Left)
 483
 484 bracket        :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c
 485 bracket before after m = do
 486         x  <- before
 487         rs <- try (m x)
 488         after x
 489         case rs of
 490            Right r -> return r
 491            Left  e -> ioError e
 492
 493 -- variant of the above where middle computation doesn't want x
 494 bracket_        :: IO a -> (a -> IO b) -> IO c -> IO c
 495 bracket_ before after m = do
 496          x  <- before
 497          rs <- try m
 498          after x
 499          case rs of
 500             Right r -> return r
 501             Left  e -> ioError e
 502
 503 -- TODO: Hugs/slurpFile
 504 slurpFile = unimp "IO.slurpFile"
 505 \end{code}
 506
 507 #endif /* #ifndef __HUGS__ */