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