[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