add GHC.HetMet.{hetmet_kappa,hetmet_kappa_app}
[ghc-base.git] / System / IO / Error.hs
index 95fde85..a026f33 100644 (file)
@@ -1,4 +1,4 @@
-{-# OPTIONS_GHC -fno-implicit-prelude #-}
+{-# LANGUAGE CPP, NoImplicitPrelude #-}
 
 -----------------------------------------------------------------------------
 -- |
 module System.IO.Error (
 
     -- * I\/O errors
-    IOError,                   -- = IOException
+    IOError,                    -- = IOException
 
-    userError,                 -- :: String  -> IOError
+    userError,                  -- :: String  -> IOError
 
-#ifndef __NHC__
-    mkIOError,                 -- :: IOErrorType -> String -> Maybe Handle
-                               --    -> Maybe FilePath -> IOError
+    mkIOError,                  -- :: IOErrorType -> String -> Maybe Handle
+                                --    -> Maybe FilePath -> IOError
 
-    annotateIOError,           -- :: IOError -> String -> Maybe Handle
-                               --    -> Maybe FilePath -> IOError
-#endif
+    annotateIOError,            -- :: IOError -> String -> Maybe Handle
+                                --    -> Maybe FilePath -> IOError
 
     -- ** Classifying I\/O errors
-    isAlreadyExistsError,      -- :: IOError -> Bool
+    isAlreadyExistsError,       -- :: IOError -> Bool
     isDoesNotExistError,
     isAlreadyInUseError,
     isFullError, 
@@ -40,24 +38,22 @@ module System.IO.Error (
     isUserError,
 
     -- ** Attributes of I\/O errors
-#ifndef __NHC__
-    ioeGetErrorType,           -- :: IOError -> IOErrorType
-#endif
-    ioeGetErrorString,         -- :: IOError -> String
-    ioeGetHandle,              -- :: IOError -> Maybe Handle
-    ioeGetFileName,            -- :: IOError -> Maybe FilePath
-
-#ifndef __NHC__
-    ioeSetErrorType,           -- :: IOError -> IOErrorType -> IOError
-    ioeSetErrorString,         -- :: IOError -> String -> IOError
-    ioeSetHandle,              -- :: IOError -> Handle -> IOError
-    ioeSetFileName,            -- :: IOError -> FilePath -> IOError
-#endif
+    ioeGetErrorType,            -- :: IOError -> IOErrorType
+    ioeGetLocation,             -- :: IOError -> String
+    ioeGetErrorString,          -- :: IOError -> String
+    ioeGetHandle,               -- :: IOError -> Maybe Handle
+    ioeGetFileName,             -- :: IOError -> Maybe FilePath
+
+    ioeSetErrorType,            -- :: IOError -> IOErrorType -> IOError
+    ioeSetErrorString,          -- :: IOError -> String -> IOError
+    ioeSetLocation,             -- :: IOError -> String -> IOError
+    ioeSetHandle,               -- :: IOError -> Handle -> IOError
+    ioeSetFileName,             -- :: IOError -> FilePath -> IOError
 
     -- * Types of I\/O error
-    IOErrorType,               -- abstract
+    IOErrorType,                -- abstract
 
-    alreadyExistsErrorType,    -- :: IOErrorType
+    alreadyExistsErrorType,     -- :: IOErrorType
     doesNotExistErrorType,
     alreadyInUseErrorType,
     fullErrorType,
@@ -67,7 +63,7 @@ module System.IO.Error (
     userErrorType,
 
     -- ** 'IOErrorType' predicates
-    isAlreadyExistsErrorType,  -- :: IOErrorType -> Bool
+    isAlreadyExistsErrorType,   -- :: IOErrorType -> Bool
     isDoesNotExistErrorType,
     isAlreadyInUseErrorType,
     isFullErrorType, 
@@ -78,37 +74,45 @@ module System.IO.Error (
 
     -- * Throwing and catching I\/O errors
 
-    ioError,                   -- :: IOError -> IO a
+    ioError,                    -- :: IOError -> IO a
 
-    catch,                     -- :: IO a -> (IOError -> IO a) -> IO a
-    try,                       -- :: IO a -> IO (Either IOError a)
+    catchIOError,               -- :: IO a -> (IOError -> IO a) -> IO a
+    catch,                      -- :: IO a -> (IOError -> IO a) -> IO a
+    tryIOError,                 -- :: IO a -> IO (Either IOError a)
+    try,                        -- :: IO a -> IO (Either IOError a)
 
-#ifndef __NHC__
-    modifyIOError,             -- :: (IOError -> IOError) -> IO a -> IO a
-#endif
+    modifyIOError,              -- :: (IOError -> IOError) -> IO a -> IO a
   ) where
 
+#ifndef __HUGS__
+import qualified Control.Exception.Base as New (catch)
+#endif
+
+#ifndef __HUGS__
 import Data.Either
+#endif
 import Data.Maybe
 
 #ifdef __GLASGOW_HASKELL__
 import GHC.Base
-import GHC.IOBase
-import GHC.Exception
+import GHC.IO
+import GHC.IO.Exception
+import GHC.IO.Handle.Types
 import Text.Show
 #endif
 
 #ifdef __HUGS__
-import Hugs.Prelude(Handle, IOException(..), IOErrorType(..))
+import Hugs.Prelude(Handle, IOException(..), IOErrorType(..), IO)
 #endif
 
 #ifdef __NHC__
 import IO
   ( IOError ()
+  , Handle ()
   , try
   , ioError
   , userError
-  , isAlreadyExistsError       -- :: IOError -> Bool
+  , isAlreadyExistsError        -- :: IOError -> Bool
   , isDoesNotExistError
   , isAlreadyInUseError
   , isFullError
@@ -120,17 +124,26 @@ import IO
   , ioeGetHandle                -- :: IOError -> Maybe Handle
   , ioeGetFileName              -- :: IOError -> Maybe FilePath
   )
---import Data.Maybe (fromJust)
---import Control.Monad (MonadPlus(mplus))
+import qualified NHC.Internal as NHC (IOError(..))
+import qualified NHC.DErrNo as NHC (ErrNo(..))
+import Data.Maybe (fromJust)
+import Control.Monad (MonadPlus(mplus))
 #endif
 
--- | The construct 'try' @comp@ exposes IO errors which occur within a
+-- | The construct 'tryIOError' @comp@ exposes IO errors which occur within a
 -- computation, and which are not fully handled.
 --
 -- Non-I\/O exceptions are not caught by this variant; to catch all
 -- exceptions, use 'Control.Exception.try' from "Control.Exception".
+tryIOError     :: IO a -> IO (Either IOError a)
+tryIOError f   =  catch (do r <- f
+                            return (Right r))
+                        (return . Left)
 
 #ifndef __NHC__
+{-# DEPRECATED try "Please use the new exceptions variant, Control.Exception.try" #-}
+-- | The 'try' function is deprecated. Please use the new exceptions
+-- variant, 'Control.Exception.try' from "Control.Exception", instead.
 try            :: IO a -> IO (Either IOError a)
 try f          =  catch (do r <- f
                             return (Right r))
@@ -148,27 +161,30 @@ try f          =  catch (do r <- f
 mkIOError :: IOErrorType -> String -> Maybe Handle -> Maybe FilePath -> IOError
 mkIOError t location maybe_hdl maybe_filename =
                IOError{ ioe_type = t, 
-                       ioe_location = location,
-                       ioe_description = "",
-                       ioe_handle = maybe_hdl, 
-                       ioe_filename = maybe_filename
-                       }
+                        ioe_location = location,
+                        ioe_description = "",
+#if defined(__GLASGOW_HASKELL__)
+                        ioe_errno = Nothing,
+#endif
+                        ioe_handle = maybe_hdl, 
+                        ioe_filename = maybe_filename
+                        }
+#endif /* __GLASGOW_HASKELL__ || __HUGS__ */
 #ifdef __NHC__
 mkIOError EOF       location maybe_hdl maybe_filename =
-    EOFError location (fromJust maybe_hdl)
+    NHC.EOFError location (fromJust maybe_hdl)
 mkIOError UserError location maybe_hdl maybe_filename =
-    UserError location ""
+    NHC.UserError location ""
 mkIOError t         location maybe_hdl maybe_filename =
-    NHC.FFI.mkIOError location maybe_filename maybe_handle (ioeTypeToInt t)
+    NHC.IOError location maybe_filename maybe_hdl (ioeTypeToErrNo t)
   where
-    ioeTypeToInt AlreadyExists     = fromEnum EEXIST
-    ioeTypeToInt NoSuchThing       = fromEnum ENOENT
-    ioeTypeToInt ResourceBusy      = fromEnum EBUSY
-    ioeTypeToInt ResourceExhausted = fromEnum ENOSPC
-    ioeTypeToInt IllegalOperation  = fromEnum EPERM
-    ioeTypeToInt PermissionDenied  = fromEnum EACCES
-#endif
-#endif /* __GLASGOW_HASKELL__ || __HUGS__ */
+    ioeTypeToErrNo AlreadyExists     = NHC.EEXIST
+    ioeTypeToErrNo NoSuchThing       = NHC.ENOENT
+    ioeTypeToErrNo ResourceBusy      = NHC.EBUSY
+    ioeTypeToErrNo ResourceExhausted = NHC.ENOSPC
+    ioeTypeToErrNo IllegalOperation  = NHC.EPERM
+    ioeTypeToErrNo PermissionDenied  = NHC.EACCES
+#endif /* __NHC__ */
 
 #ifndef __NHC__
 -- -----------------------------------------------------------------------------
@@ -226,8 +242,8 @@ isUserError          = isUserErrorType             . ioeGetErrorType
 
 #ifdef __NHC__
 data IOErrorType = AlreadyExists | NoSuchThing | ResourceBusy
-                | ResourceExhausted | EOF | IllegalOperation
-                | PermissionDenied | UserError
+                 | ResourceExhausted | EOF | IllegalOperation
+                 | PermissionDenied | UserError
 #endif
 
 -- | I\/O error where the operation failed because one of its arguments
@@ -264,8 +280,8 @@ permissionErrorType      :: IOErrorType
 permissionErrorType       = PermissionDenied
 
 -- | I\/O error that is programmer-defined.
-userErrorType           :: IOErrorType
-userErrorType            = UserError
+userErrorType            :: IOErrorType
+userErrorType             = UserError
 
 -- -----------------------------------------------------------------------------
 -- IOErrorType predicates
@@ -319,8 +335,9 @@ isUserErrorType _ = False
 -- Miscellaneous
 
 #if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
-ioeGetErrorType              :: IOError -> IOErrorType
+ioeGetErrorType       :: IOError -> IOErrorType
 ioeGetErrorString     :: IOError -> String
+ioeGetLocation        :: IOError -> String
 ioeGetHandle          :: IOError -> Maybe Handle
 ioeGetFileName        :: IOError -> Maybe FilePath
 
@@ -330,20 +347,65 @@ ioeGetErrorString ioe
    | isUserErrorType (ioe_type ioe) = ioe_description ioe
    | otherwise                      = show (ioe_type ioe)
 
+ioeGetLocation ioe = ioe_location ioe
+
 ioeGetHandle ioe = ioe_handle ioe
 
 ioeGetFileName ioe = ioe_filename ioe
 
-ioeSetErrorType                :: IOError -> IOErrorType -> IOError
-ioeSetErrorString      :: IOError -> String      -> IOError
-ioeSetHandle           :: IOError -> Handle      -> IOError
-ioeSetFileName         :: IOError -> FilePath    -> IOError
+ioeSetErrorType   :: IOError -> IOErrorType -> IOError
+ioeSetErrorString :: IOError -> String      -> IOError
+ioeSetLocation    :: IOError -> String      -> IOError
+ioeSetHandle      :: IOError -> Handle      -> IOError
+ioeSetFileName    :: IOError -> FilePath    -> IOError
 
 ioeSetErrorType   ioe errtype  = ioe{ ioe_type = errtype }
 ioeSetErrorString ioe str      = ioe{ ioe_description = str }
+ioeSetLocation    ioe str      = ioe{ ioe_location = str }
 ioeSetHandle      ioe hdl      = ioe{ ioe_handle = Just hdl }
 ioeSetFileName    ioe filename = ioe{ ioe_filename = Just filename }
 
+#elif defined(__NHC__)
+ioeGetErrorType       :: IOError -> IOErrorType
+ioeGetLocation        :: IOError -> String
+
+ioeGetErrorType e | isAlreadyExistsError e = AlreadyExists
+                  | isDoesNotExistError e  = NoSuchThing
+                  | isAlreadyInUseError e  = ResourceBusy
+                  | isFullError e          = ResourceExhausted
+                  | isEOFError e           = EOF
+                  | isIllegalOperation e   = IllegalOperation
+                  | isPermissionError e    = PermissionDenied
+                  | isUserError e          = UserError
+
+ioeGetLocation (NHC.IOError _ _ _ _)  = "unknown location"
+ioeGetLocation (NHC.EOFError _ _ )    = "unknown location"
+ioeGetLocation (NHC.PatternError loc) = loc
+ioeGetLocation (NHC.UserError loc _)  = loc
+
+ioeSetErrorType   :: IOError -> IOErrorType -> IOError
+ioeSetErrorString :: IOError -> String      -> IOError
+ioeSetLocation    :: IOError -> String      -> IOError
+ioeSetHandle      :: IOError -> Handle      -> IOError
+ioeSetFileName    :: IOError -> FilePath    -> IOError
+
+ioeSetErrorType e _ = e
+ioeSetErrorString   (NHC.IOError _ f h e) s = NHC.IOError s f h e
+ioeSetErrorString   (NHC.EOFError _ f)    s = NHC.EOFError s f
+ioeSetErrorString e@(NHC.PatternError _)  _ = e
+ioeSetErrorString   (NHC.UserError l _)   s = NHC.UserError l s
+ioeSetLocation e@(NHC.IOError _ _ _ _) _ = e
+ioeSetLocation e@(NHC.EOFError _ _)    _ = e
+ioeSetLocation   (NHC.PatternError _)  l = NHC.PatternError l
+ioeSetLocation   (NHC.UserError _ m)   l = NHC.UserError l m
+ioeSetHandle   (NHC.IOError o f _ e) h = NHC.IOError o f (Just h) e
+ioeSetHandle   (NHC.EOFError o _)    h = NHC.EOFError o h
+ioeSetHandle e@(NHC.PatternError _)  _ = e
+ioeSetHandle e@(NHC.UserError _ _)   _ = e
+ioeSetFileName (NHC.IOError o _ h e) f = NHC.IOError o (Just f) h e
+ioeSetFileName e _ = e
+#endif
+
 -- | Catch any 'IOError' that occurs in the computation and throw a
 -- modified version.
 modifyIOError :: (IOError -> IOError) -> IO a -> IO a
@@ -360,20 +422,55 @@ annotateIOError :: IOError
               -> Maybe Handle 
               -> Maybe FilePath 
               -> IOError 
-annotateIOError (IOError ohdl errTy _ str opath) loc hdl path = 
-  IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath)
+
+#if defined(__GLASGOW_HASKELL__) || defined(__HUGS__)
+annotateIOError ioe loc hdl path = 
+  ioe{ ioe_handle = hdl `mplus` ioe_handle ioe,
+       ioe_location = loc, ioe_filename = path `mplus` ioe_filename ioe }
   where
+    mplus :: Maybe a -> Maybe a -> Maybe a
     Nothing `mplus` ys = ys
     xs      `mplus` _  = xs
 #endif /* __GLASGOW_HASKELL__ || __HUGS__ */
 
-#if 0 /*__NHC__*/
-annotateIOError (IOError msg file hdl code) msg' file' hdl' =
-    IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code
-annotateIOError (EOFError msg hdl) msg' file' hdl' =
-    EOFError (msg++'\n':msg') (hdl`mplus`hdl')
-annotateIOError (UserError loc msg) msg' file' hdl' =
-    UserError loc (msg++'\n':msg')
-annotateIOError (PatternError loc) msg' file' hdl' =
-    PatternError (loc++'\n':msg')
+#if defined(__NHC__)
+annotateIOError (NHC.IOError msg file hdl code) msg' hdl' file' =
+    NHC.IOError (msg++'\n':msg') (file`mplus`file') (hdl`mplus`hdl') code
+annotateIOError (NHC.EOFError msg hdl) msg' _ _ =
+    NHC.EOFError (msg++'\n':msg') hdl
+annotateIOError (NHC.UserError loc msg) msg' _ _ =
+    NHC.UserError loc (msg++'\n':msg')
+annotateIOError (NHC.PatternError loc) msg' _ _ =
+    NHC.PatternError (loc++'\n':msg')
 #endif
+
+#ifndef __HUGS__
+-- | The 'catchIOError' function establishes a handler that receives any
+-- 'IOError' raised in the action protected by 'catchIOError'.
+-- An 'IOError' is caught by
+-- the most recent handler established by one of the exception handling
+-- functions.  These handlers are
+-- not selective: all 'IOError's are caught.  Exception propagation
+-- must be explicitly provided in a handler by re-raising any unwanted
+-- exceptions.  For example, in
+--
+-- > f = catchIOError g (\e -> if IO.isEOFError e then return [] else ioError e)
+--
+-- the function @f@ returns @[]@ when an end-of-file exception
+-- (cf. 'System.IO.Error.isEOFError') occurs in @g@; otherwise, the
+-- exception is propagated to the next outer handler.
+--
+-- When an exception propagates outside the main program, the Haskell
+-- system prints the associated 'IOError' value and exits the program.
+--
+-- Non-I\/O exceptions are not caught by this variant; to catch all
+-- exceptions, use 'Control.Exception.catch' from "Control.Exception".
+catchIOError :: IO a -> (IOError -> IO a) -> IO a
+catchIOError = New.catch
+
+{-# DEPRECATED catch "Please use the new exceptions variant, Control.Exception.catch" #-}
+-- | The 'catch' function is deprecated. Please use the new exceptions
+-- variant, 'Control.Exception.catch' from "Control.Exception", instead.
+catch :: IO a -> (IOError -> IO a) -> IO a
+catch = New.catch
+#endif /* !__HUGS__ */