[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 28662cf5197f3401d1367fa5c3d140357bdf316f
Author: John Goerzen <jgoerzen at complete.org>
Date:   Tue Dec 21 10:54:03 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index 2732d86..1beae68 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,19 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-21 03:54:03 GMT	John Goerzen <jgoerzen at complete.org>	patch-119
+
+    Summary:
+      Checkpointing
+    Revision:
+      missingh--head--0.7--patch-119
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS.hs
+     libsrc/MissingH/IO/HVFS/InstanceHelpers.hs testsrc/HVFStest.hs
+
+
 2004-12-21 03:33:35 GMT	John Goerzen <jgoerzen at complete.org>	patch-118
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS.hs b/libsrc/MissingH/IO/HVFS.hs
index 011e7a8..43124f8 100644
--- a/libsrc/MissingH/IO/HVFS.hs
+++ b/libsrc/MissingH/IO/HVFS.hs
@@ -35,6 +35,7 @@ Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
 module MissingH.IO.HVFS(-- * Implementation Classes \/ Types
                         HVFS(..), HVFSStat(..), HVFSStatEncap(..),
                         HVFSOpenable(..), HVFSOpenEncap(..),
+                        SystemFS(..),
                         -- * Re-exported types from other modules
                         FilePath, DeviceID, FileID, FileMode, LinkCount,
                         UserID, GroupID, FileOffset, EpochTime,
diff --git a/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs b/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
index a4629f6..c019d2f 100644
--- a/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
+++ b/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
@@ -40,8 +40,9 @@ module MissingH.IO.HVFS.InstanceHelpers(-- * HVFSStat objects
                                         newMemoryVFS, newMemoryVFSRef,
                                         MemoryNode,
                                         MemoryEntry(..),
-                                        -- ** FuncVFS
-                                        
+                                        -- * Utilities
+                                        nice_slice, getFullPath,
+                                        getFullSlice
                                        )
 where
 import MissingH.IO.HVFS
@@ -91,6 +92,39 @@ newMemoryVFSRef r = do
                     c <- newIORef "/"
                     return (MemoryVFS {content = r, cwd = c})
 
+{- | Similar to 'MissingH.Path.NameManip' but the first element
+won't be @\/@.
+
+>nice_slice "/" -> []
+>nice_slice "/foo/bar" -> ["foo", "bar"]
+-}
+nice_slice :: String -> [String]
+nice_slice "/" = []
+nice_slice path =
+    let sliced1 = slice_path path
+        h = head sliced1
+        t = tail sliced1
+        newh =  if head h == '/' then tail h else h
+        sliced2 = newh : t
+    in sliced2
+
+{- | Gets a full path, after investigating the cwd.
+-}
+getFullPath :: HVFS a => a -> String -> IO String
+getFullPath fs path =
+    do cwd <- vGetCurrentDirectory fs
+       case absNormPath cwd path of
+           Nothing -> vRaiseError fs doesNotExistErrorType
+                        ("Trouble normalizing path " ++ path) (Just (cwd ++ "/" ++ path))
+           Just newpath -> return newpath
+
+{- | Gets the full path via 'getFullPath', then splits it via 'nice_slice'.
+-}
+getFullSlice :: HVFS a => a -> String -> IO [String]
+getFullSlice fs fp =
+    do newpath <- getFullPath fs fp
+       return (nice_slice newpath)
+
 -- | Find an element on the tree, assuming a normalized path
 findMelem :: MemoryVFS -> String -> IO MemoryEntry
 findMelem x "/" = readIORef (content x) >>= return . MemoryDirectory
diff --git a/testsrc/HVFStest.hs b/testsrc/HVFStest.hs
index f942b63..732b8ac 100644
--- a/testsrc/HVFStest.hs
+++ b/testsrc/HVFStest.hs
@@ -41,6 +41,14 @@ testTree = [("test.txt", MemoryFile "line1\nline2\n"),
             )
            ]
 
+test_nice_slice =
+    let f exp fp = TestLabel fp $ TestCase $ exp @=? nice_slice fp
+        in [
+            f [] "/"
+           ,f ["foo", "bar"] "/foo/bar"
+           --,f [] "."
+           ]
+
 test_content = 
     let f exp fp = TestLabel fp $ TestCase $
                      do x <- newMemoryVFS testTree
@@ -73,6 +81,7 @@ test_structure =
         ]
                             
 
-tests = TestList [TestLabel "structure" (TestList test_structure)
+tests = TestList [TestLabel "nice_slice" (TestList test_nice_slice)
+                 ,TestLabel "structure" (TestList test_structure)
                  ,TestLabel "content" (TestList test_content)
                  ]
\ No newline at end of file

-- 
haskell-testpack