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

John Goerzen jgoerzen at complete.org
Fri Apr 23 14:53:42 UTC 2010


The following commit has been merged in the master branch:
commit 07d6985db9e2d277f269264d5e25c2f57c55eca8
Author: John Goerzen <jgoerzen at complete.org>
Date:   Fri Dec 24 00:06:28 2004 +0100

    Added convenience functions
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-153)

diff --git a/ChangeLog b/ChangeLog
index 89abf8c..32a80bd 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,21 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-23 17:06:28 GMT	John Goerzen <jgoerzen at complete.org>	patch-153
+
+    Summary:
+      Added convenience functions
+    Revision:
+      missingh--head--0.7--patch-153
+
+
+    new files:
+     libsrc/MissingH/IO/HVFS/Utils.hs
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS.hs libsrc/MissingH/Path.hs
+
+
 2004-12-23 02:53:10 GMT	John Goerzen <jgoerzen at complete.org>	patch-152
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS.hs b/libsrc/MissingH/IO/HVFS.hs
index 43124f8..2d6af84 100644
--- a/libsrc/MissingH/IO/HVFS.hs
+++ b/libsrc/MissingH/IO/HVFS.hs
@@ -33,8 +33,9 @@ Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
 -}
 
 module MissingH.IO.HVFS(-- * Implementation Classes \/ Types
-                        HVFS(..), HVFSStat(..), HVFSStatEncap(..),
-                        HVFSOpenable(..), HVFSOpenEncap(..),
+                        HVFS(..), HVFSStat(..), 
+                        HVFSOpenable(..), HVFSOpenEncap(..),HVFSStatEncap(..),
+                        withStat, withOpen,
                         SystemFS(..),
                         -- * Re-exported types from other modules
                         FilePath, DeviceID, FileID, FileMode, LinkCount,
@@ -59,10 +60,23 @@ typing restrictions.  You can get at it with:
 -}
 data HVFSStatEncap = forall a. HVFSStat a => HVFSStatEncap a
 
-{- | Similar for 'vOpen' result.
+{- | Convenience function for working with stat -- takes a stat result
+and a function that uses it, and returns the result. -}
+withStat :: forall b. HVFSStatEncap -> (forall a. HVFSStat a => a -> b) -> b
+withStat s f =
+    case s of
+           HVFSStatEncap x -> f x
+
+{- | Similar to 'HVFSStatEncap', but for 'vOpen' result.
 -}
 data HVFSOpenEncap = forall a. HVIO a => HVFSOpenEncap a
 
+{- | Similar to 'withStat', but for the 'vOpen' result. -}
+withOpen :: forall b. HVFSOpenEncap -> (forall a. HVIO a => a -> b) -> b
+withOpen s f =
+    case s of
+           HVFSOpenEncap x -> f x
+
 {- | Evaluating types of files and information about them.
 
 This corresponds to the System.Posix.Types.FileStatus type, and indeed,
diff --git a/libsrc/MissingH/IO/HVFS/Utils.hs b/libsrc/MissingH/IO/HVFS/Utils.hs
new file mode 100644
index 0000000..28d7eff
--- /dev/null
+++ b/libsrc/MissingH/IO/HVFS/Utils.hs
@@ -0,0 +1,88 @@
+{- arch-tag: HVFS utilities main file
+Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+
+This program is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2 of the License, or
+(at your option) any later version.
+
+This program is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with this program; if not, write to the Free Software
+Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
+-}
+
+{- 
+   Module     : MissingH.IO.HVFS.Utils
+   Copyright  : Copyright (C) 2004 John Goerzen
+   License    : GNU GPL, version 2 or above
+
+   Maintainer : John Goerzen, 
+   Maintainer : jgoerzen at complete.org
+   Stability  : provisional
+   Portability: portable
+
+This module provides various helpful utilities for dealing 
+filesystems.
+
+Written by John Goerzen, jgoerzen\@complete.org
+
+To operate on your system's main filesystem, just pass SystemFS as the
+first parameter to these functions.
+-}
+
+module MissingH.IO.HVFS.Utils (recurseDir,
+                               recurseDirStat,
+                               recursiveRemove,
+                               SystemFS
+                              )
+where
+
+import MissingH.IO.HVFS
+
+{- | Obtain a recursive listing of all files\/directories beneath 
+the specified directory.  The traversal is depth-first and the original
+item is always present in the returned list.
+
+If the passed value is not a directory, the return value
+be only that value.
+
+The \".\" and \"..\" entries are removed from the data returned.
+-}
+recurseDir :: HVFS a => a -> FilePath -> IO [FilePath]
+recurseDir fs x = recurseDirStat fs x >>= return . map fst
+
+{- | Like 'recurseDir', but return the stat() (System.Posix.Files.FileStatus)
+information with them.  This is an optimization if you will be statting files
+yourself later.
+-}
+
+recurseDirStat :: HVFS a => a -> FilePath -> IO [(FilePath, HVFSStatEncap)]
+recurseDirStat h fn =
+    do fs <- vGetSymbolicLinkStatus h fn
+       if withStat fs vIsDirectory then do
+                                dirc <- vGetDirectoryContents h fn
+                                let contents = map ((++) (fn ++ "/")) $ 
+                                     filter (\x -> x /= "." && x /= "..") dirc
+                                subdirs <- mapM (recurseDirStat h) contents
+                                return $ (concat subdirs) ++ [(fn, fs)]
+          else return [(fn, fs)]
+
+{- | Removes a file or a directory.  If a directory, also removes all its
+child files\/directories.
+-}
+recursiveRemove :: HVFS a => a -> FilePath -> IO ()
+recursiveRemove h fn =
+    let worker [] = return ()
+        worker ((fn, fs):xs) =
+            do if withStat fs vIsDirectory then
+                  vRemoveDirectory h fn
+                  else vRemoveFile h fn
+               worker xs
+        in
+        recurseDirStat h fn >>= worker
+
diff --git a/libsrc/MissingH/Path.hs b/libsrc/MissingH/Path.hs
index 3ae93d5..4e18148 100644
--- a/libsrc/MissingH/Path.hs
+++ b/libsrc/MissingH/Path.hs
@@ -49,6 +49,8 @@ import System.Posix.Temp
 import Control.Exception
 import System.IO
 import MissingH.Path.NameManip
+import MissingH.IO.HVFS.Utils
+import MissingH.IO.HVFS
 
 {- | Splits a pathname into a tuple representing the root of the name and
 the extension.  The extension is considered to be all characters from the last
@@ -96,48 +98,6 @@ secureAbsNormPath base s = do p <- absNormPath base s
                                  then return p
                                  else fail ""
 
-{- | Obtain a recursive listing of all files\/directories beneath 
-the specified directory.  The traversal is depth-first and the original
-item is always present in the returned list.
-
-If the passed value is not a directory, the return value
-be only that value.
-
-The \".\" and \"..\" entries are removed from the data returned.
--}
-recurseDir :: FilePath -> IO [FilePath]
-recurseDir x = recurseDirStat x >>= return . map fst
-
-{- | Like 'recurseDir', but return the stat() (System.Posix.Files.FileStatus)
-information with them.  This is an optimization if you will be statting files
-yourself later.
--}
-
-recurseDirStat :: FilePath -> IO [(FilePath, FileStatus)]
-recurseDirStat fn =
-    do fs <- getSymbolicLinkStatus fn
-       if isDirectory fs then do
-                              dirc <- getDirectoryContents fn
-                              let contents = map ((++) (fn ++ "/")) $ 
-                                     filter (\x -> x /= "." && x /= "..") dirc
-                              subdirs <- mapM recurseDirStat contents
-                              return $ (concat subdirs) ++ [(fn, fs)]
-          else return [(fn, fs)]
-
-{- | Removes a file or a directory.  If a directory, also removes all its
-child files\/directories.
--}
-recursiveRemove :: FilePath -> IO ()
-recursiveRemove fn =
-    let worker [] = return ()
-        worker ((fn, fs):xs) =
-            do if isDirectory fs then
-                  removeDirectory fn
-                  else removeFile fn
-               worker xs
-        in
-        recurseDirStat fn >>= worker
-
 {- | Creates a temporary directory for your use.
 
 The passed string should be a template suitable for mkstemp; that is, end with
@@ -160,4 +120,5 @@ removes the directory and all its contents when the action completes (or raises
 an exception. -}
 brackettmpdir :: String -> (String -> IO a) -> IO a
 brackettmpdir x action = do tmpdir <- mktmpdir x
-                            finally (action tmpdir) (recursiveRemove tmpdir)
+                            finally (action tmpdir) 
+                                    (recursiveRemove SystemFS tmpdir)

-- 
haskell-testpack



More information about the Pkg-haskell-commits mailing list