[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:59:44 UTC 2010
The following commit has been merged in the master branch:
commit 967e74646d1a9d6bdacae73d88d2f99c9a2ef4cb
Author: John Goerzen <jgoerzen at complete.org>
Date: Thu Jul 21 23:58:23 2005 +0100
Added FilePath
diff --git a/MissingH/IO/HVFS.hs b/MissingH/IO/HVFS.hs
index 4b3f77d..11d8baf 100644
--- a/MissingH/IO/HVFS.hs
+++ b/MissingH/IO/HVFS.hs
@@ -1,6 +1,6 @@
{-# LANGUAGE CPP #-}
{- arch-tag: HVFS main file
-Copyright (C) 2004 John Goerzen <jgoerzen at complete.org>
+Copyright (C) 2004-2005 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
@@ -19,7 +19,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
{- |
Module : MissingH.IO.HVFS
- Copyright : Copyright (C) 2004 John Goerzen
+ Copyright : Copyright (C) 2004-2005 John Goerzen
License : GNU GPL, version 2 or above
Maintainer : John Goerzen,
@@ -29,7 +29,7 @@ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
Haskell Virtual FS -- generic support for real or virtual filesystem in Haskell
-Copyright (c) 2004 John Goerzen, jgoerzen\@complete.org
+Copyright (c) 2004-2005 John Goerzen, jgoerzen\@complete.org
The idea of this module is to provide virtualization of filesystem calls.
In addition to the \"real\" system filesystem, you can also provide access
diff --git a/MissingH/Path/FilePath.hs b/MissingH/Path/FilePath.hs
new file mode 100644
index 0000000..be0a205
--- /dev/null
+++ b/MissingH/Path/FilePath.hs
@@ -0,0 +1,421 @@
+module System.FilePath
+ ( -- * File path
+ FilePath
+ , splitFileName
+ , splitFileExt
+ , splitFilePath
+ , joinFileName
+ , joinFileExt
+ , joinPaths
+ , changeFileExt
+ , isRootedPath
+ , isAbsolutePath
+ , dropAbsolutePrefix
+ , breakFilePath
+ , dropPrefix
+
+ , pathParents
+ , commonParent
+
+ -- * Search path
+ , parseSearchPath
+ , mkSearchPath
+
+ -- * Separators
+ , isPathSeparator
+ , pathSeparator
+ , searchPathSeparator
+
+ -- * Filename extensions
+ , exeExtension
+ , objExtension
+ , dllExtension
+ ) where
+
+import Data.List(intersperse)
+
+--------------------------------------------------------------
+-- * FilePath
+--------------------------------------------------------------
+
+-- | Split the path into directory and file name
+--
+-- Examples:
+--
+-- \[Posix\]
+--
+-- > splitFileName "/" == ("/", ".")
+-- > splitFileName "/foo/bar.ext" == ("/foo", "bar.ext")
+-- > splitFileName "bar.ext" == (".", "bar.ext")
+-- > splitFileName "/foo/." == ("/foo", ".")
+-- > splitFileName "/foo/.." == ("/foo", "..")
+--
+-- \[Windows\]
+--
+-- > splitFileName "\\" == ("\\", "")
+-- > splitFileName "c:\\foo\\bar.ext" == ("c:\\foo", "bar.ext")
+-- > splitFileName "bar.ext" == (".", "bar.ext")
+-- > splitFileName "c:\\foo\\." == ("c:\\foo", ".")
+-- > splitFileName "c:\\foo\\.." == ("c:\\foo", "..")
+--
+-- The first case in the Windows examples returns an empty file name.
+-- This is a special case because the \"\\\\\" path doesn\'t refer to
+-- an object (file or directory) which resides within a directory.
+splitFileName :: FilePath -> (String, String)
+#ifdef mingw32_HOST_OS
+splitFileName p = (reverse (path2++drive), reverse fname)
+ where
+ (path,drive) = case p of
+ (c:':':p) -> (reverse p,[':',c])
+ _ -> (reverse p,"")
+ (fname,path1) = break isPathSeparator path
+ path2 = case path1 of
+ [] -> "."
+ [_] -> path1 -- don't remove the trailing slash if
+ -- there is only one character
+ (c:path) | isPathSeparator c -> path
+ _ -> path1
+#else
+splitFileName p = (reverse path1, reverse fname1)
+ where
+ (fname,path) = break isPathSeparator (reverse p)
+ path1 = case path of
+ "" -> "."
+ _ -> case dropWhile isPathSeparator path of
+ "" -> [pathSeparator]
+ p -> p
+ fname1 = case fname of
+ "" -> "."
+ _ -> fname
+#endif
+
+-- | Split the path into file name and extension. If the file doesn\'t have extension,
+-- the function will return empty string. The extension doesn\'t include a leading period.
+--
+-- Examples:
+--
+-- > splitFileExt "foo.ext" == ("foo", "ext")
+-- > splitFileExt "foo" == ("foo", "")
+-- > splitFileExt "." == (".", "")
+-- > splitFileExt ".." == ("..", "")
+-- > splitFileExt "foo.bar."== ("foo.bar.", "")
+splitFileExt :: FilePath -> (String, String)
+splitFileExt p =
+ case break (== '.') fname of
+ (suf@(_:_),_:pre) -> (reverse (pre++path), reverse suf)
+ _ -> (p, [])
+ where
+ (fname,path) = break isPathSeparator (reverse p)
+
+-- | Split the path into directory, file name and extension.
+-- The function is an optimized version of the following equation:
+--
+-- > splitFilePath path = (dir,name,ext)
+-- > where
+-- > (dir,basename) = splitFileName path
+-- > (name,ext) = splitFileExt basename
+splitFilePath :: FilePath -> (String, String, String)
+splitFilePath path = case break (== '.') (reverse basename) of
+ (name_r, "") -> (dir, reverse name_r, "")
+ (ext_r, _:name_r) -> (dir, reverse name_r, reverse ext_r)
+ where
+ (dir, basename) = splitFileName path
+
+-- | The 'joinFileName' function is the opposite of 'splitFileName'.
+-- It joins directory and file names to form a complete file path.
+--
+-- The general rule is:
+--
+-- > dir `joinFileName` basename == path
+-- > where
+-- > (dir,basename) = splitFileName path
+--
+-- There might be an exceptions to the rule but in any case the
+-- reconstructed path will refer to the same object (file or directory).
+-- An example exception is that on Windows some slashes might be converted
+-- to backslashes.
+joinFileName :: String -> String -> FilePath
+joinFileName "" fname = fname
+joinFileName "." fname = fname
+joinFileName dir "" = dir
+joinFileName dir fname
+ | isPathSeparator (last dir) = dir++fname
+ | otherwise = dir++pathSeparator:fname
+
+-- | The 'joinFileExt' function is the opposite of 'splitFileExt'.
+-- It joins a file name and an extension to form a complete file path.
+--
+-- The general rule is:
+--
+-- > filename `joinFileExt` ext == path
+-- > where
+-- > (filename,ext) = splitFileExt path
+joinFileExt :: String -> String -> FilePath
+joinFileExt path "" = path
+joinFileExt path ext = path ++ '.':ext
+
+-- | Given a directory path \"dir\" and a file\/directory path \"rel\",
+-- returns a merged path \"full\" with the property that
+-- (cd dir; do_something_with rel) is equivalent to
+-- (do_something_with full). If the \"rel\" path is an absolute path
+-- then the returned path is equal to \"rel\"
+joinPaths :: FilePath -> FilePath -> FilePath
+joinPaths path1 path2
+ | isRootedPath path2 = path2
+ | otherwise =
+#ifdef mingw32_HOST_OS
+ case path2 of
+ d:':':path2' | take 2 path1 == [d,':'] -> path1 `joinFileName` path2'
+ | otherwise -> path2
+ _ -> path1 `joinFileName` path2
+#else
+ path1 `joinFileName` path2
+#endif
+
+-- | Changes the extension of a file path.
+changeFileExt :: FilePath -- ^ The path information to modify.
+ -> String -- ^ The new extension (without a leading period).
+ -- Specify an empty string to remove an existing
+ -- extension from path.
+ -> FilePath -- ^ A string containing the modified path information.
+changeFileExt path ext = joinFileExt name ext
+ where
+ (name,_) = splitFileExt path
+
+-- | On Unix and Macintosh the 'isRootedPath' function is a synonym to 'isAbsolutePath'.
+-- The difference is important only on Windows. The rooted path must start from the root
+-- directory but may not include the drive letter while the absolute path always includes
+-- the drive letter and the full file path.
+isRootedPath :: FilePath -> Bool
+isRootedPath (c:_) | isPathSeparator c = True
+#ifdef mingw32_HOST_OS
+isRootedPath (_:':':c:_) | isPathSeparator c = True -- path with drive letter
+#endif
+isRootedPath _ = False
+
+-- | Returns 'True' if this path\'s meaning is independent of any OS
+-- \"working directory\", or 'False' if it isn\'t.
+isAbsolutePath :: FilePath -> Bool
+#ifdef mingw32_HOST_OS
+isAbsolutePath (_:':':c:_) | isPathSeparator c = True
+#else
+isAbsolutePath (c:_) | isPathSeparator c = True
+#endif
+isAbsolutePath _ = False
+
+-- | If the function is applied to an absolute path then it returns a local path droping
+-- the absolute prefix in the path. Under Windows the prefix is \"\\\", \"c:\" or \"c:\\\". Under
+-- Unix the prefix is always \"\/\".
+dropAbsolutePrefix :: FilePath -> FilePath
+dropAbsolutePrefix (c:cs) | isPathSeparator c = cs
+#ifdef mingw32_HOST_OS
+dropAbsolutePrefix (_:':':c:cs) | isPathSeparator c = cs -- path with drive letter
+dropAbsolutePrefix (_:':':cs) = cs
+#endif
+dropAbsolutePrefix cs = cs
+
+-- | Split the path into a list of strings constituting the filepath
+--
+-- > breakFilePath "/usr/bin/ls" == ["/","usr","bin","ls"]
+breakFilePath :: FilePath -> [String]
+breakFilePath = worker []
+ where worker ac path
+ | less == path = less:ac
+ | otherwise = worker (current:ac) less
+ where (less,current) = splitFileName path
+
+-- | Drops a specified prefix from a filepath.
+--
+-- > stripPrefix "." "Src/Test.hs" == "Src/Test.hs"
+-- > stripPrefix "Src" "Src/Test.hs" == "Test.hs"
+dropPrefix :: FilePath -> FilePath -> FilePath
+dropPrefix prefix path
+ = worker (breakFilePath prefix) (breakFilePath path)
+ where worker (x:xs) (y:ys)
+ | x == y = worker xs ys
+ worker _ ys = foldr1 joinPaths ys
+-- | Gets this path and all its parents.
+-- The function is useful in case if you want to create
+-- some file but you aren\'t sure whether all directories
+-- in the path exist or if you want to search upward for some file.
+--
+-- Some examples:
+--
+-- \[Posix\]
+--
+-- > pathParents "/" == ["/"]
+-- > pathParents "/dir1" == ["/", "/dir1"]
+-- > pathParents "/dir1/dir2" == ["/", "/dir1", "/dir1/dir2"]
+-- > pathParents "dir1" == [".", "dir1"]
+-- > pathParents "dir1/dir2" == [".", "dir1", "dir1/dir2"]
+--
+-- \[Windows\]
+--
+-- > pathParents "c:" == ["c:."]
+-- > pathParents "c:\\" == ["c:\\"]
+-- > pathParents "c:\\dir1" == ["c:\\", "c:\\dir1"]
+-- > pathParents "c:\\dir1\\dir2" == ["c:\\", "c:\\dir1", "c:\\dir1\\dir2"]
+-- > pathParents "c:dir1" == ["c:.","c:dir1"]
+-- > pathParents "dir1\\dir2" == [".", "dir1", "dir1\\dir2"]
+--
+-- Note that if the file is relative then the current directory (\".\")
+-- will be explicitly listed.
+pathParents :: FilePath -> [FilePath]
+pathParents p =
+ root'' : map ((++) root') (dropEmptyPath $ inits path')
+ where
+#ifdef mingw32_HOST_OS
+ (root,path) = case break (== ':') p of
+ (path, "") -> ("",path)
+ (root,_:path) -> (root++":",path)
+#else
+ (root,path) = ("",p)
+#endif
+ (root',root'',path') = case path of
+ (c:path) | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path)
+ _ -> (root ,root++"." ,path)
+
+ dropEmptyPath ("":paths) = paths
+ dropEmptyPath paths = paths
+
+ inits :: String -> [String]
+ inits [] = [""]
+ inits cs =
+ case pre of
+ "." -> inits suf
+ ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf)
+ _ -> "" : map (joinFileName pre) (inits suf)
+ where
+ (pre,suf) = case break isPathSeparator cs of
+ (pre,"") -> (pre, "")
+ (pre,_:suf) -> (pre,suf)
+
+-- | Given a list of file paths, returns the longest common parent.
+commonParent :: [FilePath] -> Maybe FilePath
+commonParent [] = Nothing
+commonParent paths@(p:ps) =
+ case common Nothing "" p ps of
+#ifdef mingw32_HOST_OS
+ Nothing | all (not . isAbsolutePath) paths ->
+ let
+ getDrive (d:':':_) ds
+ | not (d `elem` ds) = d:ds
+ getDrive _ ds = ds
+ in
+ case foldr getDrive [] paths of
+ [] -> Just "."
+ [d] -> Just [d,':']
+ _ -> Nothing
+#else
+ Nothing | all (not . isAbsolutePath) paths -> Just "."
+#endif
+ mb_path -> mb_path
+ where
+ common i acc [] ps = checkSep i acc ps
+ common i acc (c:cs) ps
+ | isPathSeparator c = removeSep i acc cs [] ps
+ | otherwise = removeChar i acc c cs [] ps
+
+ checkSep i acc [] = Just (reverse acc)
+ checkSep i acc ([]:ps) = Just (reverse acc)
+ checkSep i acc ((c1:p):ps)
+ | isPathSeparator c1 = checkSep i acc ps
+ checkSep i acc ps = i
+
+ removeSep i acc cs pacc [] =
+ common (Just (reverse (pathSeparator:acc))) (pathSeparator:acc) cs pacc
+ removeSep i acc cs pacc ([] :ps) = Just (reverse acc)
+ removeSep i acc cs pacc ((c1:p):ps)
+ | isPathSeparator c1 = removeSep i acc cs (p:pacc) ps
+ removeSep i acc cs pacc ps = i
+
+ removeChar i acc c cs pacc [] = common i (c:acc) cs pacc
+ removeChar i acc c cs pacc ([] :ps) = i
+ removeChar i acc c cs pacc ((c1:p):ps)
+ | c == c1 = removeChar i acc c cs (p:pacc) ps
+ removeChar i acc c cs pacc ps = i
+
+--------------------------------------------------------------
+-- * Search path
+--------------------------------------------------------------
+
+-- | The function splits the given string to substrings
+-- using the 'searchPathSeparator'.
+parseSearchPath :: String -> [FilePath]
+parseSearchPath path = split searchPathSeparator path
+ where
+ split :: Char -> String -> [String]
+ split c s =
+ case rest of
+ [] -> [chunk]
+ _:rest' -> chunk : split c rest'
+ where
+ (chunk, rest) = break (==c) s
+
+-- | The function concatenates the given paths to form a
+-- single string where the paths are separated with 'searchPathSeparator'.
+mkSearchPath :: [FilePath] -> String
+mkSearchPath paths = concat (intersperse [searchPathSeparator] paths)
+
+
+--------------------------------------------------------------
+-- * Separators
+--------------------------------------------------------------
+
+-- | Checks whether the character is a valid path separator for the host
+-- platform. The valid character is a 'pathSeparator' but since the Windows
+-- operating system also accepts a slash (\"\/\") since DOS 2, the function
+-- checks for it on this platform, too.
+isPathSeparator :: Char -> Bool
+isPathSeparator ch =
+#ifdef mingw32_HOST_OS
+ ch == '/' || ch == '\\'
+#else
+ ch == '/'
+#endif
+
+-- | Provides a platform-specific character used to separate directory levels in
+-- a path string that reflects a hierarchical file system organization. The
+-- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash
+-- (@\"\\\"@) on the Windows operating system.
+pathSeparator :: Char
+#ifdef mingw32_HOST_OS
+pathSeparator = '\\'
+#else
+pathSeparator = '/'
+#endif
+
+-- | A platform-specific character used to separate search path strings in
+-- environment variables. The separator is a colon (\":\") on Unix and Macintosh,
+-- and a semicolon (\";\") on the Windows operating system.
+searchPathSeparator :: Char
+#ifdef mingw32_HOST_OS
+searchPathSeparator = ';'
+#else
+searchPathSeparator = ':'
+#endif
+
+-- ToDo: This should be determined via autoconf (AC_EXEEXT)
+-- | Extension for executable files
+-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
+exeExtension :: String
+#ifdef mingw32_HOST_OS
+exeExtension = "exe"
+#else
+exeExtension = ""
+#endif
+
+-- ToDo: This should be determined via autoconf (AC_OBJEXT)
+-- | Extension for object files. For GHC and NHC the extension is @\"o\"@.
+-- Hugs uses either @\"o\"@ or @\"obj\"@ depending on the used C compiler.
+objExtension :: String
+objExtension = "o"
+
+-- | Extension for dynamically linked (or shared) libraries
+-- (typically @\"so\"@ on Unix and @\"dll\"@ on Windows)
+dllExtension :: String
+#ifdef mingw32_HOST_OS
+dllExtension = "dll"
+#else
+dllExtension = "so"
+#endif
--
haskell-testpack
More information about the Pkg-haskell-commits
mailing list