diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,60 @@ + +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 + diff --git a/System/FilePath.hs b/System/FilePath.hs new file mode 100644 --- /dev/null +++ b/System/FilePath.hs @@ -0,0 +1,28 @@ + +{- | +Module : System.FilePath +Copyright : (c) Neil Mitchell 2005-2007 +License : BSD-style (see the file libraries/base/LICENSE) + +Maintainer : libraries@haskell.org +Stability : stable +Portability : portable + +A library for 'FilePath' manipulations, using Posix or Windows filepaths +depending on the platform. + +Both "System.FilePath.Posix" and "System.FilePath.Windows" provide the +same interface. See either for examples and a list of the available +functions. +-} + +#if defined(mingw32_HOST_OS) || defined(__MINGW32__) +module System.FilePath(module System.FilePath.Windows) where +import System.FilePath.Windows +#else +module System.FilePath(module System.FilePath.Posix) where +import System.FilePath.Posix +#endif + + + diff --git a/System/FilePath/Internal.hs b/System/FilePath/Internal.hs new file mode 100644 --- /dev/null +++ b/System/FilePath/Internal.hs @@ -0,0 +1,750 @@ +-- +-- Some short examples: +-- +-- You are given a C file, you want to figure out the corresponding object (.o) file: +-- +-- @'replaceExtension' file \"o\"@ +-- +-- Haskell module Main imports Test, you have the file named main: +-- +-- @['replaceFileName' path_to_main \"Test\" '<.>' ext | ext <- [\"hs\",\"lhs\"] ]@ +-- +-- You want to download a file from the web and save it to disk: +-- +-- @do let file = 'makeValid' url +-- System.IO.createDirectoryIfMissing True ('takeDirectory' file)@ +-- +-- 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. +----------------------------------------------------------------------------- + +-- expects CPP definitions for: +-- MODULE_NAME = Posix | Windows +-- IS_WINDOWS = False | True + +module System.FilePath.MODULE_NAME + ( + -- * Separator predicates + FilePath, + pathSeparator, pathSeparators, isPathSeparator, + searchPathSeparator, isSearchPathSeparator, + extSeparator, isExtSeparator, + + -- * Path methods (environment $PATH) + splitSearchPath, getSearchPath, + + -- * Extension methods + splitExtension, + 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 + + -- * Operations on a FilePath, as a list of directories + splitFileName, + takeFileName, replaceFileName, dropFileName, + takeBaseName, replaceBaseName, + takeDirectory, replaceDirectory, + combine, (), + splitPath, joinPath, splitDirectories, + + -- * Low level FilePath operators + hasTrailingPathSeparator, + addTrailingPathSeparator, + dropTrailingPathSeparator, + + -- * File name manipulators + normalise, equalFilePath, + makeRelativeToCurrentDirectory, makeRelative, + isRelative, isAbsolute, + isValid, makeValid + ) + where + +import Data.Maybe(isJust, fromJust) +import Data.Char(toLower, toUpper) + +import System.Environment(getEnv) +import System.Directory(getCurrentDirectory) + + +infixr 7 <.> +infixr 5 + + + + + +--------------------------------------------------------------------- +-- Platform Abstraction Methods (private) + +-- | Is the operating system Unix or Linux like +isPosix :: Bool +isPosix = not isWindows + +-- | Is the operating system Windows like +isWindows :: Bool +isWindows = IS_WINDOWS + + +--------------------------------------------------------------------- +-- The basic functions + +-- | The character that separates directories. In the case where more than +-- one character is possible, 'pathSeparator' is the \'ideal\' one. +-- +-- > Windows: pathSeparator == '\\' +-- > Posix: pathSeparator == '/' +-- > isPathSeparator pathSeparator +pathSeparator :: Char +pathSeparator = if isWindows then '\\' else '/' + +-- | The list of all possible separators. +-- +-- > Windows: pathSeparators == ['\\', '/'] +-- > Posix: pathSeparators == ['/'] +-- > pathSeparator `elem` pathSeparators +pathSeparators :: [Char] +pathSeparators = if isWindows then "\\/" else "/" + +-- | Rather than using @(== 'pathSeparator')@, use this. Test if something +-- is a path separator. +-- +-- > isPathSeparator a == (a `elem` pathSeparators) +isPathSeparator :: Char -> Bool +isPathSeparator = (`elem` pathSeparators) + + +-- | The character that is used to separate the entries in the $PATH environment variable. +-- +-- > Windows: searchPathSeparator == ';' +-- > Posix: searchPathSeparator == ':' +searchPathSeparator :: Char +searchPathSeparator = if isWindows then ';' else ':' + +-- | Is the character a file separator? +-- +-- > isSearchPathSeparator a == (a == searchPathSeparator) +isSearchPathSeparator :: Char -> Bool +isSearchPathSeparator = (== searchPathSeparator) + + +-- | File extension character +-- +-- > extSeparator == '.' +extSeparator :: Char +extSeparator = '.' + +-- | Is the character an extension character? +-- +-- > isExtSeparator a == (a == extSeparator) +isExtSeparator :: Char -> Bool +isExtSeparator = (== extSeparator) + + + + +--------------------------------------------------------------------- +-- Path methods (environment $PATH) + +-- | 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"] +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) + +-- | Get a list of filepaths in the $PATH. +getSearchPath :: IO [FilePath] +getSearchPath = fmap splitSearchPath (getEnv "PATH") + + +--------------------------------------------------------------------- +-- Extension methods + +-- | Split on the extension. 'addExtension' is the inverse. +-- +-- > uncurry (++) (splitExtension x) == x +-- > uncurry addExtension (splitExtension x) == x +-- > splitExtension "file.txt" == ("file",".txt") +-- > splitExtension "file" == ("file","") +-- > splitExtension "file/file.txt" == ("file/file",".txt") +-- > splitExtension "file.txt/boris" == ("file.txt/boris","") +-- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext") +-- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred") +-- > splitExtension "file/path.txt/" == ("file/path.txt/","") +splitExtension :: FilePath -> (String, String) +splitExtension x = case d of + "" -> (x,"") + (y:ys) -> (a ++ reverse ys, y : reverse c) + where + (a,b) = splitFileName x + (c,d) = break isExtSeparator $ reverse b + +-- | 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" +takeExtension :: FilePath -> String +takeExtension = snd . splitExtension + +-- | Set the extension of a file, overwriting one if already present. +-- +-- > replaceExtension "file.txt" ".bob" == "file.bob" +-- > replaceExtension "file.txt" "bob" == "file.bob" +-- > replaceExtension "file" ".bob" == "file.bob" +-- > replaceExtension "file.txt" "" == "file" +-- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt" +replaceExtension :: FilePath -> String -> FilePath +replaceExtension x y = dropExtension x <.> y + +-- | Alias to 'addExtension', for people who like that sort of thing. +(<.>) :: FilePath -> String -> FilePath +(<.>) = addExtension + +-- | Remove last extension, and the \".\" preceding it. +-- +-- > dropExtension x == fst (splitExtension x) +dropExtension :: FilePath -> FilePath +dropExtension = fst . splitExtension + +-- | Add an extension, even if there is already one there. +-- E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@. +-- +-- > addExtension "file.txt" "bib" == "file.txt.bib" +-- > addExtension "file." ".bib" == "file..bib" +-- > addExtension "file" ".bib" == "file.bib" +-- > addExtension "/" "x" == "/.x" +-- > takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext" +-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt" +addExtension :: FilePath -> String -> FilePath +addExtension file "" = file +addExtension file xs@(x:_) = joinDrive a res + where + res = if isExtSeparator x then b ++ xs + else b ++ [extSeparator] ++ xs + + (a,b) = splitDrive file + +-- | Does the given filename have an extension? +-- +-- > null (takeExtension x) == not (hasExtension x) +hasExtension :: FilePath -> Bool +hasExtension = any isExtSeparator . takeFileName + + +-- | Split on all extensions +-- +-- > splitExtensions "file.tar.gz" == ("file",".tar.gz") +splitExtensions :: FilePath -> (FilePath, String) +splitExtensions x = (a ++ c, d) + where + (a,b) = splitFileName x + (c,d) = break isExtSeparator b + +-- | Drop all extensions +-- +-- > not $ hasExtension (dropExtensions x) +dropExtensions :: FilePath -> FilePath +dropExtensions = fst . splitExtensions + +-- | Get all extensions +takeExtensions :: FilePath -> String +takeExtensions = snd . splitExtensions + + + +--------------------------------------------------------------------- +-- Drive methods + +-- | Is the given character a valid drive letter? +-- only a-z and A-Z are letters, not isAlpha which is more unicodey +isLetter :: Char -> Bool +isLetter x = (x >= 'a' && x <= 'z') || (x >= 'A' && x <= 'Z') + + +-- | Split a path into a drive and a path. +-- On Unix, \/ is a Drive. +-- +-- > uncurry (++) (splitDrive x) == x +-- > Windows: splitDrive "file" == ("","file") +-- > Windows: splitDrive "c:/file" == ("c:/","file") +-- > Windows: splitDrive "c:\\file" == ("c:\\","file") +-- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test") +-- > Windows: splitDrive "\\\\shared" == ("\\\\shared","") +-- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file") +-- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file") +-- > Windows: splitDrive "/d" == ("/","d") +-- > Posix: splitDrive "/test" == ("/","test") +-- > Posix: splitDrive "//test" == ("//","test") +-- > Posix: splitDrive "test/file" == ("","test/file") +-- > Posix: splitDrive "file" == ("","file") +splitDrive :: FilePath -> (FilePath, FilePath) +splitDrive x | isPosix = span (== '/') x + +splitDrive x | isJust y = fromJust y + where y = readDriveLetter x + +splitDrive x | isJust y = fromJust y + where y = readDriveUNC x + +splitDrive x | isJust y = fromJust y + where y = readDriveShare x + +splitDrive (x:xs) | isPathSeparator x = addSlash [x] xs + +splitDrive x = ("",x) + +addSlash a xs = (a++c,d) + where (c,d) = span isPathSeparator xs + +-- http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp +-- "\\?\D:\" or "\\?\UNC\\" +-- a is "\\?\" +readDriveUNC :: FilePath -> Maybe (FilePath, FilePath) +readDriveUNC (s1:s2:'?':s3:xs) | all isPathSeparator [s1,s2,s3] = + case map toUpper xs of + ('U':'N':'C':s4:_) | isPathSeparator s4 -> + let (a,b) = readDriveShareName (drop 4 xs) + in Just (s1:s2:'?':s3:take 4 xs ++ a, b) + _ -> case readDriveLetter xs of + Just (a,b) -> Just (s1:s2:'?':s3:a,b) + Nothing -> Nothing +readDriveUNC x = 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\ +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" +readDriveShareName :: String -> (FilePath, FilePath) +readDriveShareName name = addSlash a b + where (a,b) = break isPathSeparator name + + + +-- | Join a drive and the rest of the path. +-- +-- > uncurry joinDrive (splitDrive x) == x +joinDrive :: FilePath -> FilePath -> FilePath +joinDrive a b | isPosix = a ++ b + | null a = b + | null b = a + | isPathSeparator (last a) = a ++ b + | otherwise = case a of + [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) +takeDrive :: FilePath -> FilePath +takeDrive = fst . splitDrive + +-- | Delete the drive, if it exists. +-- +-- > dropDrive x == snd (splitDrive x) +dropDrive :: FilePath -> FilePath +dropDrive = snd . splitDrive + +-- | Does a path have a drive. +-- +-- > not (hasDrive x) == null (takeDrive x) +hasDrive :: FilePath -> Bool +hasDrive = not . null . takeDrive + + +-- | Is an element a drive +isDrive :: FilePath -> Bool +isDrive = null . dropDrive + + +--------------------------------------------------------------------- +-- Operations on a filepath, as a list of directories + +-- | Split a filename into directory and file. 'combine' is the inverse. +-- +-- > uncurry (++) (splitFileName x) == x +-- > uncurry combine (splitFileName (makeValid x)) == (makeValid x) +-- > splitFileName "file/bob.txt" == ("file/", "bob.txt") +-- > splitFileName "file/" == ("file/", "") +-- > splitFileName "bob" == ("", "bob") +-- > Posix: splitFileName "/" == ("/","") +-- > Windows: splitFileName "c:" == ("c:","") +splitFileName :: FilePath -> (String, String) +splitFileName x = (c ++ reverse b, reverse a) + where + (a,b) = break isPathSeparator $ reverse d + (c,d) = splitDrive x + + +-- | Set the filename. +-- +-- > replaceFileName (makeValid x) (takeFileName (makeValid x)) == makeValid x +replaceFileName :: FilePath -> String -> FilePath +replaceFileName x y = dropFileName x `combine` y + +-- | Drop the filename. +-- +-- > dropFileName x == fst (splitFileName x) +dropFileName :: FilePath -> FilePath +dropFileName = fst . splitFileName + + +-- | Get the file name. +-- +-- > takeFileName "test/" == "" +-- > takeFileName x == snd (splitFileName x) +-- > takeFileName (replaceFileName x "fred") == "fred" +-- > takeFileName (combine x "fred") == "fred" +-- > isRelative (takeFileName (makeValid x)) +takeFileName :: FilePath -> FilePath +takeFileName = snd . splitFileName + +-- | Get the base name, without an extension or path. +-- +-- > takeBaseName "file/test.txt" == "test" +-- > takeBaseName "dave.ext" == "dave" +-- > takeBaseName "" == "" +-- > takeBaseName "test" == "test" +-- > takeBaseName (addTrailingPathSeparator x) == "" +-- > takeBaseName "file/file.tar.gz" == "file.tar" +takeBaseName :: FilePath -> String +takeBaseName = dropExtension . takeFileName + +-- | Set the base name. +-- +-- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt" +-- > replaceBaseName "fred" "bill" == "bill" +-- > 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) + where + (a,b) = splitFileName pth + ext = takeExtension b + +-- | Is an item either a directory or the last character a path separator? +-- +-- > hasTrailingPathSeparator "test" == False +-- > hasTrailingPathSeparator "test/" == True +hasTrailingPathSeparator :: FilePath -> Bool +hasTrailingPathSeparator "" = False +hasTrailingPathSeparator x = isPathSeparator (last x) + + +-- | Add a trailing file path separator if one is not already present. +-- +-- > hasTrailingPathSeparator (addTrailingPathSeparator 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] + + +-- | Remove any trailing path separators +-- +-- > dropTrailingPathSeparator "file/test/" == "file/test" +-- > not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x +-- > Posix: dropTrailingPathSeparator "/" == "/" +dropTrailingPathSeparator :: FilePath -> FilePath +dropTrailingPathSeparator x = + if hasTrailingPathSeparator x && not (isDrive x) + then reverse $ dropWhile isPathSeparator $ reverse x + else x + + +-- | Get the directory name, move up one level. +-- +-- > 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:\\" +takeDirectory :: FilePath -> FilePath +takeDirectory x = if isDrive file then file + else if null res && not (null file) then file + else res + where + res = reverse $ dropWhile isPathSeparator $ reverse file + file = dropFileName x + +-- | Set the directory, keeping the filename the same. +-- +-- > replaceDirectory x (takeDirectory x) `equalFilePath` x +replaceDirectory :: FilePath -> String -> FilePath +replaceDirectory x dir = combineAlways dir (takeFileName x) + + +-- | Combine two paths, if the second path 'isAbsolute', then it returns the second. +-- +-- > 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" +combine :: FilePath -> FilePath -> FilePath +combine a b | isAbsolute b = b + | otherwise = combineAlways a b + +-- | Combine two paths, assuming rhs is NOT absolute. +combineAlways :: FilePath -> FilePath -> FilePath +combineAlways a b | null a = b + | null b = a + | isPathSeparator (last a) = a ++ b + | isDrive a = joinDrive a b + | otherwise = a ++ [pathSeparator] ++ b + + +-- | A nice alias for 'combine'. +() :: FilePath -> FilePath -> FilePath +() = combine + + +-- | Split a path by the directory separator. +-- +-- > concat (splitPath x) == x +-- > splitPath "test//item/" == ["test//","item/"] +-- > splitPath "test/item/file" == ["test/","item/","file"] +-- > splitPath "" == [] +-- > 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 + + f "" = [] + f x = (a++c) : f d + where + (a,b) = break isPathSeparator x + (c,d) = break (not . isPathSeparator) b + +-- | Just as 'splitPath', but don't add the trailing slashes to each element. +-- +-- > splitDirectories "test/file" == ["test","file"] +-- > splitDirectories "/test/file" == ["/","test","file"] +-- > 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 + + f xs = map g xs + g x = if null res then x else res + where res = takeWhile (not . isPathSeparator) x + + +-- | Join path elements back together. +-- +-- > joinPath (splitPath (makeValid x)) == makeValid x + +-- Note that this definition on c:\\c:\\, join then split will give c:\\. +joinPath :: [FilePath] -> FilePath +joinPath x = foldr combine "" x + + + + + + +--------------------------------------------------------------------- +-- File name manipulators + +-- | Equality of two 'FilePath's. +-- 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. +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 + | 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 +-- > Windows: makeRelative "C:\\Home" "c:\\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" +-- > Posix: makeRelative "/file/test" "/file/test/fred" == "fred" +-- > 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) + 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 + + 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 +-- +-- * \/ -> 'pathSeparator' +-- +-- * .\/ -> \"\" +-- +-- > Posix: normalise "/file/\\test////" == "/file/\\test/" +-- > Posix: normalise "/file/./test" == "/file/test" +-- > Posix: normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/" +-- > Posix: normalise "../bob/fred/" == "../bob/fred/" +-- > Posix: normalise "./bob/fred/" == "bob/fred/" +-- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\" +-- > 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 + + 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 (x:xs) = x : propSep xs + propSep [] = [] + + dropDots acc (".":xs) = dropDots acc xs + dropDots acc (x:xs) = dropDots (x:acc) xs + 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 + + 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 = ":*?><|" +badElements = ["CON", "PRN", "AUX", "NUL", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9", "CLOCK$"] + + +-- | Is a FilePath valid, i.e. could you create a file like it? +-- +-- > Posix: isValid "/random_ path:*" == True +-- > 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 +isValid :: FilePath -> Bool +isValid x | isPosix = True +isValid x = not (any (`elem` badCharacters) x2) && not (any f $ splitDirectories x2) + where + x2 = dropDrive x + f x = map toUpper (dropExtensions x) `elem` badElements + + +-- | 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 +-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test" +-- > Windows: makeValid "test*" == "test_" +-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_" +-- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt" +-- > 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 + + validChars x = map f x + f x | x `elem` badCharacters = '_' + | otherwise = x + + 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 + where (a,b) = splitExtensions x + + +-- | Is a path relative, or is it fixed to the root? +-- +-- > Windows: isRelative "path\\test" == True +-- > Windows: isRelative "c:\\test" == False +-- > Posix: isRelative "test/path" == True +-- > Posix: isRelative "/test" == False +isRelative :: FilePath -> Bool +isRelative = null . takeDrive + + +-- | @not . 'isRelative'@ +-- +-- > isAbsolute x == not (isRelative x) +isAbsolute :: FilePath -> Bool +isAbsolute = not . isRelative diff --git a/System/FilePath/Posix.hs b/System/FilePath/Posix.hs new file mode 100644 --- /dev/null +++ b/System/FilePath/Posix.hs @@ -0,0 +1,16 @@ +#define MODULE_NAME Posix +#define IS_WINDOWS False + +----------------------------------------------------------------------------- +-- | +-- Module : System.FilePath.Posix +-- Copyright : (c) Neil Mitchell 2005-2007 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : stable +-- Portability : portable +-- +-- A library for FilePath manipulations, using Posix style paths on +-- all platforms. Importing "System.FilePath" is usually better. +#include "Internal.hs" diff --git a/System/FilePath/Windows.hs b/System/FilePath/Windows.hs new file mode 100644 --- /dev/null +++ b/System/FilePath/Windows.hs @@ -0,0 +1,16 @@ +#define MODULE_NAME Windows +#define IS_WINDOWS True + +----------------------------------------------------------------------------- +-- | +-- Module : System.FilePath.Windows +-- Copyright : (c) Neil Mitchell 2005-2007 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : stable +-- Portability : portable +-- +-- A library for FilePath manipulations, using Windows style paths on +-- all platforms. Importing "System.FilePath" is usually better. +#include "Internal.hs" diff --git a/filepath.cabal b/filepath.cabal new file mode 100644 --- /dev/null +++ b/filepath.cabal @@ -0,0 +1,14 @@ +Name: filepath +Version: 1.0 +License: BSD3 +Author: Neil Mitchell +Homepage: http://www-users.cs.york.ac.uk/~ndm/filepath/ +Category: System +Build-Depends: base +Synopsis: Library for manipulating FilePath's in a cross platform way. +Exposed-modules: + System.FilePath + System.FilePath.Posix + System.FilePath.Windows +Extra-Source-Files: System/FilePath/Internal.hs +Extensions: CPP