[Pkg-haskell-commits] r1292 - in /packages/haskell-filepath/branches/upstream/1.1.0.1: System/FilePath.hs System/FilePath/Internal.hs System/FilePath/Posix.hs System/FilePath/Windows.hs filepath.cabal
arjan at users.alioth.debian.org
arjan at users.alioth.debian.org
Sat Jan 17 18:16:44 UTC 2009
Author: arjan
Date: Sat Jan 17 18:16:44 2009
New Revision: 1292
URL: http://svn.debian.org/wsvn/pkg-haskell/?sc=1&rev=1292
Log:
Sync trees
Modified:
packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath.hs
packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Internal.hs
packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Posix.hs
packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Windows.hs
packages/haskell-filepath/branches/upstream/1.1.0.1/filepath.cabal
Modified: packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath.hs?rev=1292&op=diff
==============================================================================
--- packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath.hs (original)
+++ packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath.hs Sat Jan 17 18:16:44 2009
@@ -1,4 +1,4 @@
-{-# LANGUAGE CPP #-}
+
{- |
Module : System.FilePath
Copyright : (c) Neil Mitchell 2005-2007
Modified: packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Internal.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Internal.hs?rev=1292&op=diff
==============================================================================
--- packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Internal.hs (original)
+++ packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Internal.hs Sat Jan 17 18:16:44 2009
@@ -64,16 +64,11 @@
makeRelative,
isRelative, isAbsolute,
isValid, makeValid
-
-#ifdef TESTING
- , isRelativeDrive
-#endif
-
)
where
+import Data.Maybe(isJust, fromJust)
import Data.Char(toLower, toUpper)
-import Data.Maybe(isJust, fromJust)
import System.Environment(getEnv)
@@ -159,23 +154,16 @@
-- | Take a string, split it on the 'searchPathSeparator' character.
--
--- 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"]
+-- > Windows: splitSearchPath "File1;File2;File3" == ["File1","File2","File3"]
+-- > Posix: splitSearchPath "File1:File2:File3" == ["File1","File2","File3"]
splitSearchPath :: String -> [FilePath]
splitSearchPath = f
where
f xs = case break isSearchPathSeparator xs of
- (pre, [] ) -> g pre
- (pre, _:post) -> g pre ++ f post
-
- g "" = ["." | isPosix]
- g x = [x]
-
+ ([], []) -> []
+ ([], post) -> f (tail post)
+ (pre, []) -> [pre]
+ (pre, post) -> pre : f (tail post)
-- | Get a list of filepaths in the $PATH.
getSearchPath :: IO [FilePath]
@@ -207,8 +195,8 @@
-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
--
-- > takeExtension x == snd (splitExtension x)
--- > Valid x => takeExtension (addExtension x "ext") == ".ext"
--- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"
+-- > takeExtension (addExtension x "ext") == ".ext"
+-- > takeExtension (replaceExtension x "ext") == ".ext"
takeExtension :: FilePath -> String
takeExtension = snd . splitExtension
@@ -239,7 +227,7 @@
-- > addExtension "file." ".bib" == "file..bib"
-- > addExtension "file" ".bib" == "file.bib"
-- > addExtension "/" "x" == "/.x"
--- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
+-- > takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
addExtension :: FilePath -> String -> FilePath
addExtension file "" = file
@@ -273,8 +261,6 @@
dropExtensions = fst . splitExtensions
-- | Get all extensions
---
--- > takeExtensions "file.tar.gz" == ".tar.gz"
takeExtensions :: FilePath -> String
takeExtensions = snd . splitExtensions
@@ -299,9 +285,8 @@
-- > 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")
@@ -317,6 +302,8 @@
splitDrive x | isJust y = fromJust y
where y = readDriveShare x
+
+splitDrive (x:xs) | isPathSeparator x = addSlash [x] xs
splitDrive x = ("",x)
@@ -361,11 +348,7 @@
-- | Join a drive and the rest of the path.
--
--- > 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"
+-- > uncurry joinDrive (splitDrive x) == x
joinDrive :: FilePath -> FilePath -> FilePath
joinDrive a b | isPosix = a ++ b
| null a = b
@@ -405,7 +388,7 @@
-- | Split a filename into directory and file. 'combine' is the inverse.
--
-- > uncurry (++) (splitFileName x) == x
--- > Valid x => uncurry combine (splitFileName x) == x
+-- > uncurry combine (splitFileName (makeValid x)) == (makeValid x)
-- > splitFileName "file/bob.txt" == ("file/", "bob.txt")
-- > splitFileName "file/" == ("file/", "")
-- > splitFileName "bob" == ("", "bob")
@@ -420,9 +403,9 @@
-- | Set the filename.
--
--- > Valid x => replaceFileName x (takeFileName x) == x
+-- > replaceFileName (makeValid x) (takeFileName (makeValid x)) == makeValid x
replaceFileName :: FilePath -> String -> FilePath
-replaceFileName x y = dropFileName x </> y
+replaceFileName x y = dropFileName x `combine` y
-- | Drop the filename.
--
@@ -434,11 +417,10 @@
-- | Get the file name.
--
-- > takeFileName "test/" == ""
--- > takeFileName x `isSuffixOf` x
-- > takeFileName x == snd (splitFileName x)
--- > Valid x => takeFileName (replaceFileName x "fred") == "fred"
--- > Valid x => takeFileName (x </> "fred") == "fred"
--- > Valid x => isRelative (takeFileName x)
+-- > takeFileName (replaceFileName x "fred") == "fred"
+-- > takeFileName (combine x "fred") == "fred"
+-- > isRelative (takeFileName (makeValid x))
takeFileName :: FilePath -> FilePath
takeFileName = snd . splitFileName
@@ -460,7 +442,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 (nam <.> ext)
+replaceBaseName pth nam = combineAlways a (addExtension nam ext)
where
(a,b) = splitFileName pth
ext = takeExtension b
@@ -477,7 +459,7 @@
-- | Add a trailing file path separator if one is not already present.
--
-- > hasTrailingPathSeparator (addTrailingPathSeparator x)
--- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x
+-- > if hasTrailingPathSeparator x then addTrailingPathSeparator x == x else True
-- > Posix: addTrailingPathSeparator "test/rest" == "test/rest/"
addTrailingPathSeparator :: FilePath -> FilePath
addTrailingPathSeparator x = if hasTrailingPathSeparator x then x else x ++ [pathSeparator]
@@ -497,11 +479,8 @@
-- | Get the directory name, move up one level.
--
--- > 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"
+-- > Posix: takeDirectory "/foo/bar/baz" == "/foo/bar"
+-- > Posix: takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"
-- > Windows: takeDirectory "foo\\bar" == "foo"
-- > Windows: takeDirectory "foo\\bar\\\\" == "foo\\bar"
-- > Windows: takeDirectory "C:\\" == "C:\\"
@@ -522,13 +501,12 @@
-- | Combine two paths, if the second path 'isAbsolute', then it returns the second.
--
--- > Valid x => combine (takeDirectory x) (takeFileName x) `equalFilePath` x
+-- > combine (takeDirectory (makeValid x)) (takeFileName (makeValid x)) `equalFilePath` makeValid 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 | hasDrive b || (not (null b) && isPathSeparator (head b)) = b
+combine a b | isAbsolute b = b
| otherwise = combineAlways a b
-- | Combine two paths, assuming rhs is NOT absolute.
@@ -568,7 +546,7 @@
--
-- > splitDirectories "test/file" == ["test","file"]
-- > splitDirectories "/test/file" == ["/","test","file"]
--- > Valid x => joinPath (splitDirectories x) `equalFilePath` x
+-- > joinPath (splitDirectories (makeValid x)) `equalFilePath` makeValid x
-- > splitDirectories "" == []
splitDirectories :: FilePath -> [FilePath]
splitDirectories path =
@@ -584,7 +562,7 @@
-- | Join path elements back together.
--
--- > Valid x => joinPath (splitPath x) == x
+-- > joinPath (splitPath (makeValid x)) == makeValid x
-- > joinPath [] == ""
-- > Posix: joinPath ["test","file","path"] == "test/file/path"
@@ -604,36 +582,24 @@
-- 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 x | length x >= 2 && isPathSeparator (last x) = init x
+ dropTrailSlash "" = ""
+ dropTrailSlash x | isPathSeparator (last x) = init x
| otherwise = x
-- | Contract a filename, based on a relative path.
--
--- 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 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
-- > 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"
@@ -642,9 +608,8 @@
-- > Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
makeRelative :: FilePath -> FilePath -> FilePath
makeRelative root path
- | equalFilePath root path = "."
- | takeAbs root /= takeAbs path = path
- | otherwise = f (dropAbs root) (dropAbs path)
+ | not (takeDrive root `equalFilePath` takeDrive path) = path
+ | otherwise = f (dropDrive root) (dropDrive path)
where
f "" y = dropWhile isPathSeparator y
f x y = let (x1,x2) = g x
@@ -654,12 +619,6 @@
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
--
@@ -678,8 +637,6 @@
-- > 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)]
@@ -695,7 +652,7 @@
propSep (x:xs) = x : propSep xs
propSep [] = []
- dropDots acc (".":xs) | not $ null xs = dropDots acc xs
+ dropDots acc (".":xs) = dropDots acc xs
dropDots acc (x:xs) = dropDots (x:acc) xs
dropDots acc [] = reverse acc
@@ -719,23 +676,17 @@
-- | Is a FilePath valid, i.e. could you create a file like it?
--
--- > isValid "" == False
-- > Posix: isValid "/random_ path:*" == True
--- > Posix: isValid x == not (null x)
+-- > Posix: isValid x == True
-- > 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) &&
- not (length path >= 2 && all isPathSeparator path)
+isValid path = not (any (`elem` badCharacters) x2) && not (any f $ splitDirectories x2)
where
x2 = dropDrive path
f x = map toUpper (dropExtensions x) `elem` badElements
@@ -744,8 +695,7 @@
-- | Take a FilePath and make it valid; does not change already valid FilePaths.
--
-- > isValid (makeValid x)
--- > isValid x ==> makeValid x == x
--- > makeValid "" == "_"
+-- > if isValid x then makeValid x == x else True
-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"
-- > Windows: makeValid "test*" == "test_"
-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"
@@ -753,9 +703,7 @@
-- > 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
@@ -767,7 +715,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 a ++ "_" <.> b else x
+ h x = if map toUpper a `elem` badElements then addExtension (a ++ "_") b else x
where (a,b) = splitExtensions x
@@ -775,25 +723,10 @@
--
-- > 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 = 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)
+isRelative = null . takeDrive
-- | @not . 'isRelative'@
Modified: packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Posix.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Posix.hs?rev=1292&op=diff
==============================================================================
--- packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Posix.hs (original)
+++ packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Posix.hs Sat Jan 17 18:16:44 2009
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
#define MODULE_NAME Posix
#define IS_WINDOWS False
@@ -14,11 +13,4 @@
--
-- 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/branches/upstream/1.1.0.1/System/FilePath/Windows.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Windows.hs?rev=1292&op=diff
==============================================================================
--- packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Windows.hs (original)
+++ packages/haskell-filepath/branches/upstream/1.1.0.1/System/FilePath/Windows.hs Sat Jan 17 18:16:44 2009
@@ -1,4 +1,3 @@
-{-# LANGUAGE CPP #-}
#define MODULE_NAME Windows
#define IS_WINDOWS True
@@ -14,10 +13,4 @@
--
-- 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/branches/upstream/1.1.0.1/filepath.cabal
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/branches/upstream/1.1.0.1/filepath.cabal?rev=1292&op=diff
==============================================================================
--- packages/haskell-filepath/branches/upstream/1.1.0.1/filepath.cabal (original)
+++ packages/haskell-filepath/branches/upstream/1.1.0.1/filepath.cabal Sat Jan 17 18:16:44 2009
@@ -1,7 +1,6 @@
Name: filepath
-Version: 1.1.0.1
+Version: 1.1.0.0
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