[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 45115ff6dbb7fc5b4645a19a1161223de62790f7
Author: John Goerzen <jgoerzen at complete.org>
Date:   Mon Dec 20 22:17:47 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index 29512b6..d88fed1 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 15:17:47 GMT	John Goerzen <jgoerzen at complete.org>	patch-89
+
+    Summary:
+      Checkpointing again
+    Revision:
+      missingh--head--0.7--patch-89
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS.hs
+
+
 2004-12-20 15:03:58 GMT	John Goerzen <jgoerzen at complete.org>	patch-88
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS.hs b/libsrc/MissingH/IO/HVFS.hs
index 1a079c1..28706bb 100644
--- a/libsrc/MissingH/IO/HVFS.hs
+++ b/libsrc/MissingH/IO/HVFS.hs
@@ -43,31 +43,41 @@ where
 
 import MissingH.IO.HVIO
 import System.IO
+import System.IO.Error
 import System.Posix.Files
 import System.Posix.Types
 import System.Time
 
-class HVFSStat b where
-    vDeviceID :: b -> DeviceID
-    vFileID :: b -> FileID
-    vFileMode :: b -> FileMode
-    vLinkCount :: b -> LinkCount
-    vFileOwner :: b -> UserID
-    vFileGroup :: b -> GroupID
-    vSpecialDeviceID :: b -> DeviceID
-    vFileSize :: b -> FileOffset
-    vAccessTime :: b -> EpochTime
-    vModificationTime :: b -> EpochTime
-    vStatusChangeTime :: b -> EpochTime
-    vIsBlockDevice :: b -> Bool
-    vIsCharacterDevice :: b -> Bool
-    vIsNamedPipe :: b -> Bool
-    vIsRegularFile :: b -> Bool
-    vIsDirectory :: b -> Bool
-    vIsSymbolicLink :: b -> Bool
-    vIsSocket :: b -> Bool
-
-class HVFS a where
+class HVFSStat a where
+    vDeviceID :: a -> DeviceID
+    vFileID :: a -> FileID
+    vFileMode :: a -> FileMode
+    vLinkCount :: a -> LinkCount
+    vFileOwner :: a -> UserID
+    vFileGroup :: a -> GroupID
+    vSpecialDeviceID :: a -> DeviceID
+    vFileSize :: a -> FileOffset
+    vAccessTime :: a -> EpochTime
+    vModificationTime :: a -> EpochTime
+    vStatusChangeTime :: a -> EpochTime
+    vIsBlockDevice :: a -> Bool
+    vIsCharacterDevice :: a -> Bool
+    vIsNamedPipe :: a -> Bool
+    vIsRegularFile :: a -> Bool
+    vIsDirectory :: a -> Bool
+    vIsSymbolicLink :: a -> Bool
+    vIsSocket :: a -> Bool
+
+{- | 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 all other functions
+will generate an isIllegalOperation error, since they are assumed to be
+un-implemented. -}
+class HVFSStat b => HVFS a b where
     vGetCurrentDirectory :: a -> IO FilePath
     vSetCurrentDirectory :: a -> FilePath -> IO ()
     vGetDirectoryContents :: a -> FilePath -> IO [FilePath]
@@ -78,12 +88,23 @@ class HVFS a where
     vRenameDirectory :: a -> FilePath -> FilePath -> IO ()
     vRemoveFile :: a -> FilePath -> IO ()
     vRenameFile :: a -> FilePath -> FilePath -> IO ()
-    vGetFileStatus :: HVFSStat b => a -> FilePath -> IO b
-    vGetSymbolicLinkStatus :: HVFSStat b => a -> FilePath -> IO b
+    vGetFileStatus :: a -> FilePath -> IO b
+    vGetSymbolicLinkStatus :: a -> FilePath -> IO b
     vGetModificationTime :: a -> FilePath -> IO ClockTime
+    vRaiseError :: a -> IOErrorType -> String -> Maybe FilePath -> IO b
+
+    vGetModificationTime fs fp = 
+        do s <- (vGetFileStatus fs fp)::IO b
+           let t = vModificationTime s
+           return $ TOD (fromIntegral t) 0
+
+    vRaiseError fs et desc mfp =
+        ioError $ mkIOError et desc Nothing mfp
+
+    --vGetCurrentDirectory fs = vRaiseError fs 
 
-class (HVFS a, HVIOGeneric b) => HVFSOpenable a b where
-    vOpen :: a -> FilePath -> IO b
+class (HVFS a b, HVIOGeneric c) => HVFSOpenable a b c where
+    vOpen :: a -> FilePath -> IO c
 
 ----------------------------------------------------------------------
 -- Standard implementations

-- 
haskell-testpack