[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 de0d1e8835a4e09dbbf045370b3077ee41f8e150
Author: John Goerzen <jgoerzen at complete.org>
Date:   Tue Dec 21 03:44:29 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index afe3887..ffa46e4 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 20:44:29 GMT	John Goerzen <jgoerzen at complete.org>	patch-105
+
+    Summary:
+      Checkpointing (compiles)
+    Revision:
+      missingh--head--0.7--patch-105
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
+
+
 2004-12-20 20:18:45 GMT	John Goerzen <jgoerzen at complete.org>	patch-104
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs b/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
index bedcdd7..8282ed3 100644
--- a/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
+++ b/libsrc/MissingH/IO/HVFS/InstanceHelpers.hs
@@ -40,6 +40,9 @@ module MissingH.IO.HVFS.InstanceHelpers(-- * HVFSStat objects
 where
 import MissingH.IO.HVFS
 import Data.IORef
+import MissingH.Path
+import MissingH.Path.NameManip
+import Control.Monad.Error
 
 {- | A simple class that assumes that everything is either a file
 or a directory. -}
@@ -75,4 +78,46 @@ newMemoryVFSRef r = do
                     c <- newIORef "/"
                     return (MemoryVFS {content = r, cwd = c})
 
+-- | Find an element on the tree, assuming a normalized path
+findMelem :: MemoryVFS -> String -> IO MemoryEntry
+findMelem x "/" = readIORef (content x) >>= return . MemoryDirectory
+findMelem x path =
+    let sliced1 = slice_path path
+        h = head sliced1
+        t = tail sliced1
+        newh = if (h /= "/") && head h == '/' then tail h else h
+        sliced2 = newh : t
+                  
+        -- Walk the tree
+        walk :: MemoryEntry -> [String] -> Either String MemoryEntry
+        -- Empty list -- return the item we have
+        walk y [] = Right y
+        -- Root directory -- return the item we have
+        walk y ["/"] = Right y
+        -- File but stuff: error
+        walk (MemoryFile _) (x : _) = 
+            Left $ "Attempt to look up name " ++ x ++ " in file"
+        walk (MemoryDirectory y) (x : xs) =
+            let newentry = case lookup x y of
+                                Nothing -> Left $ "Couldn't find entry " ++ x
+                                Just z -> Right z
+                in do newobj <- newentry
+                      walk newobj xs
+        in do
+           c <- readIORef $ content x
+           case walk (MemoryDirectory c) (slice_path path) of
+              Left err -> fail err
+              Right result -> return result
 
+-- | Find an element on the tree, normalizing the path first
+getMelem :: MemoryVFS -> String -> IO MemoryEntry
+getMelem x s = 
+    do base <- readIORef $ cwd x
+       case secureAbsNormPath base s of
+           Nothing -> fail $ "Trouble normalizing path " ++ s
+           Just newpath -> findMelem x newpath
+
+{-                       
+instance HVFS MemoryVFS where
+    vGetCurrentDirectory x = readIORef $ cwd x
+-}
\ No newline at end of file

-- 
haskell-testpack