[Pkg-haskell-commits] r1290 - in /packages/haskell-filepath/trunk: LICENSE System/FilePath.hs System/FilePath/Internal.hs System/FilePath/Posix.hs System/FilePath/Windows.hs debian/changelog filepath.cabal
arjan at users.alioth.debian.org
arjan at users.alioth.debian.org
Sat Jan 17 18:11:28 UTC 2009
Author: arjan
Date: Sat Jan 17 18:11:28 2009
New Revision: 1290
URL: http://svn.debian.org/wsvn/pkg-haskell/?sc=1&rev=1290
Log:
New upstream release
Added:
packages/haskell-filepath/trunk/LICENSE
- copied unchanged from r1289, packages/haskell-filepath/branches/upstream/current/LICENSE
Modified:
packages/haskell-filepath/trunk/System/FilePath.hs
packages/haskell-filepath/trunk/System/FilePath/Internal.hs
packages/haskell-filepath/trunk/System/FilePath/Posix.hs
packages/haskell-filepath/trunk/System/FilePath/Windows.hs
packages/haskell-filepath/trunk/debian/changelog
packages/haskell-filepath/trunk/filepath.cabal
Modified: packages/haskell-filepath/trunk/System/FilePath.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/trunk/System/FilePath.hs?rev=1290&op=diff
==============================================================================
--- packages/haskell-filepath/trunk/System/FilePath.hs (original)
+++ packages/haskell-filepath/trunk/System/FilePath.hs Sat Jan 17 18:11:28 2009
@@ -1,4 +1,4 @@
-
+{-# LANGUAGE CPP #-}
{- |
Module : System.FilePath
Copyright : (c) Neil Mitchell 2005-2007
Modified: packages/haskell-filepath/trunk/System/FilePath/Internal.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/trunk/System/FilePath/Internal.hs?rev=1290&op=diff
==============================================================================
--- packages/haskell-filepath/trunk/System/FilePath/Internal.hs (original)
+++ packages/haskell-filepath/trunk/System/FilePath/Internal.hs Sat Jan 17 18:11:28 2009
@@ -64,11 +64,16 @@
makeRelative,
isRelative, isAbsolute,
isValid, makeValid
+
+#ifdef TESTING
+ , isRelativeDrive
+#endif
+
)
where
+import Data.Char(toLower, toUpper)
import Data.Maybe(isJust, fromJust)
-import Data.Char(toLower, toUpper)
import System.Environment(getEnv)
@@ -154,16 +159,23 @@
-- | Take a string, split it on the 'searchPathSeparator' character.
--
--- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"]
--- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"]
+-- Follows the recommendations in
+-- <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>
+--
+-- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"]
+-- > Posix: splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]
+-- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"]
+-- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]
splitSearchPath :: String -> [FilePath]
splitSearchPath = f
where
f xs = case break isSearchPathSeparator xs of
- ([], []) -> []
- ([], post) -> f (tail post)
- (pre, []) -> [pre]
- (pre, post) -> pre : f (tail post)
+ (pre, [] ) -> g pre
+ (pre, _:post) -> g pre ++ f post
+
+ g "" = ["." | isPosix]
+ g x = [x]
+
-- | Get a list of filepaths in the $PATH.
getSearchPath :: IO [FilePath]
@@ -195,8 +207,8 @@
-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
--
-- > takeExtension x == snd (splitExtension x)
--- > takeExtension (addExtension x "ext") == ".ext"
--- > takeExtension (replaceExtension x "ext") == ".ext"
+-- > Valid x => takeExtension (addExtension x "ext") == ".ext"
+-- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"
takeExtension :: FilePath -> String
takeExtension = snd . splitExtension
@@ -227,7 +239,7 @@
-- > addExtension "file." ".bib" == "file..bib"
-- > addExtension "file" ".bib" == "file.bib"
-- > addExtension "/" "x" == "/.x"
--- > takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
+-- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
addExtension :: FilePath -> String -> FilePath
addExtension file "" = file
@@ -261,6 +273,8 @@
dropExtensions = fst . splitExtensions
-- | Get all extensions
+--
+-- > takeExtensions "file.tar.gz" == ".tar.gz"
takeExtensions :: FilePath -> String
takeExtensions = snd . splitExtensions
@@ -285,8 +299,9 @@
-- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")
-- > Windows: splitDrive "\\\\shared" == ("\\\\shared","")
-- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")
+-- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")
-- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")
--- > Windows: splitDrive "/d" == ("/","d")
+-- > Windows: splitDrive "/d" == ("","/d")
-- > Posix: splitDrive "/test" == ("/","test")
-- > Posix: splitDrive "//test" == ("//","test")
-- > Posix: splitDrive "test/file" == ("","test/file")
@@ -302,8 +317,6 @@
splitDrive x | isJust y = fromJust y
where y = readDriveShare x
-
-splitDrive (x:xs) | isPathSeparator x = addSlash [x] xs
splitDrive x = ("",x)
@@ -348,7 +361,11 @@
-- | Join a drive and the rest of the path.
--
--- > uncurry joinDrive (splitDrive x) == x
+-- > uncurry joinDrive (splitDrive x) == x
+-- > Windows: joinDrive "C:" "foo" == "C:foo"
+-- > Windows: joinDrive "C:\\" "bar" == "C:\\bar"
+-- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo"
+-- > Windows: joinDrive "/:" "foo" == "/:\\foo"
joinDrive :: FilePath -> FilePath -> FilePath
joinDrive a b | isPosix = a ++ b
| null a = b
@@ -388,7 +405,7 @@
-- | Split a filename into directory and file. 'combine' is the inverse.
--
-- > uncurry (++) (splitFileName x) == x
--- > uncurry combine (splitFileName (makeValid x)) == (makeValid x)
+-- > Valid x => uncurry combine (splitFileName x) == x
-- > splitFileName "file/bob.txt" == ("file/", "bob.txt")
-- > splitFileName "file/" == ("file/", "")
-- > splitFileName "bob" == ("", "bob")
@@ -403,9 +420,9 @@
-- | Set the filename.
--
--- > replaceFileName (makeValid x) (takeFileName (makeValid x)) == makeValid x
+-- > Valid x => replaceFileName x (takeFileName x) == x
replaceFileName :: FilePath -> String -> FilePath
-replaceFileName x y = dropFileName x `combine` y
+replaceFileName x y = dropFileName x </> y
-- | Drop the filename.
--
@@ -417,10 +434,11 @@
-- | Get the file name.
--
-- > takeFileName "test/" == ""
+-- > takeFileName x `isSuffixOf` x
-- > takeFileName x == snd (splitFileName x)
--- > takeFileName (replaceFileName x "fred") == "fred"
--- > takeFileName (combine x "fred") == "fred"
--- > isRelative (takeFileName (makeValid x))
+-- > Valid x => takeFileName (replaceFileName x "fred") == "fred"
+-- > Valid x => takeFileName (x </> "fred") == "fred"
+-- > Valid x => isRelative (takeFileName x)
takeFileName :: FilePath -> FilePath
takeFileName = snd . splitFileName
@@ -442,7 +460,7 @@
-- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"
-- > replaceBaseName x (takeBaseName x) == x
replaceBaseName :: FilePath -> String -> FilePath
-replaceBaseName pth nam = combineAlways a (addExtension nam ext)
+replaceBaseName pth nam = combineAlways a (nam <.> ext)
where
(a,b) = splitFileName pth
ext = takeExtension b
@@ -459,7 +477,7 @@
-- | Add a trailing file path separator if one is not already present.
--
-- > hasTrailingPathSeparator (addTrailingPathSeparator x)
--- > if hasTrailingPathSeparator x then addTrailingPathSeparator x == x else True
+-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x
-- > Posix: addTrailingPathSeparator "test/rest" == "test/rest/"
addTrailingPathSeparator :: FilePath -> FilePath
addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator]
@@ -479,8 +497,11 @@
-- | Get the directory name, move up one level.
--
--- > Posix: takeDirectory "/foo/bar/baz" == "/foo/bar"
--- > Posix: takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"
+-- > takeDirectory x `isPrefixOf` x
+-- > takeDirectory "foo" == ""
+-- > takeDirectory "/foo/bar/baz" == "/foo/bar"
+-- > takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"
+-- > takeDirectory "foo/bar/baz" == "foo/bar"
-- > Windows: takeDirectory "foo\\bar" == "foo"
-- > Windows: takeDirectory "foo\\bar\\\\" == "foo\\bar"
-- > Windows: takeDirectory "C:\\" == "C:\\"
@@ -501,12 +522,13 @@
-- | Combine two paths, if the second path 'isAbsolute', then it returns the second.
--
--- > combine (takeDirectory (makeValid x)) (takeFileName (makeValid x)) `equalFilePath` makeValid x
+-- > Valid x => combine (takeDirectory x) (takeFileName x) `equalFilePath` x
-- > Posix: combine "/" "test" == "/test"
-- > Posix: combine "home" "bob" == "home/bob"
-- > Windows: combine "home" "bob" == "home\\bob"
+-- > Windows: combine "home" "/bob" == "/bob"
combine :: FilePath -> FilePath -> FilePath
-combine a b | isAbsolute b = b
+combine a b | hasDrive b || (not (null b) && isPathSeparator (head b)) = b
| otherwise = combineAlways a b
-- | Combine two paths, assuming rhs is NOT absolute.
@@ -546,7 +568,7 @@
--
-- > splitDirectories "test/file" == ["test","file"]
-- > splitDirectories "/test/file" == ["/","test","file"]
--- > joinPath (splitDirectories (makeValid x)) `equalFilePath` makeValid x
+-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x
-- > splitDirectories "" == []
splitDirectories :: FilePath -> [FilePath]
splitDirectories path =
@@ -562,7 +584,7 @@
-- | Join path elements back together.
--
--- > joinPath (splitPath (makeValid x)) == makeValid x
+-- > Valid x => joinPath (splitPath x) == x
-- > joinPath [] == ""
-- > Posix: joinPath ["test","file","path"] == "test/file/path"
@@ -582,24 +604,36 @@
-- If you call @System.Directory.canonicalizePath@
-- first this has a much better chance of working.
-- Note that this doesn't follow symlinks or DOSNAM~1s.
+--
+-- > x == y ==> equalFilePath x y
+-- > normalise x == normalise y ==> equalFilePath x y
+-- > Posix: equalFilePath "foo" "foo/"
+-- > Posix: not (equalFilePath "foo" "/foo")
+-- > Posix: not (equalFilePath "foo" "FOO")
+-- > Windows: equalFilePath "foo" "FOO"
equalFilePath :: FilePath -> FilePath -> Bool
equalFilePath a b = f a == f b
where
f x | isWindows = dropTrailSlash $ map toLower $ normalise x
| otherwise = dropTrailSlash $ normalise x
- dropTrailSlash "" = ""
- dropTrailSlash x | isPathSeparator (last x) = init x
+ dropTrailSlash x | length x >= 2 && isPathSeparator (last x) = init x
| otherwise = x
-- | Contract a filename, based on a relative path.
--
--- > Windows: makeRelative x (x `combine` y) == y || takeDrive x == x
--- > Posix: makeRelative x (x `combine` y) == y
--- > (isRelative x && makeRelative y x == x) || y `combine` makeRelative y x == x
+-- There is no corresponding @makeAbsolute@ function, instead use
+-- @System.Directory.canonicalizePath@ which has the same effect.
+--
+-- > Valid y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x
+-- > makeRelative x x == "."
+-- > null y || equalFilePath (makeRelative x (x </> y)) y || null (takeFileName x)
-- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob"
+-- > Windows: makeRelative "C:\\Home" "c:/home/bob" == "bob"
-- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"
+-- > Windows: makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"
+-- > Windows: makeRelative "/Home" "/home/bob" == "bob"
-- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob"
-- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"
-- > Posix: makeRelative "/fred" "bob" == "bob"
@@ -608,8 +642,9 @@
-- > Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
makeRelative :: FilePath -> FilePath -> FilePath
makeRelative root path
- | not (takeDrive root `equalFilePath` takeDrive path) = path
- | otherwise = f (dropDrive root) (dropDrive path)
+ | equalFilePath root path = "."
+ | takeAbs root /= takeAbs path = path
+ | otherwise = f (dropAbs root) (dropAbs path)
where
f "" y = dropWhile isPathSeparator y
f x y = let (x1,x2) = g x
@@ -619,6 +654,12 @@
g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)
where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
+ -- on windows, need to drop '/' which is kind of absolute, but not a drive
+ dropAbs (x:xs) | isPathSeparator x = xs
+ dropAbs x = dropDrive x
+
+ takeAbs (x:_) | isPathSeparator x = [pathSeparator]
+ takeAbs x = map (\y -> if isPathSeparator y then pathSeparator else toLower y) $ takeDrive x
-- | Normalise a file
--
@@ -637,6 +678,8 @@
-- > Windows: normalise "c:\\" == "C:\\"
-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"
-- > Windows: normalise "c:/file" == "C:\\file"
+-- > normalise "." == "."
+-- > Posix: normalise "./" == "./"
normalise :: FilePath -> FilePath
normalise path = joinDrive (normaliseDrive drv) (f pth)
++ [pathSeparator | not (null pth) && isPathSeparator (last pth)]
@@ -652,7 +695,7 @@
propSep (x:xs) = x : propSep xs
propSep [] = []
- dropDots acc (".":xs) = dropDots acc xs
+ dropDots acc (".":xs) | not $ null xs = dropDots acc xs
dropDots acc (x:xs) = dropDots (x:acc) xs
dropDots acc [] = reverse acc
@@ -676,17 +719,23 @@
-- | Is a FilePath valid, i.e. could you create a file like it?
--
+-- > isValid "" == False
-- > Posix: isValid "/random_ path:*" == True
--- > Posix: isValid x == True
+-- > Posix: isValid x == not (null x)
-- > Windows: isValid "c:\\test" == True
-- > Windows: isValid "c:\\test:of_test" == False
-- > Windows: isValid "test*" == False
-- > Windows: isValid "c:\\test\\nul" == False
-- > Windows: isValid "c:\\test\\prn.txt" == False
-- > Windows: isValid "c:\\nul\\file" == False
+-- > Windows: isValid "\\\\" == False
isValid :: FilePath -> Bool
+isValid "" = False
isValid _ | isPosix = True
-isValid path = not (any (`elem` badCharacters) x2) && not (any f $ splitDirectories x2)
+isValid path =
+ not (any (`elem` badCharacters) x2) &&
+ not (any f $ splitDirectories x2) &&
+ not (length path >= 2 && all isPathSeparator path)
where
x2 = dropDrive path
f x = map toUpper (dropExtensions x) `elem` badElements
@@ -695,7 +744,8 @@
-- | Take a FilePath and make it valid; does not change already valid FilePaths.
--
-- > isValid (makeValid x)
--- > if isValid x then makeValid x == x else True
+-- > isValid x ==> makeValid x == x
+-- > makeValid "" == "_"
-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"
-- > Windows: makeValid "test*" == "test_"
-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"
@@ -703,7 +753,9 @@
-- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"
-- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"
makeValid :: FilePath -> FilePath
+makeValid "" = "_"
makeValid path | isPosix = path
+makeValid x | length x >= 2 && all isPathSeparator x = take 2 x ++ "drive"
makeValid path = joinDrive drv $ validElements $ validChars pth
where
(drv,pth) = splitDrive path
@@ -715,7 +767,7 @@
validElements x = joinPath $ map g $ splitPath x
g x = h (reverse b) ++ reverse a
where (a,b) = span isPathSeparator $ reverse x
- h x = if map toUpper a `elem` badElements then addExtension (a ++ "_") b else x
+ h x = if map toUpper a `elem` badElements then a ++ "_" <.> b else x
where (a,b) = splitExtensions x
@@ -723,10 +775,25 @@
--
-- > Windows: isRelative "path\\test" == True
-- > Windows: isRelative "c:\\test" == False
+-- > Windows: isRelative "c:test" == True
+-- > Windows: isRelative "c:" == True
+-- > Windows: isRelative "\\\\foo" == False
+-- > Windows: isRelative "/foo" == True
-- > Posix: isRelative "test/path" == True
-- > Posix: isRelative "/test" == False
isRelative :: FilePath -> Bool
-isRelative = null . takeDrive
+isRelative = isRelativeDrive . takeDrive
+
+
+-- > isRelativeDrive "" == True
+-- > Windows: isRelativeDrive "c:\\" == False
+-- > Windows: isRelativeDrive "c:/" == False
+-- > Windows: isRelativeDrive "c:" == True
+-- > Windows: isRelativeDrive "\\\\foo" == False
+-- > Posix: isRelativeDrive "/" == False
+isRelativeDrive :: String -> Bool
+isRelativeDrive x = null x ||
+ maybe False (not . isPathSeparator . last . fst) (readDriveLetter x)
-- | @not . 'isRelative'@
Modified: packages/haskell-filepath/trunk/System/FilePath/Posix.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/trunk/System/FilePath/Posix.hs?rev=1290&op=diff
==============================================================================
--- packages/haskell-filepath/trunk/System/FilePath/Posix.hs (original)
+++ packages/haskell-filepath/trunk/System/FilePath/Posix.hs Sat Jan 17 18:11:28 2009
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
#define MODULE_NAME Posix
#define IS_WINDOWS False
@@ -13,4 +14,11 @@
--
-- A library for FilePath manipulations, using Posix style paths on
-- all platforms. Importing "System.FilePath" is usually better.
+
+-- Unfortunately, this #include breaks when haddocking with Cabal
+#ifdef __HADDOCK__
+module System.FilePath.Posix where
+#else
#include "Internal.hs"
+#endif
+
Modified: packages/haskell-filepath/trunk/System/FilePath/Windows.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/trunk/System/FilePath/Windows.hs?rev=1290&op=diff
==============================================================================
--- packages/haskell-filepath/trunk/System/FilePath/Windows.hs (original)
+++ packages/haskell-filepath/trunk/System/FilePath/Windows.hs Sat Jan 17 18:11:28 2009
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
#define MODULE_NAME Windows
#define IS_WINDOWS True
@@ -13,4 +14,10 @@
--
-- A library for FilePath manipulations, using Windows style paths on
-- all platforms. Importing "System.FilePath" is usually better.
+
+-- Unfortunately, this #include breaks when haddocking with Cabal
+#ifdef __HADDOCK__
+module System.FilePath.Windows where
+#else
#include "Internal.hs"
+#endif
Modified: packages/haskell-filepath/trunk/debian/changelog
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/trunk/debian/changelog?rev=1290&op=diff
==============================================================================
--- packages/haskell-filepath/trunk/debian/changelog (original)
+++ packages/haskell-filepath/trunk/debian/changelog Sat Jan 17 18:11:28 2009
@@ -1,3 +1,9 @@
+haskell-filepath (1.1.0.1-1~pre1) experimental; urgency=low
+
+ * New upstream release
+
+ -- Arjan Oosting <arjan at debian.org> Sat, 17 Jan 2009 19:09:14 +0100
+
haskell-filepath (1.1.0.0-1) unstable; urgency=low
* New upstream release.
Modified: packages/haskell-filepath/trunk/filepath.cabal
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/trunk/filepath.cabal?rev=1290&op=diff
==============================================================================
--- packages/haskell-filepath/trunk/filepath.cabal (original)
+++ packages/haskell-filepath/trunk/filepath.cabal Sat Jan 17 18:11:28 2009
@@ -1,6 +1,7 @@
Name: filepath
-Version: 1.1.0.0
+Version: 1.1.0.1
License: BSD3
+license-file: LICENSE
Author: Neil Mitchell
Homepage: http://www-users.cs.york.ac.uk/~ndm/filepath/
Category: System
More information about the Pkg-haskell-commits
mailing list