filepath 1.0 → 1.1.0.0
raw patch · 3 files changed
+49/−116 lines, 3 filesdep ~basesetup-changednew-uploader
Dependency ranges changed: base
Files
- Setup.hs +1/−55
- System/FilePath/Internal.hs +46/−60
- filepath.cabal +2/−1
Setup.hs view
@@ -1,60 +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 -> UserHooks -> a -> IO ()---- We can't give a type signature as Cabal < 1.1.7 has Maybe UserHooks--- where we have UserHooks.--- add_ghc_options :: [String] -> Hook a -> Hook a-add_ghc_options args f pd lbi uhs 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 uhs x-+main = defaultMain
System/FilePath/Internal.hs view
@@ -18,10 +18,6 @@ -- -- @'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 <.>@@ -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+readDriveUNC _ = Nothing --- c:\+{- 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+readDriveLetter _ = Nothing --- \\sharename\+{- \\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+readDriveShare _ = Nothing --- assume you have already seen \\--- share\bob -> "share","\","bob"+{- 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+splitPath x = [drive | drive /= ""] ++ f path where- (a,b) = splitDrive x+ (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+splitDirectories path =+ if hasDrive path then head pathComponents : f (tail pathComponents)+ else f pathComponents where- xs = splitPath x+ 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@@ -610,6 +599,7 @@ -- > 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"@@ -617,25 +607,19 @@ -- > Posix: makeRelative "/file/test" "/file/test/fred/" == "fred/" -- > Posix: makeRelative "some/path" "some/path/a/b/c" == "a/b/c" makeRelative :: FilePath -> FilePath -> FilePath-makeRelative x y | not (takeDrive x `equalFilePath` takeDrive y) = y-makeRelative x orig = f (dropDrive x) (dropDrive orig)+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 orig+ 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 --- | 'makeRelative' the current directory.-makeRelativeToCurrentDirectory :: FilePath -> IO FilePath-makeRelativeToCurrentDirectory x = do- cur <- getCurrentDirectory- return $ makeRelative cur x-- -- | Normalise a file -- -- * \/\/ outside of the drive can be made blank@@ -650,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]+normalise path = joinDrive (normaliseDrive drv) (f pth)+ ++ [pathSeparator | not (null pth) && isPathSeparator (last pth)] where- (drv,pth) = splitDrive x+ (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 [] = [] @@ -672,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+normaliseDrive drive | isPosix = drive+normaliseDrive drive = if isJust $ readDriveLetter x2+ then map toUpper x2+ else drive where- x2 = map repSlash x+ 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$"] @@ -699,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)+isValid _ | isPosix = True+isValid path = not (any (`elem` badCharacters) x2) && not (any f $ splitDirectories x2) where- x2 = dropDrive x+ x2 = dropDrive path f x = map toUpper (dropExtensions x) `elem` badElements @@ -717,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+makeValid path | isPosix = path+makeValid path = joinDrive drv $ validElements $ validChars pth where- (drv,pth) = splitDrive x+ (drv,pth) = splitDrive path validChars x = map f x f x | x `elem` badCharacters = '_'
filepath.cabal view
@@ -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: