ghc/lib/ghc/IOBase.lhs

   1 %
   2 % (c) The AQUA Project, Glasgow University, 1994-1996
   3 %
   4
   5 \section[IOBase]{Module @IOBase@}
   6
   7 Definitions for the @IO@ monad and its friends.  Everything is exported
   8 concretely; the @IO@ module itself exports abstractly.
   9
  10 \begin{code}
  11 {-# OPTIONS -fno-implicit-prelude #-}
  12 #include "error.h"
  13
  14 module IOBase where
  15
  16 import STBase
  17 import PrelTup
  18 import Foreign
  19 import PackedString     ( unpackCString )
  20 import PrelBase
  21 import PrelRead
  22 import GHC
  23 import ArrBase  ( ByteArray(..), MutableVar(..) )
  24
  25 infixr 1 `thenIO_Prim`, `seqIO_Prim`
  26 \end{code}
  27
  28 %*********************************************************
  29 %*                                                      *
  30 \subsection{The @IO@ monad}
  31 %*                                                      *
  32 %*********************************************************
  33
  34 \begin{code}
  35 newtype IO a = IO (PrimIO (Either IOError a))
  36
  37 instance  Functor IO where
  38    map f x = x >>= (return . f)
  39
  40 instance  Monad IO  where
  41     {-# INLINE return #-}
  42     {-# INLINE (>>)   #-}
  43     {-# INLINE (>>=)  #-}
  44     m >> k      =  m >>= \ _ -> k
  45     return x    = IO $ ST $ \ s@(S# _) -> (Right x, s)
  46
  47     (IO (ST m)) >>= k =
  48         IO (ST ( \ s ->
  49         let  (r, new_s) = m s  in
  50         case r of
  51           Left err -> (Left err, new_s)
  52           Right  x -> case (k x) of { IO (ST k2) ->
  53                         k2 new_s }))
  54
  55 fixIO :: (a -> IO a) -> IO a
  56     -- not required but worth having around
  57
  58 fixIO k = IO $ ST $ \ s ->
  59     let
  60         (IO (ST k_loop)) = k loop
  61         result           = k_loop s
  62         (Right loop, _)  = result
  63     in
  64     result
  65
  66 fail            :: IOError -> IO a
  67 fail err        =  IO $ ST $ \ s -> (Left err, s)
  68
  69 userError       :: String  -> IOError
  70 userError str   =  IOError Nothing UserError str
  71
  72 catch           :: IO a    -> (IOError -> IO a) -> IO a
  73 catch (IO (ST m)) k  = IO $ ST $ \ s ->
  74   case (m s) of { (r, new_s) ->
  75   case r of
  76     Right  _ -> (r, new_s)
  77     Left err -> case (k err) of { IO (ST k_err) ->
  78                 (k_err new_s) }}
  79
  80 instance  Show (IO a)  where
  81     showsPrec p f  = showString "<<IO action>>"
  82     showList       = showList__ (showsPrec 0)
  83 \end{code}
  84
  85 %*********************************************************
  86 %*                                                      *
  87 \subsection{Coercions to @ST@ and @PrimIO@}
  88 %*                                                      *
  89 %*********************************************************
  90
  91 \begin{code}
  92 stToIO     :: ST RealWorld a -> IO a
  93 primIOToIO :: PrimIO a       -> IO a
  94 ioToST     :: IO a -> ST RealWorld a
  95 ioToPrimIO :: IO a -> PrimIO       a
  96
  97 primIOToIO = stToIO -- for backwards compatibility
  98 ioToPrimIO = ioToST
  99
 100 stToIO (ST m) = IO $ ST $ \ s ->
 101     case (m s) of { (r, new_s) ->
 102     (Right r, new_s) }
 103
 104 ioToST (IO (ST io)) = ST $ \ s ->
 105     case (io s) of { (r, new_s) ->
 106     case r of
 107       Right a -> (a, new_s)
 108       Left  e -> error ("I/O Error (ioToST): " ++ showsPrec 0 e "\n")
 109     }
 110 \end{code}
 111
 112 @thenIO_Prim@ is a useful little number for doing _ccall_s in IO-land:
 113
 114 \begin{code}
 115 thenIO_Prim :: PrimIO a -> (a -> IO b) -> IO b
 116 seqIO_Prim  :: PrimIO a -> IO b -> IO b
 117 {-# INLINE thenIO_Prim   #-}
 118 {-# INLINE seqIO_Prim   #-}
 119
 120 thenIO_Prim (ST m) k = IO $ ST $ \ s ->
 121     case (m s)     of { (m_res, new_s)    ->
 122     case (k m_res) of { (IO (ST k_m_res)) ->
 123     k_m_res new_s }}
 124
 125 seqIO_Prim m k = thenIO_Prim m (\ _ -> k)
 126 \end{code}
 127
 128
 129 %*********************************************************
 130 %*                                                      *
 131 \subsection{Error/trace-ish functions}
 132 %*                                                      *
 133 %*********************************************************
 134
 135 \begin{code}
 136 errorIO :: PrimIO () -> a
 137
 138 errorIO (ST io)
 139   = case (errorIO# io) of
 140       _ -> bottom
 141   where
 142     bottom = bottom -- Never evaluated
 143
 144 -- error stops execution and displays an error message
 145 error :: String -> a
 146 error s = error__ ( \ x -> _ccall_ ErrorHdrHook x ) s
 147
 148 error__ :: (Addr{-FILE *-} -> PrimIO ()) -> String -> a
 149
 150 error__ msg_hdr s
 151 #ifdef __PARALLEL_HASKELL__
 152   = errorIO (msg_hdr sTDERR{-msg hdr-}  >>
 153              _ccall_ fflush sTDERR      >>
 154              fputs sTDERR s             >>
 155              _ccall_ fflush sTDERR      >>
 156              _ccall_ stg_exit (1::Int)
 157             )
 158 #else
 159   = errorIO (msg_hdr sTDERR{-msg hdr-}  >>
 160              _ccall_ fflush sTDERR      >>
 161              fputs sTDERR s             >>
 162              _ccall_ fflush sTDERR      >>
 163              _ccall_ getErrorHandler    >>= \ errorHandler ->
 164              if errorHandler == (-1::Int) then
 165                 _ccall_ stg_exit (1::Int)
 166              else
 167                 _casm_ ``%r = (StgStablePtr)(%0);'' errorHandler
 168                                                 >>= \ osptr ->
 169                 _ccall_ decrementErrorCount     >>= \ () ->
 170                 deRefStablePtr osptr            >>= \ oact ->
 171                 oact
 172             )
 173 #endif {- !parallel -}
 174   where
 175     sTDERR = (``stderr'' :: Addr)
 176 \end{code}
 177
 178 \begin{code}
 179 {-# GENERATE_SPECS _trace a #-}
 180 trace :: String -> a -> a
 181
 182 trace string expr
 183   = unsafePerformPrimIO (
 184         ((_ccall_ PreTraceHook sTDERR{-msg-}):: PrimIO ())  >>
 185         fputs sTDERR string                                 >>
 186         ((_ccall_ PostTraceHook sTDERR{-msg-}):: PrimIO ()) >>
 187         returnPrimIO expr )
 188   where
 189     sTDERR = (``stderr'' :: Addr)
 190 \end{code}
 191
 192
 193 %*********************************************************
 194 %*                                                      *
 195 \subsection{Utility functions}
 196 %*                                                      *
 197 %*********************************************************
 198
 199 I'm not sure why this little function is here...
 200
 201 \begin{code}
 202 fputs :: Addr{-FILE*-} -> String -> PrimIO Bool
 203
 204 fputs stream [] = return True
 205
 206 fputs stream (c : cs)
 207   = _ccall_ stg_putc c stream >> -- stg_putc expands to putc
 208     fputs stream cs              -- (just does some casting stream)
 209 \end{code}
 210
 211
 212 %*********************************************************
 213 %*                                                      *
 214 \subsection{Type @IOError@}
 215 %*                                                      *
 216 %*********************************************************
 217
 218 A value @IOError@ encode errors occurred in the @IO@ monad.
 219 An @IOError@ records a more specific error type, a descriptive
 220 string and maybe the handle that was used when the error was
 221 flagged.
 222
 223 \begin{code}
 224 data IOError
 225  = IOError
 226      (Maybe Handle)  -- the handle used by the action flagging the
 227                      -- the error.
 228      IOErrorType     -- what it was.
 229      String          -- error type specific information.
 230
 231
 232 data IOErrorType
 233   = AlreadyExists        | HardwareFault
 234   | IllegalOperation     | InappropriateType
 235   | Interrupted          | InvalidArgument
 236   | NoSuchThing          | OtherError
 237   | PermissionDenied     | ProtocolError
 238   | ResourceBusy         | ResourceExhausted
 239   | ResourceVanished     | SystemError
 240   | TimeExpired          | UnsatisfiedConstraints
 241   | UnsupportedOperation | UserError
 242   | EOF
 243   deriving (Eq, Show)
 244
 245 \end{code}
 246
 247 Predicates on IOError; little effort made on these so far...
 248
 249 \begin{code}
 250
 251 isAlreadyExistsError (IOError _ AlreadyExists _) = True
 252 isAlreadyExistsError _                           = False
 253
 254 isAlreadyInUseError (IOError _ ResourceBusy _) = True
 255 isAlreadyInUseError _                          = False
 256
 257 isFullError (IOError _ ResourceExhausted _) = True
 258 isFullError _                               = False
 259
 260 isEOFError (IOError _ EOF _) = True
 261 isEOFError _                 = True
 262
 263 isIllegalOperation (IOError _ IllegalOperation _) = True
 264 isIllegalOperation _                              = False
 265
 266 isPermissionError (IOError _ PermissionDenied _) = True
 267 isPermissionError _                              = False
 268
 269 isDoesNotExistError (IOError _ NoSuchThing _) = True
 270 isDoesNotExistError _                         = False
 271
 272 isUserError (IOError _ UserError s) = Just s
 273 isUserError _                       = Nothing
 274 \end{code}
 275
 276 Showing @IOError@s
 277
 278 \begin{code}
 279 instance Show IOError where
 280     showsPrec p (IOError _ UserError s) rs =
 281       showString s rs
 282     showsPrec p (IOError _ EOF _) rs =
 283       showsPrec p EOF rs
 284     showsPrec p (IOError _ iot s) rs =
 285       showsPrec p
 286                 iot
 287                 (case s of {
 288                   "" -> rs;
 289                   _ -> showString ": " $
 290                        showString s rs})
 291
 292 \end{code}
 293
 294 The @String@ part of an @IOError@ is platform-dependent.  However, to
 295 provide a uniform mechanism for distinguishing among errors within
 296 these broad categories, each platform-specific standard shall specify
 297 the exact strings to be used for particular errors.  For errors not
 298 explicitly mentioned in the standard, any descriptive string may be
 299 used.
 300
 301 \begin{change}
 302 SOF & 4/96 & added argument to indicate function that flagged error
 303 \end{change}
 304 % Hmm..does these envs work?!...SOF
 305
 306 \begin{code}
 307 constructErrorAndFail :: String -> IO a
 308 constructErrorAndFail call_site
 309   = stToIO (constructError call_site) >>= \ io_error ->
 310     fail io_error
 311
 312 \end{code}
 313
 314 This doesn't seem to be documented/spelled out anywhere,
 315 so here goes: (SOF)
 316
 317 The implementation of the IO prelude uses various C stubs
 318 to do the actual interaction with the OS. The bandwidth
 319 \tr{C<->Haskell} is somewhat limited, so the general strategy
 320 for flaggging any errors (apart from possibly using the
 321 return code of the external call), is to set the @ghc_errtype@
 322 to a value that is one of the \tr{#define}s in @includes/error.h@.
 323 @ghc_errstr@ holds a character string providing error-specific
 324 information.
 325
 326 \begin{code}
 327 constructError        :: String -> PrimIO IOError
 328 constructError call_site =
 329  _casm_ ``%r = ghc_errtype;''    >>= \ (I# errtype#) ->
 330  _casm_ ``%r = ghc_errstr;''        >>= \ str ->
 331  let
 332   iot =
 333    case errtype# of
 334      ERR_ALREADYEXISTS#          -> AlreadyExists
 335      ERR_HARDWAREFAULT#          -> HardwareFault
 336      ERR_ILLEGALOPERATION#       -> IllegalOperation
 337      ERR_INAPPROPRIATETYPE#      -> InappropriateType
 338      ERR_INTERRUPTED#            -> Interrupted
 339      ERR_INVALIDARGUMENT#        -> InvalidArgument
 340      ERR_NOSUCHTHING#            -> NoSuchThing
 341      ERR_OTHERERROR#             -> OtherError
 342      ERR_PERMISSIONDENIED#       -> PermissionDenied
 343      ERR_PROTOCOLERROR#          -> ProtocolError
 344      ERR_RESOURCEBUSY#           -> ResourceBusy
 345      ERR_RESOURCEEXHAUSTED#      -> ResourceExhausted
 346      ERR_RESOURCEVANISHED#       -> ResourceVanished
 347      ERR_SYSTEMERROR#            -> SystemError
 348      ERR_TIMEEXPIRED#            -> TimeExpired
 349      ERR_UNSATISFIEDCONSTRAINTS# -> UnsatisfiedConstraints
 350      ERR_UNSUPPORTEDOPERATION#   -> UnsupportedOperation
 351      ERR_EOF#                    -> EOF
 352      _                           -> OtherError
 353
 354   msg =
 355    case iot of
 356      EOF -> ""
 357      OtherError -> "bad error construct"
 358      _   -> call_site ++ ':' : ' ' : unpackCString str
 359  in
 360  return (IOError Nothing iot msg)
 361 \end{code}
 362
 363 %*********************************************************
 364 %*                                                      *
 365 \subsection{Types @Handle@, @Handle__@}
 366 %*                                                      *
 367 %*********************************************************
 368
 369 The type for @Handle@ is defined rather than in @IOHandle@
 370 module, as the @IOError@ type uses it..all operations over
 371 a handles reside in @IOHandle@.
 372
 373 \begin{code}
 374
 375 {-
 376  Sigh, the MVar ops in ConcBase depend on IO, the IO
 377  representation here depend on MVars for handles (when
 378  compiling a concurrent way). Break the cycle by having
 379  the definition of MVars go here:
 380
 381 -}
 382 data MVar a = MVar (SynchVar# RealWorld a)
 383
 384 #if defined(__CONCURRENT_HASKELL__)
 385 type Handle = MVar Handle__
 386 #else
 387 type Handle = MutableVar RealWorld Handle__
 388 #endif
 389
 390 data Handle__
 391   = ErrorHandle         IOError
 392   | ClosedHandle
 393 #ifndef PAR
 394   | SemiClosedHandle    ForeignObj (Addr, Int)
 395   | ReadHandle          ForeignObj (Maybe BufferMode) Bool
 396   | WriteHandle         ForeignObj (Maybe BufferMode) Bool
 397   | AppendHandle        ForeignObj (Maybe BufferMode) Bool
 398   | ReadWriteHandle     ForeignObj (Maybe BufferMode) Bool
 399 #else
 400   | SemiClosedHandle    Addr (Addr, Int)
 401   | ReadHandle          Addr (Maybe BufferMode) Bool
 402   | WriteHandle         Addr (Maybe BufferMode) Bool
 403   | AppendHandle        Addr (Maybe BufferMode) Bool
 404   | ReadWriteHandle     Addr (Maybe BufferMode) Bool
 405 #endif
 406
 407 -- Standard Instances as defined by the Report..
 408 -- instance Eq Handle   (defined in IO)
 409 -- instance Show Handle    ""
 410
 411 \end{code}
 412
 413 %*********************************************************
 414 %*                                                      *
 415 \subsection[BufferMode]{Buffering modes}
 416 %*                                                      *
 417 %*********************************************************
 418
 419 Three kinds of buffering are supported: line-buffering,
 420 block-buffering or no-buffering.  These modes have the following
 421 effects. For output, items are written out from the internal
 422 buffer according to the buffer mode:
 423
 424 \begin{itemize}
 425 \item[line-buffering]  the entire output buffer is written
 426 out whenever a newline is output, the output buffer overflows,
 427 a flush is issued, or the handle is closed.
 428
 429 \item[block-buffering] the entire output buffer is written out whenever
 430 it overflows, a flush is issued, or the handle
 431 is closed.
 432
 433 \item[no-buffering] output is written immediately, and never stored
 434 in the output buffer.
 435 \end{itemize}
 436
 437 The output buffer is emptied as soon as it has been written out.
 438
 439 Similarly, input occurs according to the buffer mode for handle {\em hdl}.
 440 \begin{itemize}
 441 \item[line-buffering] when the input buffer for {\em hdl} is not empty,
 442 the next item is obtained from the buffer;
 443 otherwise, when the input buffer is empty,
 444 characters up to and including the next newline
 445 character are read into the buffer.  No characters
 446 are available until the newline character is
 447 available.
 448 \item[block-buffering] when the input buffer for {\em hdl} becomes empty,
 449 the next block of data is read into this buffer.
 450 \item[no-buffering] the next input item is read and returned.
 451 \end{itemize}
 452 For most implementations, physical files will normally be block-buffered
 453 and terminals will normally be line-buffered.
 454
 455 \begin{code}
 456 data BufferMode
 457  = NoBuffering | LineBuffering | BlockBuffering (Maybe Int)
 458    deriving (Eq, Ord, Read, Show)
 459 \end{code}