System/IO/Error.hs

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  System.IO.Error
   6 -- Copyright   :  (c) The University of Glasgow 2001
   7 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   8 --
   9 -- Maintainer  :  libraries@haskell.org
  10 -- Stability   :  provisional
  11 -- Portability :  portable
  12 --
  13 -- Standard IO Errors.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module System.IO.Error (
  18     IOError,                    -- abstract
  19     IOErrorType,                -- abstract
  20
  21     catch,                      -- :: IO a -> (IOError -> IO a) -> IO a
  22     try,                        -- :: IO a -> IO (Either IOError a)
  23
  24     ioError,                    -- :: IOError -> IO a
  25     userError,                  -- :: String  -> IOError
  26
  27 #ifndef __NHC__
  28     mkIOError,                  -- :: IOErrorType -> String -> Maybe Handle
  29                                 --    -> Maybe FilePath -> IOError
  30
  31     annotateIOError,            -- :: IOError -> String -> Maybe Handle
  32                                 --    -> Maybe FilePath -> IOError
  33 #endif
  34
  35     alreadyExistsErrorType,     -- :: IOErrorType
  36     doesNotExistErrorType,
  37     alreadyInUseErrorType,
  38     fullErrorType,
  39     eofErrorType,
  40     illegalOperationErrorType,
  41     permissionErrorType,
  42     userErrorType,
  43
  44     isAlreadyExistsErrorType,   -- :: IOErrorType -> Bool
  45     isDoesNotExistErrorType,
  46     isAlreadyInUseErrorType,
  47     isFullErrorType,
  48     isEOFErrorType,
  49     isIllegalOperationErrorType,
  50     isPermissionErrorType,
  51     isUserErrorType,
  52
  53     isAlreadyExistsError,       -- :: IOError -> Bool
  54     isDoesNotExistError,
  55     isAlreadyInUseError,
  56     isFullError,
  57     isEOFError,
  58     isIllegalOperation,
  59     isPermissionError,
  60     isUserError,
  61
  62 #ifndef __NHC__
  63     ioeGetErrorType,            -- :: IOError -> IOErrorType
  64 #endif
  65     ioeGetErrorString,          -- :: IOError -> String
  66     ioeGetHandle,               -- :: IOError -> Maybe Handle
  67     ioeGetFileName,             -- :: IOError -> Maybe FilePath
  68
  69   ) where
  70
  71 import Data.Either
  72 import Data.Maybe
  73
  74 #ifdef __GLASGOW_HASKELL__
  75 import GHC.Base
  76 import GHC.IOBase
  77 import GHC.Exception
  78 import Text.Show
  79 #endif
  80
  81 #ifdef __HUGS__
  82 import Hugs.Prelude(Handle, IOException(..), IOErrorType(..))
  83 #endif
  84
  85 #ifdef __NHC__
  86 import IO
  87   ( IOError ()
  88   , try
  89   , ioError
  90   , userError
  91   , isAlreadyExistsError        -- :: IOError -> Bool
  92   , isDoesNotExistError
  93   , isAlreadyInUseError
  94   , isFullError
  95   , isEOFError
  96   , isIllegalOperation
  97   , isPermissionError
  98   , isUserError
  99   , ioeGetErrorString           -- :: IOError -> String
 100   , ioeGetHandle                -- :: IOError -> Maybe Handle
 101   , ioeGetFileName              -- :: IOError -> Maybe FilePath
 102   )
 103 --import Data.Maybe (fromJust)
 104 --import Control.Monad (MonadPlus(mplus))
 105 #endif
 106
 107 -- | The construct @try comp@ exposes IO errors which occur within a
 108 -- computation, and which are not fully handled.
 109 -- Other exceptions are not caught by this variant;
 110 -- to catch all exceptions, use @try@ from "Control.Exception".
 111
 112 #ifndef __NHC__
 113 try            :: IO a -> IO (Either IOError a)
 114 try f          =  catch (do r <- f
 115                             return (Right r))
 116                         (return . Left)
 117 #endif
 118
 119 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
 120 -- -----------------------------------------------------------------------------
 121 -- Constructing an IOError
 122
 123 mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError
 124 mkIOError t location maybe_hdl maybe_filename =
 125                IOError{ ioe_type = t,
 126                         ioe_location = location,
 127                         ioe_description = "",
 128                         ioe_handle = maybe_hdl,
 129                         ioe_filename = maybe_filename
 130                         }
 131 #ifdef __NHC__
 132 mkIOError EOF       location maybe_hdl maybe_filename =
 133     EOFError location (fromJust maybe_hdl)
 134 mkIOError UserError location maybe_hdl maybe_filename =
 135     UserError location ""
 136 mkIOError t         location maybe_hdl maybe_filename =
 137     NHC.FFI.mkIOError location maybe_filename maybe_handle (ioeTypeToInt t)
 138   where
 139     ioeTypeToInt AlreadyExists     = fromEnum EEXIST
 140     ioeTypeToInt NoSuchThing       = fromEnum ENOENT
 141     ioeTypeToInt ResourceBusy      = fromEnum EBUSY
 142     ioeTypeToInt ResourceExhausted = fromEnum ENOSPC
 143     ioeTypeToInt IllegalOperation  = fromEnum EPERM
 144     ioeTypeToInt PermissionDenied  = fromEnum EACCES
 145 #endif
 146 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
 147
 148 #ifndef __NHC__
 149 -- -----------------------------------------------------------------------------
 150 -- IOErrorType
 151
 152 isAlreadyExistsError, isDoesNotExistError, isAlreadyInUseError,
 153  isFullError, isEOFError, isIllegalOperation, isPermissionError,
 154  isUserError :: IOError -> Bool
 155
 156 isAlreadyExistsError = isAlreadyExistsErrorType    . ioeGetErrorType
 157 isDoesNotExistError  = isDoesNotExistErrorType     . ioeGetErrorType
 158 isAlreadyInUseError  = isAlreadyInUseErrorType     . ioeGetErrorType
 159 isFullError          = isFullErrorType             . ioeGetErrorType
 160 isEOFError           = isEOFErrorType              . ioeGetErrorType
 161 isIllegalOperation   = isIllegalOperationErrorType . ioeGetErrorType
 162 isPermissionError    = isPermissionErrorType       . ioeGetErrorType
 163 isUserError          = isUserErrorType             . ioeGetErrorType
 164 #endif /* __NHC__ */
 165
 166 -- -----------------------------------------------------------------------------
 167 -- IOErrorTypes
 168
 169 #ifdef __NHC__
 170 data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy
 171                  | ResourceExhausted | EOF | IllegalOperation
 172                  | PermissionDenied | UserError
 173 #endif
 174
 175 alreadyExistsErrorType, doesNotExistErrorType, alreadyInUseErrorType,
 176  fullErrorType, eofErrorType, illegalOperationErrorType,
 177  permissionErrorType, userErrorType :: IOErrorType
 178
 179 alreadyExistsErrorType    = AlreadyExists
 180 doesNotExistErrorType     = NoSuchThing
 181 alreadyInUseErrorType     = ResourceBusy
 182 fullErrorType             = ResourceExhausted
 183 eofErrorType              = EOF
 184 illegalOperationErrorType = IllegalOperation
 185 permissionErrorType       = PermissionDenied
 186 userErrorType             = UserError
 187
 188 -- -----------------------------------------------------------------------------
 189 -- IOErrorType predicates
 190
 191 isAlreadyExistsErrorType, isDoesNotExistErrorType, isAlreadyInUseErrorType,
 192   isFullErrorType, isEOFErrorType, isIllegalOperationErrorType,
 193   isPermissionErrorType, isUserErrorType :: IOErrorType -> Bool
 194
 195 isAlreadyExistsErrorType AlreadyExists = True
 196 isAlreadyExistsErrorType _ = False
 197
 198 isDoesNotExistErrorType NoSuchThing = True
 199 isDoesNotExistErrorType _ = False
 200
 201 isAlreadyInUseErrorType ResourceBusy = True
 202 isAlreadyInUseErrorType _ = False
 203
 204 isFullErrorType ResourceExhausted = True
 205 isFullErrorType _ = False
 206
 207 isEOFErrorType EOF = True
 208 isEOFErrorType _ = False
 209
 210 isIllegalOperationErrorType IllegalOperation = True
 211 isIllegalOperationErrorType _ = False
 212
 213 isPermissionErrorType PermissionDenied = True
 214 isPermissionErrorType _ = False
 215
 216 isUserErrorType UserError = True
 217 isUserErrorType _ = False
 218
 219 -- -----------------------------------------------------------------------------
 220 -- Miscellaneous
 221
 222 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
 223 ioeGetErrorType       :: IOError -> IOErrorType
 224 ioeGetHandle          :: IOError -> Maybe Handle
 225 ioeGetErrorString     :: IOError -> String
 226 ioeGetFileName        :: IOError -> Maybe FilePath
 227
 228 ioeGetErrorType ioe = ioe_type ioe
 229
 230 ioeGetHandle ioe = ioe_handle ioe
 231
 232 ioeGetErrorString ioe
 233    | isUserErrorType (ioe_type ioe) = ioe_description ioe
 234    | otherwise                      = show (ioe_type ioe)
 235
 236 ioeGetFileName ioe = ioe_filename ioe
 237
 238 -- -----------------------------------------------------------------------------
 239 -- annotating an IOError
 240
 241 annotateIOError :: IOError
 242               -> String
 243               -> Maybe Handle
 244               -> Maybe FilePath
 245               -> IOError
 246 annotateIOError (IOError hdl errTy _ str path) loc ohdl opath =
 247   IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath)
 248   where
 249     Nothing `mplus` ys = ys
 250     xs      `mplus` _  = xs
 251 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
 252
 253 #ifdef 0 /*__NHC__*/
 254 annotateIOError (IOError msg file hdl code) msg' file' hdl' =
 255     IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code
 256 annotateIOError (EOFError msg hdl) msg' file' hdl' =
 257     EOFError (msg++'\n':msg') (hdl`mplus`hdl')
 258 annotateIOError (UserError loc msg) msg' file' hdl' =
 259     UserError loc (msg++'\n':msg')
 260 annotateIOError (PatternError loc) msg' file' hdl' =
 261     PatternError (loc++'\n':msg')
 262 #endif