[Pkg-haskell-commits] r930 - in /packages/haskell-filepath/branches/upstream/current: LICENSE Makefile Makefile.nhc98 Setup.hs System/FilePath/Internal.hs filepath.cabal make-docs.bat package.conf.in prologue.txt push.bat readme.txt test/
arjan at users.alioth.debian.org
arjan at users.alioth.debian.org
Sun Jan 13 01:13:04 UTC 2008
Author: arjan
Date: Sun Jan 13 01:13:04 2008
New Revision: 930
URL: http://svn.debian.org/wsvn/pkg-haskell/?sc=1&rev=930
Log:
[svn-upgrade] Integrating new upstream version, haskell-filepath (1.1.0.0)
Removed:
packages/haskell-filepath/branches/upstream/current/LICENSE
packages/haskell-filepath/branches/upstream/current/Makefile
packages/haskell-filepath/branches/upstream/current/Makefile.nhc98
packages/haskell-filepath/branches/upstream/current/make-docs.bat
packages/haskell-filepath/branches/upstream/current/package.conf.in
packages/haskell-filepath/branches/upstream/current/prologue.txt
packages/haskell-filepath/branches/upstream/current/push.bat
packages/haskell-filepath/branches/upstream/current/readme.txt
packages/haskell-filepath/branches/upstream/current/test/
Modified:
packages/haskell-filepath/branches/upstream/current/Setup.hs
packages/haskell-filepath/branches/upstream/current/System/FilePath/Internal.hs
packages/haskell-filepath/branches/upstream/current/filepath.cabal
Modified: packages/haskell-filepath/branches/upstream/current/Setup.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/branches/upstream/current/Setup.hs?rev=930&op=diff
==============================================================================
--- packages/haskell-filepath/branches/upstream/current/Setup.hs (original)
+++ packages/haskell-filepath/branches/upstream/current/Setup.hs Sun Jan 13 01:13:04 2008
@@ -1,59 +1,6 @@
-
module Main (main) where
-import Data.List
import Distribution.Simple
-import Distribution.PackageDescription
-import Distribution.Setup
-import Distribution.Simple.LocalBuildInfo
-import System.Environment
main :: IO ()
-main = do args <- getArgs
- let (ghcArgs, args') = extractGhcArgs args
- (_, args'') = extractConfigureArgs args'
- hooks = defaultUserHooks {
- buildHook = add_ghc_options ghcArgs
- $ buildHook defaultUserHooks }
- withArgs args'' $ defaultMainWithHooks hooks
-
-extractGhcArgs :: [String] -> ([String], [String])
-extractGhcArgs = extractPrefixArgs "--ghc-option="
-
-extractConfigureArgs :: [String] -> ([String], [String])
-extractConfigureArgs = extractPrefixArgs "--configure-option="
-
-extractPrefixArgs :: String -> [String] -> ([String], [String])
-extractPrefixArgs the_prefix args
- = let f [] = ([], [])
- f (x:xs) = case f xs of
- (wantedArgs, otherArgs) ->
- case removePrefix the_prefix x of
- Just wantedArg ->
- (wantedArg:wantedArgs, otherArgs)
- Nothing ->
- (wantedArgs, x:otherArgs)
- in f args
-
-removePrefix :: String -> String -> Maybe String
-removePrefix "" ys = Just ys
-removePrefix _ "" = Nothing
-removePrefix (x:xs) (y:ys)
- | x == y = removePrefix xs ys
- | otherwise = Nothing
-
-type Hook a = PackageDescription -> LocalBuildInfo -> Maybe UserHooks -> a
- -> IO ()
-
-add_ghc_options :: [String] -> Hook a -> Hook a
-add_ghc_options args f pd lbi muhs x
- = do let lib' = case library pd of
- Just lib ->
- let bi = libBuildInfo lib
- opts = options bi ++ [(GHC, args)]
- bi' = bi { options = opts }
- in lib { libBuildInfo = bi' }
- Nothing -> error "Expected a library"
- pd' = pd { library = Just lib' }
- f pd' lbi muhs x
-
+main = defaultMain
Modified: packages/haskell-filepath/branches/upstream/current/System/FilePath/Internal.hs
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/branches/upstream/current/System/FilePath/Internal.hs?rev=930&op=diff
==============================================================================
--- packages/haskell-filepath/branches/upstream/current/System/FilePath/Internal.hs (original)
+++ packages/haskell-filepath/branches/upstream/current/System/FilePath/Internal.hs Sun Jan 13 01:13:04 2008
@@ -17,10 +17,6 @@
-- You want to compile a Haskell file, but put the hi file under \"interface\"
--
-- @'takeDirectory' file '</>' \"interface\" '</>' ('takeFileName' file \`replaceExtension\` \"hi\"@)
---
--- You want to display a filename to the user, as neatly as possible
---
--- @'makeRelativeToCurrentDirectory' file >>= putStrLn@
--
-- The examples in code format descibed by each function are used to generate
-- tests, and should give clear semantics for the functions.
@@ -46,12 +42,9 @@
takeExtension, replaceExtension, dropExtension, addExtension, hasExtension, (<.>),
splitExtensions, dropExtensions, takeExtensions,
- -- Note: leave this section to enable some of the tests to work
-#ifdef TESTING
-- * Drive methods
splitDrive, joinDrive,
- takeDrive, replaceDrive, hasDrive, dropDrive, isDrive,
-#endif
+ takeDrive, hasDrive, dropDrive, isDrive,
-- * Operations on a FilePath, as a list of directories
splitFileName,
@@ -68,7 +61,7 @@
-- * File name manipulators
normalise, equalFilePath,
- makeRelativeToCurrentDirectory, makeRelative,
+ makeRelative,
isRelative, isAbsolute,
isValid, makeValid
)
@@ -78,7 +71,6 @@
import Data.Char(toLower, toUpper)
import System.Environment(getEnv)
-import System.Directory(getCurrentDirectory)
infixr 7 <.>
@@ -222,7 +214,7 @@
(<.>) :: FilePath -> String -> FilePath
(<.>) = addExtension
--- | Remove last extension, and any . following it.
+-- | Remove last extension, and the \".\" preceding it.
--
-- > dropExtension x == fst (splitExtension x)
dropExtension :: FilePath -> FilePath
@@ -315,6 +307,7 @@
splitDrive x = ("",x)
+addSlash :: FilePath -> FilePath -> (FilePath, FilePath)
addSlash a xs = (a++c,d)
where (c,d) = span isPathSeparator xs
@@ -330,23 +323,23 @@
_ -> case readDriveLetter xs of
Just (a,b) -> Just (s1:s2:'?':s3:a,b)
Nothing -> Nothing
-readDriveUNC x = Nothing
-
--- c:\
+readDriveUNC _ = Nothing
+
+{- c:\ -}
readDriveLetter :: String -> Maybe (FilePath, FilePath)
readDriveLetter (x:':':y:xs) | isLetter x && isPathSeparator y = Just $ addSlash [x,':'] (y:xs)
readDriveLetter (x:':':xs) | isLetter x = Just ([x,':'], xs)
-readDriveLetter x = Nothing
-
--- \\sharename\
+readDriveLetter _ = Nothing
+
+{- \\sharename\ -}
readDriveShare :: String -> Maybe (FilePath, FilePath)
readDriveShare (s1:s2:xs) | isPathSeparator s1 && isPathSeparator s2 =
Just (s1:s2:a,b)
where (a,b) = readDriveShareName xs
-readDriveShare x = Nothing
-
--- assume you have already seen \\
--- share\bob -> "share","\","bob"
+readDriveShare _ = Nothing
+
+{- assume you have already seen \\ -}
+{- share\bob -> "share","\","bob" -}
readDriveShareName :: String -> (FilePath, FilePath)
readDriveShareName name = addSlash a b
where (a,b) = break isPathSeparator name
@@ -365,12 +358,6 @@
[a1,':'] | isLetter a1 -> a ++ b
_ -> a ++ [pathSeparator] ++ b
--- | Set the drive, from the filepath.
---
--- > replaceDrive x (takeDrive x) == x
-replaceDrive :: FilePath -> String -> FilePath
-replaceDrive x drv = joinDrive drv (dropDrive x)
-
-- | Get the drive from a filepath.
--
-- > takeDrive x == fst (splitDrive x)
@@ -545,14 +532,14 @@
-- > Windows: splitPath "c:\\test\\path" == ["c:\\","test\\","path"]
-- > Posix: splitPath "/file/test" == ["/","file/","test"]
splitPath :: FilePath -> [FilePath]
-splitPath x = [a | a /= ""] ++ f b
- where
- (a,b) = splitDrive x
+splitPath x = [drive | drive /= ""] ++ f path
+ where
+ (drive,path) = splitDrive x
f "" = []
- f x = (a++c) : f d
+ f y = (a++c) : f d
where
- (a,b) = break isPathSeparator x
+ (a,b) = break isPathSeparator y
(c,d) = break (not . isPathSeparator) b
-- | Just as 'splitPath', but don't add the trailing slashes to each element.
@@ -562,11 +549,11 @@
-- > joinPath (splitDirectories (makeValid x)) `equalFilePath` makeValid x
-- > splitDirectories "" == []
splitDirectories :: FilePath -> [FilePath]
-splitDirectories x =
- if hasDrive x then head xs : f (tail xs)
- else f xs
- where
- xs = splitPath x
+splitDirectories path =
+ if hasDrive path then head pathComponents : f (tail pathComponents)
+ else f pathComponents
+ where
+ pathComponents = splitPath path
f xs = map g xs
g x = if null res then x else res
@@ -576,6 +563,8 @@
-- | Join path elements back together.
--
-- > joinPath (splitPath (makeValid x)) == makeValid x
+-- > joinPath [] == ""
+-- > Posix: joinPath ["test","file","path"] == "test/file/path"
-- Note that this definition on c:\\c:\\, join then split will give c:\\.
joinPath :: [FilePath] -> FilePath
@@ -606,28 +595,29 @@
-- | 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
+-- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob"
+-- > Windows: makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"
+-- > Posix: makeRelative "/Home" "/home/bob" == "/home/bob"
-- > Posix: makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"
-- > Posix: makeRelative "/fred" "bob" == "bob"
-- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred"
-- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/"
--- > Posix: makeRelative "/fred/dave" "/fred/bill" == "../bill"
+-- > Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
makeRelative :: FilePath -> FilePath -> FilePath
-makeRelative cur x | isRelative x || isRelative cur || not (takeDrive x `equalFilePath` takeDrive cur) = normalise x
-makeRelative cur x = joinPath $
- replicate (length curdir - common) ".." ++
- drop common orgpth
- where
- common = length $ takeWhile id $ zipWith (==) orgdir curdir
- orgpth = splitPath pth
- orgdir = splitDirectories pth
- curdir = splitDirectories $ dropDrive $ normalise $ cur
- (drv,pth) = splitDrive $ normalise x
-
--- | 'makeRelative' the current directory.
-makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
-makeRelativeToCurrentDirectory x = do
- cur <- getCurrentDirectory
- return $ makeRelative cur x
+makeRelative root 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
+ (y1,y2) = g y
+ in if equalFilePath x1 y1 then f x2 y2 else path
+
+ g x = (dropWhile isPathSeparator a, dropWhile isPathSeparator b)
+ where (a,b) = break isPathSeparator $ dropWhile isPathSeparator x
-- | Normalise a file
@@ -644,20 +634,21 @@
-- > Posix: normalise "../bob/fred/" == "../bob/fred/"
-- > Posix: normalise "./bob/fred/" == "bob/fred/"
-- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"
+-- > Windows: normalise "c:\\" == "C:\\"
-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"
-- > Windows: normalise "c:/file" == "C:\\file"
normalise :: FilePath -> FilePath
-normalise "" = ""
-normalise x = joinDrive (normaliseDrive drv) (f pth) ++ [pathSeparator | isPathSeparator $ last x]
- where
- (drv,pth) = splitDrive x
+normalise path = joinDrive (normaliseDrive drv) (f pth)
+ ++ [pathSeparator | not (null pth) && isPathSeparator (last pth)]
+ where
+ (drv,pth) = splitDrive path
f = joinPath . dropDots [] . splitDirectories . propSep
- g x = if isPathSeparator x then pathSeparator else x
-
- propSep (a:b:xs) | isPathSeparator a && isPathSeparator b = propSep (a:xs)
- propSep (a:xs) | isPathSeparator a = pathSeparator : propSep xs
+ propSep (a:b:xs)
+ | isPathSeparator a && isPathSeparator b = propSep (a:xs)
+ propSep (a:xs)
+ | isPathSeparator a = pathSeparator : propSep xs
propSep (x:xs) = x : propSep xs
propSep [] = []
@@ -666,19 +657,20 @@
dropDots acc [] = reverse acc
normaliseDrive :: FilePath -> FilePath
-normaliseDrive x | isPosix = x
-normaliseDrive x = if isJust $ readDriveLetter x2 then
- map toUpper x2
- else
- x
- where
- x2 = map repSlash x
+normaliseDrive drive | isPosix = drive
+normaliseDrive drive = if isJust $ readDriveLetter x2
+ then map toUpper x2
+ else drive
+ where
+ x2 = map repSlash drive
repSlash x = if isPathSeparator x then pathSeparator else x
-- information for validity functions on Windows
-- see http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp
+badCharacters :: [Char]
badCharacters = ":*?><|"
+badElements :: [FilePath]
badElements = ["CON", "PRN", "AUX", "NUL", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9", "CLOCK$"]
@@ -693,10 +685,10 @@
-- > Windows: isValid "c:\\test\\prn.txt" == False
-- > Windows: isValid "c:\\nul\\file" == False
isValid :: FilePath -> Bool
-isValid x | isPosix = True
-isValid x = not (any (`elem` badCharacters) x2) && not (any f $ splitDirectories x2)
- where
- x2 = dropDrive x
+isValid _ | isPosix = True
+isValid path = not (any (`elem` badCharacters) x2) && not (any f $ splitDirectories x2)
+ where
+ x2 = dropDrive path
f x = map toUpper (dropExtensions x) `elem` badElements
@@ -711,10 +703,10 @@
-- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"
-- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"
makeValid :: FilePath -> FilePath
-makeValid x | isPosix = x
-makeValid x = joinDrive drv $ validElements $ validChars pth
- where
- (drv,pth) = splitDrive x
+makeValid path | isPosix = path
+makeValid path = joinDrive drv $ validElements $ validChars pth
+ where
+ (drv,pth) = splitDrive path
validChars x = map f x
f x | x `elem` badCharacters = '_'
Modified: packages/haskell-filepath/branches/upstream/current/filepath.cabal
URL: http://svn.debian.org/wsvn/pkg-haskell/packages/haskell-filepath/branches/upstream/current/filepath.cabal?rev=930&op=diff
==============================================================================
--- packages/haskell-filepath/branches/upstream/current/filepath.cabal (original)
+++ packages/haskell-filepath/branches/upstream/current/filepath.cabal Sun Jan 13 01:13:04 2008
@@ -1,9 +1,10 @@
Name: filepath
-Version: 1.0
+Version: 1.1.0.0
License: BSD3
Author: Neil Mitchell
Homepage: http://www-users.cs.york.ac.uk/~ndm/filepath/
Category: System
+build-type: Simple
Build-Depends: base
Synopsis: Library for manipulating FilePath's in a cross platform way.
Exposed-modules:
More information about the Pkg-haskell-commits
mailing list