[project @ 2002-02-04 09:05:45 by chak]

[ghc-hetmet.git] / ghc / lib / std / PrelMarshalError.lhs

diff --git a/ghc/lib/std/PrelMarshalError.lhs b/ghc/lib/std/PrelMarshalError.lhs
index 583610f..313ec85 100644 (file)
--- a/ghc/lib/std/PrelMarshalError.lhs
+++ b/ghc/lib/std/PrelMarshalError.lhs
@@ -1,7 +1,7 @@
 % -----------------------------------------------------------------------------
-% $Id: PrelMarshalError.lhs,v 1.2 2001/05/18 16:54:05 simonmar Exp $
+% $Id: PrelMarshalError.lhs,v 1.3 2002/02/04 09:05:46 chak Exp $
 %
-% (c) The FFI task force, 2000
+% (c) The FFI task force, [2000..2002]
 %
 
 Marshalling support: Handling of common error conditions
@@ -11,6 +11,35 @@ Marshalling support: Handling of common error conditions
 
 module PrelMarshalError (
 
+  -- I/O errors
+  -- ----------
+
+  IOErrorType,            -- abstract data type
+
+  mkIOError,             -- :: IOErrorType 
+                         -- -> String 
+                         -- -> Maybe FilePath 
+                         -- -> Maybe Handle
+                         -- -> IOError
+  
+  alreadyExistsErrorType, -- :: IOErrorType 
+  doesNotExistErrorType,  -- :: IOErrorType 
+  alreadyInUseErrorType,  -- :: IOErrorType 
+  fullErrorType,         -- :: IOErrorType 
+  eofErrorType,                  -- :: IOErrorType 
+  illegalOperationType,   -- :: IOErrorType 
+  permissionErrorType,    -- :: IOErrorType 
+  userErrorType,         -- :: IOErrorType 
+
+  annotateIOError,       -- :: IOError 
+                         -- -> String 
+                         -- -> Maybe FilePath 
+                         -- -> Maybe Handle 
+                         -- -> IOError 
+
+  -- Result value checks
+  -- -------------------
+
   -- throw an exception on specific return values
   --
   throwIf,       -- :: (a -> Bool) -> (a -> String) -> IO a       -> IO a
@@ -28,11 +57,57 @@ module PrelMarshalError (
 
 import PrelPtr
 import PrelIOBase
+import PrelMaybe
 import PrelNum
 import PrelBase
 
--- exported functions
--- ------------------
+
+-- I/O errors
+-- ----------
+
+-- construct an IO error
+--
+mkIOError :: IOErrorType -> String -> Maybe FilePath -> Maybe Handle -> IOError
+mkIOError errTy loc path hdl =
+  IOException $ IOError hdl errTy loc "" path
+
+-- pre-defined error types corresponding to the predicates in the standard
+-- library `IO'
+--
+alreadyExistsErrorType, doesNotExistErrorType, alreadyInUseErrorType,
+  fullErrorType, eofErrorType, illegalOperationType, permissionErrorType, 
+  userErrorType :: IOErrorType 
+alreadyExistsErrorType = AlreadyExists
+doesNotExistErrorType  = NoSuchThing
+alreadyInUseErrorType  = ResourceBusy
+fullErrorType         = ResourceExhausted
+eofErrorType          = EOF
+illegalOperationType   = IllegalOperation
+permissionErrorType    = PermissionDenied
+userErrorType         = OtherError
+
+-- add location information and possibly a path and handle to an existing I/O
+-- error 
+--
+-- * if no file path or handle is given, the corresponding value that's in the
+--   error is left unaltered
+--
+annotateIOError :: IOError 
+               -> String 
+               -> Maybe FilePath 
+               -> Maybe Handle 
+               -> IOError 
+annotateIOError (IOException (IOError hdl errTy _ str path)) loc opath ohdl = 
+  IOException (IOError (hdl `mplus` ohdl) errTy loc str (path `mplus` opath))
+  where
+    Nothing `mplus` ys = ys
+    xs      `mplus` _  = xs
+annotateIOError exc                                         _   _     _    = 
+  exc
+
+
+-- Result value checks
+-- -------------------
 
 -- guard an IO operation and throw an exception if the result meets the given
 -- predicate