[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 c57176677302f20a2d537abd421af2edf4bec452
Author: John Goerzen <jgoerzen at complete.org>
Date:   Mon Dec 20 23:31:21 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index 3707418..a436f77 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:31:21 GMT	John Goerzen <jgoerzen at complete.org>	patch-96
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--0.7--patch-96
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS.hs
+
+
 2004-12-20 16:20:23 GMT	John Goerzen <jgoerzen at complete.org>	patch-95
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS.hs b/libsrc/MissingH/IO/HVFS.hs
index d202e4c..a61200d 100644
--- a/libsrc/MissingH/IO/HVFS.hs
+++ b/libsrc/MissingH/IO/HVFS.hs
@@ -53,11 +53,19 @@ data HVFSStatEncap = forall a. HVFSStat a => HVFSStatEncap a
 
 {- | Evaluating types of files and information about them.
 
-This corresponds to the System.Posix.Types.FileStatus type.
+This corresponds to the System.Posix.Types.FileStatus type, and indeed,
+that is one instance of this class.
+
+Inplementators must, at minimum, implement 'vIsDirectory' and
+'vIsRegularFile'.
+
+Default implementations of everything else are provided, returning
+reasonable values.
 -}
 class HVFSStat a where
     vDeviceID :: a -> DeviceID
     vFileID :: a -> FileID
+    {- | Refers to file permissions, NOT the st_mode field from stat(2) -}
     vFileMode :: a -> FileMode
     vLinkCount :: a -> LinkCount
     vFileOwner :: a -> UserID
@@ -75,6 +83,23 @@ class HVFSStat a where
     vIsSymbolicLink :: a -> Bool
     vIsSocket :: a -> Bool
 
+    vDeviceID _ = 0
+    vFileID _ = 0
+    vFileMode _ = 0o0644
+    vLinkCount _ = 1
+    vFileOwner _ = 0
+    vFileGroup _ = 0
+    vSpecialDeviceID _ = 0
+    vFileSize _ = 0
+    vAccessTime _ = 0
+    vModificationTime _ = 0
+    vStatusChangeTime _ = 0
+    vIsBlockDevice _ = False
+    vIsCharacterDevice _ = False
+    vIsNamedPipe _ = False
+    vIsSymbolicLink _ = False
+    vIsSocket _ = False
+
 {- | The main HVFS class.
 
 Default implementations of these functions are provided:
@@ -115,6 +140,9 @@ class HVFS a where
     vGetModificationTime :: a -> FilePath -> IO ClockTime
     {- | Raise an error relating to actions on this class. -}
     vRaiseError :: a -> IOErrorType -> String -> Maybe FilePath -> IO c
+    vCreateSymbolicLink :: a -> FilePath -> FilePath -> IO ()
+    vReadSymbolicLink :: a -> FilePath -> IO FilePath
+    vCreateLink :: a -> FilePath -> FilePath -> IO ()
 
     vGetModificationTime fs fp = 
         do s <- vGetFileStatus fs fp
@@ -141,6 +169,9 @@ class HVFS a where
     vRemoveDirectory fs _ = eh fs "vRemoveDirectory"
     vRemoveFile fs _ = eh fs "vRemoveFile"
     vRenameFile fs _ _ = eh fs "vRenameFile"
+    vCreateSymbolicLink fs _ _ = eh fs "vCreateSymbolicLink"
+    vReadSymbolicLink fs _ = eh fs "vReadSymbolicLink"
+    vCreateLink fs _ _ = eh fs "vCreateLink"
     vGetSymbolicLinkStatus = vGetFileStatus
 
 -- | Error handler helper
@@ -191,6 +222,9 @@ instance HVFS SystemFS where
     vGetFileStatus _ fp = getFileStatus fp >>= return . HVFSStatEncap
     vGetSymbolicLinkStatus _ fp = getSymbolicLinkStatus fp >>= return . HVFSStatEncap
     vGetModificationTime _ = getModificationTime
+    vCreateSymbolicLink _ = createSymbolicLink
+    vReadSymbolicLink _ = readSymbolicLink
+    vCreateLink _ = createLink
 
 instance HVFSOpenable SystemFS Handle where
     vOpen _ fp iomode = openFile fp iomode

-- 
haskell-testpack