[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit 2245b560c0d79a9489ebd429ff99c3be2b08110e
Author: John Goerzen <jgoerzen at complete.org>
Date:   Mon Dec 20 23:15:03 2004 +0100

    Checkpointing (compiles)
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-94)

diff --git a/ChangeLog b/ChangeLog
index e2363b4..0527104 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-20 16:15:03 GMT	John Goerzen <jgoerzen at complete.org>	patch-94
+
+    Summary:
+      Checkpointing (compiles)
+    Revision:
+      missingh--head--0.7--patch-94
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS.hs
+
+
 2004-12-20 15:59:04 GMT	John Goerzen <jgoerzen at complete.org>	patch-93
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS.hs b/libsrc/MissingH/IO/HVFS.hs
index db2f53d..033722d 100644
--- a/libsrc/MissingH/IO/HVFS.hs
+++ b/libsrc/MissingH/IO/HVFS.hs
@@ -73,13 +73,25 @@ class HVFSStat a where
 
 {- | The main HVFS class.
 
-A default implementation of 'vGetModificationTime' is provided (in terms
-of 'vGetFileStatus').  A standard implementation of 'vRaiseError' is also
-provided.
+Default implementations of these functions are provided:
+
+ * 'vGetModificationTime' -- implemented in terms of 'vGetFileStatus'
+
+ * 'vRaiseError'
+
+ * 'vDoesFileExist' -- implemented in terms of 'vGetFileStatus'
+
+ * 'vDoesDirectoryExist' -- implemented in terms of 'vGetFileStatus'
+
+ * 'vGetSymbolicLinkStatus' -- set to call 'vGetFileStatus'.
 
 Default implementations of all other functions
 will generate an isIllegalOperation error, since they are assumed to be
-un-implemented. -}
+un-implemented.
+
+You should always provide at least a 'vGetFileStatus' call, and almost
+certainly several of the others.
+ -}
 class HVFS a where
     vGetCurrentDirectory :: a -> IO FilePath
     vSetCurrentDirectory :: a -> FilePath -> IO ()
@@ -95,15 +107,38 @@ class HVFS a where
     vGetSymbolicLinkStatus :: a -> FilePath -> IO HVFSStatEncap
     vGetModificationTime :: a -> FilePath -> IO ClockTime
     vRaiseError :: a -> IOErrorType -> String -> Maybe FilePath -> IO c
+
     vGetModificationTime fs fp = 
-        do s <- (vGetFileStatus fs fp)
+        do s <- vGetFileStatus fs fp
            case s of
                   HVFSStatEncap x -> return $ 
                                       TOD (fromIntegral (vModificationTime x)) 0
     vRaiseError _ et desc mfp =
         ioError $ mkIOError et desc Nothing mfp
 
-    --vGetCurrentDirectory fs = vRaiseError fs 
+    vGetCurrentDirectory fs = eh fs "vGetCurrentDirectory"
+    vSetCurrentDirectory fs _ = eh fs "vSetCurrentDirectory"
+    vGetDirectoryContents fs _ = eh fs "vGetDirectoryContents"
+    vDoesFileExist fs fp = 
+        catch (do s <- vGetFileStatus fs fp
+                  case s of
+                     HVFSStatEncap x -> return $ vIsRegularFile x
+              ) (\_ -> return False)
+    vDoesDirectoryExist fs fp = 
+        catch (do s <- vGetFileStatus fs fp
+                  case s of
+                     HVFSStatEncap x -> return $ vIsDirectory x
+              ) (\_ -> return False)
+    vCreateDirectory fs _ = eh fs "vCreateDirectory"
+    vRemoveDirectory fs _ = eh fs "vRemoveDirectory"
+    vRemoveFile fs _ = eh fs "vRemoveFile"
+    vRenameFile fs _ _ = eh fs "vRenameFile"
+    vGetSymbolicLinkStatus = vGetFileStatus
+
+-- | Error handler helper
+eh :: HVFS a => a -> String -> IO c
+eh fs desc = vRaiseError fs illegalOperationErrorType 
+             (desc ++ " is not implemented in this HVFS class") Nothing
 
 class (HVFS a, HVIOGeneric c) => HVFSOpenable a b c where
     vOpen :: a -> FilePath -> IO c

-- 
haskell-testpack