From 9a51302e229db4a6432ae15b346b0ea0248a6e8f Mon Sep 17 00:00:00 2001 From: simonmar Date: Wed, 26 Jan 2005 14:55:44 +0000 Subject: [PATCH] [project @ 2005-01-26 14:55:41 by simonmar] Remove System.FilePath pending a redesign of the interface. Temporarily introduce System.Directory.Internals as a home for some of the bits of System.FilePath we were already using elsewhere. --- GHC/Handle.hs | 2 +- System/Directory.hs | 2 +- System/Directory/Internals.hs | 179 +++++++++++++++++ System/FilePath.hs | 428 ----------------------------------------- 4 files changed, 181 insertions(+), 430 deletions(-) create mode 100644 System/Directory/Internals.hs delete mode 100644 System/FilePath.hs diff --git a/GHC/Handle.hs b/GHC/Handle.hs index 16a9a2f..d433962 100644 --- a/GHC/Handle.hs +++ b/GHC/Handle.hs @@ -56,6 +56,7 @@ module GHC.Handle ( #include "ghcconfig.h" +import System.Directory.Internals import Control.Monad import Data.Bits import Data.Maybe @@ -63,7 +64,6 @@ import Foreign import Foreign.C import System.IO.Error import System.Posix.Internals -import System.FilePath import GHC.Real diff --git a/System/Directory.hs b/System/Directory.hs index b3c09e1..e2fd121 100644 --- a/System/Directory.hs +++ b/System/Directory.hs @@ -65,8 +65,8 @@ module System.Directory , getModificationTime -- :: FilePath -> IO ClockTime ) where +import System.Directory.Internals import System.Environment ( getEnv ) -import System.FilePath import System.IO.Error import Control.Monad ( when, unless ) diff --git a/System/Directory/Internals.hs b/System/Directory/Internals.hs new file mode 100644 index 0000000..7c7f8a5 --- /dev/null +++ b/System/Directory/Internals.hs @@ -0,0 +1,179 @@ +{-# OPTIONS_GHC -fno-implicit-prelude #-} +----------------------------------------------------------------------------- +-- | +-- Module : System.Directory.Internals +-- Copyright : (c) The University of Glasgow 2005 +-- License : BSD-style (see the file libraries/base/LICENSE) +-- +-- Maintainer : libraries@haskell.org +-- Stability : hidden +-- Portability : portable +-- +-- System-independent pathname manipulations. +-- +----------------------------------------------------------------------------- + +-- #hide +module System.Directory.Internals ( + joinFileName, + joinFileExt, + parseSearchPath, + pathParents, + exeExtension, + ) where + +#if __GLASGOW_HASKELL__ +import GHC.Base +import GHC.IOBase (FilePath) +#endif +import Data.List + +-- | The 'joinFileName' function is the opposite of 'splitFileName'. +-- It joins directory and file names to form a complete file path. +-- +-- The general rule is: +-- +-- > dir `joinFileName` basename == path +-- > where +-- > (dir,basename) = splitFileName path +-- +-- There might be an exceptions to the rule but in any case the +-- reconstructed path will refer to the same object (file or directory). +-- An example exception is that on Windows some slashes might be converted +-- to backslashes. +joinFileName :: String -> String -> FilePath +joinFileName "" fname = fname +joinFileName "." fname = fname +joinFileName dir "" = dir +joinFileName dir fname + | isPathSeparator (last dir) = dir++fname + | otherwise = dir++pathSeparator:fname + +-- | The 'joinFileExt' function is the opposite of 'splitFileExt'. +-- It joins a file name and an extension to form a complete file path. +-- +-- The general rule is: +-- +-- > filename `joinFileExt` ext == path +-- > where +-- > (filename,ext) = splitFileExt path +joinFileExt :: String -> String -> FilePath +joinFileExt path "" = path +joinFileExt path ext = path ++ '.':ext + +-- | Gets this path and all its parents. +-- The function is useful in case if you want to create +-- some file but you aren\'t sure whether all directories +-- in the path exist or if you want to search upward for some file. +-- +-- Some examples: +-- +-- \[Posix\] +-- +-- > pathParents "/" == ["/"] +-- > pathParents "/dir1" == ["/", "/dir1"] +-- > pathParents "/dir1/dir2" == ["/", "/dir1", "/dir1/dir2"] +-- > pathParents "dir1" == [".", "dir1"] +-- > pathParents "dir1/dir2" == [".", "dir1", "dir1/dir2"] +-- +-- \[Windows\] +-- +-- > pathParents "c:" == ["c:."] +-- > pathParents "c:\\" == ["c:\\"] +-- > pathParents "c:\\dir1" == ["c:\\", "c:\\dir1"] +-- > pathParents "c:\\dir1\\dir2" == ["c:\\", "c:\\dir1", "c:\\dir1\\dir2"] +-- > pathParents "c:dir1" == ["c:.","c:dir1"] +-- > pathParents "dir1\\dir2" == [".", "dir1", "dir1\\dir2"] +-- +-- Note that if the file is relative then the current directory (\".\") +-- will be explicitly listed. +pathParents :: FilePath -> [FilePath] +pathParents p = + root'' : map ((++) root') (dropEmptyPath $ inits path') + where +#ifdef mingw32_TARGET_OS + (root,path) = case break (== ':') p of + (path, "") -> ("",path) + (root,_:path) -> (root++":",path) +#else + (root,path) = ("",p) +#endif + (root',root'',path') = case path of + (c:path) | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path) + _ -> (root ,root++"." ,path) + + dropEmptyPath ("":paths) = paths + dropEmptyPath paths = paths + + inits :: String -> [String] + inits [] = [""] + inits cs = + case pre of + "." -> inits suf + ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf) + _ -> "" : map (joinFileName pre) (inits suf) + where + (pre,suf) = case break isPathSeparator cs of + (pre,"") -> (pre, "") + (pre,_:suf) -> (pre,suf) + +-------------------------------------------------------------- +-- * Search path +-------------------------------------------------------------- + +-- | The function splits the given string to substrings +-- using the 'searchPathSeparator'. +parseSearchPath :: String -> [FilePath] +parseSearchPath path = split searchPathSeparator path + where + split :: Char -> String -> [String] + split c s = + case rest of + [] -> [chunk] + _:rest' -> chunk : split c rest' + where + (chunk, rest) = break (==c) s + +-------------------------------------------------------------- +-- * Separators +-------------------------------------------------------------- + +-- | Checks whether the character is a valid path separator for the host +-- platform. The valid character is a 'pathSeparator' but since the Windows +-- operating system also accepts a slash (\"\/\") since DOS 2, the function +-- checks for it on this platform, too. +isPathSeparator :: Char -> Bool +isPathSeparator ch = ch == pathSeparator || ch == '/' + +-- | Provides a platform-specific character used to separate directory levels in +-- a path string that reflects a hierarchical file system organization. The +-- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash +-- (@\"\\\"@) on the Windows operating system. +pathSeparator :: Char +#ifdef mingw32_TARGET_OS +pathSeparator = '\\' +#else +pathSeparator = '/' +#endif + +-- ToDo: This should be determined via autoconf (PATH_SEPARATOR) +-- | A platform-specific character used to separate search path strings in +-- environment variables. The separator is a colon (@\":\"@) on Unix and +-- Macintosh, and a semicolon (@\";\"@) on the Windows operating system. +searchPathSeparator :: Char +#ifdef mingw32_TARGET_OS +searchPathSeparator = ';' +#else +searchPathSeparator = ':' +#endif + +-- ToDo: This should be determined via autoconf (AC_EXEEXT) +-- | Extension for executable files +-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2) +exeExtension :: String +#ifdef mingw32_TARGET_OS +exeExtension = "exe" +#else +exeExtension = "" +#endif + diff --git a/System/FilePath.hs b/System/FilePath.hs deleted file mode 100644 index 2ed786a..0000000 --- a/System/FilePath.hs +++ /dev/null @@ -1,428 +0,0 @@ -{-# OPTIONS_GHC -fno-implicit-prelude #-} - ------------------------------------------------------------------------------ --- | --- Module : System.FilePath --- Copyright : (c) The University of Glasgow 2004 --- License : BSD-style (see the file libraries/base/LICENSE) --- --- Maintainer : libraries@haskell.org --- Stability : highly experimental --- Portability : portable --- --- System-independent pathname manipulations. --- ------------------------------------------------------------------------------ - -module System.FilePath - ( -- * File path - FilePath - , splitFileName - , splitFileExt - , splitFilePath - , joinFileName - , joinFileExt - , joinPaths - , changeFileExt - , isRootedPath - , isAbsolutePath - , splitAbsolutePrefix - - , pathParents - , commonParent - - -- * Search path - , parseSearchPath - , mkSearchPath - - -- * Separators - , isPathSeparator - , pathSeparator - , searchPathSeparator - - -- * Filename extensions - , exeExtension - , objExtension - , dllExtension - ) where - -#ifdef __GLASGOW_HASKELL__ -import GHC.Base -import GHC.IOBase(FilePath) -import GHC.Num -#else -import Prelude -- necessary to get dependencies right -#endif -import Data.Maybe -import Data.List - --------------------------------------------------------------- --- * FilePath --------------------------------------------------------------- - --- | Split the path into directory and file name --- --- Examples: --- --- \[Posix\] --- --- > splitFileName "/" == ("/", "") --- > splitFileName "/foo/bar.ext" == ("/foo", "bar.ext") --- > splitFileName "bar.ext" == (".", "bar.ext") --- > splitFileName "/foo/." == ("/foo", ".") --- > splitFileName "/foo/.." == ("/foo", "..") --- --- \[Windows\] --- --- > splitFileName "\\" == ("\\", "") --- > splitFileName "c:\\foo\\bar.ext" == ("c:\\foo", "bar.ext") --- > splitFileName "bar.ext" == (".", "bar.ext") --- > splitFileName "c:\\foo\\." == ("c:\\foo", ".") --- > splitFileName "c:\\foo\\.." == ("c:\\foo", "..") --- --- The first case in the above examples returns an empty file name. --- This is a special case because the \"\/\" (\"\\\\\" on Windows) --- path doesn\'t refer to an object (file or directory) which resides --- within a directory. -splitFileName :: FilePath -> (String, String) -splitFileName p = (reverse (path2++drive), reverse fname) - where -#ifdef mingw32_TARGET_OS - (path,drive) = case p of - (c:':':p) -> (reverse p,[':',c]) - _ -> (reverse p,"") -#else - (path,drive) = (reverse p,"") -#endif - (fname,path1) = break isPathSeparator path - path2 = case path1 of - [] -> "." - [_] -> path1 -- don't remove the trailing slash if - -- there is only one character - (c:path) | isPathSeparator c -> path - _ -> path1 - --- | Split the path into file name and extension. If the file doesn\'t have extension, --- the function will return empty string. The extension doesn\'t include a leading period. --- --- Examples: --- --- > splitFileExt "foo.ext" == ("foo", "ext") --- > splitFileExt "foo" == ("foo", "") --- > splitFileExt "." == (".", "") --- > splitFileExt ".." == ("..", "") --- > splitFileExt "foo.bar."== ("foo.bar.", "") -splitFileExt :: FilePath -> (String, String) -splitFileExt p = - case break (== '.') fname of - (suf@(_:_),_:pre) -> (reverse (pre++path), reverse suf) - _ -> (p, []) - where - (fname,path) = break isPathSeparator (reverse p) - --- | Split the path into directory, file name and extension. --- The function is an optimized version of the following equation: --- --- > splitFilePath path = (dir,name,ext) --- > where --- > (dir,basename) = splitFileName path --- > (name,ext) = splitFileExt basename -splitFilePath :: FilePath -> (String, String, String) -splitFilePath p = - case pre of - [] -> (reverse real_dir, reverse suf, []) - (_:pre) -> (reverse real_dir, reverse pre, reverse suf) - where -#ifdef mingw32_TARGET_OS - (path,drive) = case p of - (c:':':p) -> (reverse p,[':',c]) - _ -> (reverse p,"") -#else - (path,drive) = (reverse p,"") -#endif - (file,dir) = break isPathSeparator path - (suf,pre) = case file of - ".." -> ("..", "") - _ -> break (== '.') file - - real_dir = case dir of - [] -> '.':drive - [_] -> pathSeparator:drive - (_:dir) -> dir++drive - --- | The 'joinFileName' function is the opposite of 'splitFileName'. --- It joins directory and file names to form a complete file path. --- --- The general rule is: --- --- > dir `joinFileName` basename == path --- > where --- > (dir,basename) = splitFileName path --- --- There might be an exceptions to the rule but in any case the --- reconstructed path will refer to the same object (file or directory). --- An example exception is that on Windows some slashes might be converted --- to backslashes. -joinFileName :: String -> String -> FilePath -joinFileName "" fname = fname -joinFileName "." fname = fname -joinFileName dir "" = dir -joinFileName dir fname - | isPathSeparator (last dir) = dir++fname - | otherwise = dir++pathSeparator:fname - --- | The 'joinFileExt' function is the opposite of 'splitFileExt'. --- It joins a file name and an extension to form a complete file path. --- --- The general rule is: --- --- > filename `joinFileExt` ext == path --- > where --- > (filename,ext) = splitFileExt path -joinFileExt :: String -> String -> FilePath -joinFileExt path "" = path -joinFileExt path ext = path ++ '.':ext - --- | Given a directory path \"dir\" and a file\/directory path \"rel\", --- returns a merged path \"full\" with the property that --- (cd dir; do_something_with rel) is equivalent to --- (do_something_with full). If the \"rel\" path is an absolute path --- then the returned path is equal to \"rel\" -joinPaths :: FilePath -> FilePath -> FilePath -joinPaths path1 path2 - | isRootedPath path2 = path2 - | otherwise = -#ifdef mingw32_TARGET_OS - case path2 of - d:':':path2' | take 2 path1 == [d,':'] -> path1 `joinFileName` path2' - | otherwise -> path2 - _ -> path1 `joinFileName` path2 -#else - path1 `joinFileName` path2 -#endif - --- | Changes the extension of a file path. -changeFileExt :: FilePath -- ^ The path information to modify. - -> String -- ^ The new extension (without a leading period). - -- Specify an empty string to remove an existing - -- extension from path. - -> FilePath -- ^ A string containing the modified path information. -changeFileExt path ext = joinFileExt name ext - where - (name,_) = splitFileExt path - --- | On Unix and Macintosh the 'isRootedPath' function is a synonym to 'isAbsolutePath'. --- The difference is important only on Windows. The rooted path must start from the root --- directory but may not include the drive letter while the absolute path always includes --- the drive letter and the full file path. -isRootedPath :: FilePath -> Bool -isRootedPath (c:_) | isPathSeparator c = True -#ifdef mingw32_TARGET_OS -isRootedPath (_:':':c:_) | isPathSeparator c = True -- path with drive letter -#endif -isRootedPath _ = False - --- | Returns 'True' if this path\'s meaning is independent of any OS --- \"working directory\", or 'False' if it isn\'t. -isAbsolutePath :: FilePath -> Bool -#ifdef mingw32_TARGET_OS -isAbsolutePath (_:':':c:_) | isPathSeparator c = True -#else -isAbsolutePath (c:_) | isPathSeparator c = True -#endif -isAbsolutePath _ = False - --- | If the function is applied to an absolute path then it returns a --- local path obtained by dropping the absolute prefix from the path. --- Under Windows the prefix is @\"\\\"@, @\"c:\"@ or @\"c:\\\"@. --- Under Unix the prefix is always @\"\/\"@. -splitAbsolutePrefix :: FilePath -> (String,FilePath) -splitAbsolutePrefix (c:cs) | isPathSeparator c = ([c],cs) -#ifdef mingw32_TARGET_OS -splitAbsolutePrefix (d:':':c:cs) | isPathSeparator c = ([d,':',c],cs) -- path with drive letter -splitAbsolutePrefix (d:':':cs) = ([d,':'], cs) -#endif -splitAbsolutePrefix cs = ("",cs) - --- | Gets this path and all its parents. --- The function is useful in case if you want to create --- some file but you aren\'t sure whether all directories --- in the path exist or if you want to search upward for some file. --- --- Some examples: --- --- \[Posix\] --- --- > pathParents "/" == ["/"] --- > pathParents "/dir1" == ["/", "/dir1"] --- > pathParents "/dir1/dir2" == ["/", "/dir1", "/dir1/dir2"] --- > pathParents "dir1" == [".", "dir1"] --- > pathParents "dir1/dir2" == [".", "dir1", "dir1/dir2"] --- --- \[Windows\] --- --- > pathParents "c:" == ["c:."] --- > pathParents "c:\\" == ["c:\\"] --- > pathParents "c:\\dir1" == ["c:\\", "c:\\dir1"] --- > pathParents "c:\\dir1\\dir2" == ["c:\\", "c:\\dir1", "c:\\dir1\\dir2"] --- > pathParents "c:dir1" == ["c:.","c:dir1"] --- > pathParents "dir1\\dir2" == [".", "dir1", "dir1\\dir2"] --- --- Note that if the file is relative then the current directory (\".\") --- will be explicitly listed. -pathParents :: FilePath -> [FilePath] -pathParents p = - root'' : map ((++) root') (dropEmptyPath $ inits path') - where -#ifdef mingw32_TARGET_OS - (root,path) = case break (== ':') p of - (path, "") -> ("",path) - (root,_:path) -> (root++":",path) -#else - (root,path) = ("",p) -#endif - (root',root'',path') = case path of - (c:path) | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path) - _ -> (root ,root++"." ,path) - - dropEmptyPath ("":paths) = paths - dropEmptyPath paths = paths - - inits :: String -> [String] - inits [] = [""] - inits cs = - case pre of - "." -> inits suf - ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf) - _ -> "" : map (joinFileName pre) (inits suf) - where - (pre,suf) = case break isPathSeparator cs of - (pre,"") -> (pre, "") - (pre,_:suf) -> (pre,suf) - --- | Given a list of file paths, returns the longest common parent. -commonParent :: [FilePath] -> Maybe FilePath -commonParent [] = Nothing -commonParent paths@(p:ps) = - case common Nothing "" p ps of -#ifdef mingw32_TARGET_OS - Nothing | all (not . isAbsolutePath) paths -> - case foldr getDrive [] paths of - [] -> Just "." - [d] -> Just [d,':'] - _ -> Nothing -#else - Nothing | all (not . isAbsolutePath) paths -> Just "." -#endif - mb_path -> mb_path - where -#ifdef mingw32_TARGET_OS - getDrive (d:':':_) ds - | not (d `elem` ds) = d:ds - getDrive _ ds = ds -#endif - - common i acc [] ps = checkSep i acc ps - common i acc (c:cs) ps - | isPathSeparator c = removeSep i acc cs [] ps - | otherwise = removeChar i acc c cs [] ps - - checkSep i acc [] = Just (reverse acc) - checkSep i acc ([]:ps) = Just (reverse acc) - checkSep i acc ((c1:p):ps) - | isPathSeparator c1 = checkSep i acc ps - checkSep i acc ps = i - - removeSep i acc cs pacc [] = - common (Just (reverse (pathSeparator:acc))) (pathSeparator:acc) cs pacc - removeSep i acc cs pacc ([] :ps) = Just (reverse acc) - removeSep i acc cs pacc ((c1:p):ps) - | isPathSeparator c1 = removeSep i acc cs (p:pacc) ps - removeSep i acc cs pacc ps = i - - removeChar i acc c cs pacc [] = common i (c:acc) cs pacc - removeChar i acc c cs pacc ([] :ps) = i - removeChar i acc c cs pacc ((c1:p):ps) - | c == c1 = removeChar i acc c cs (p:pacc) ps - removeChar i acc c cs pacc ps = i - --------------------------------------------------------------- --- * Search path --------------------------------------------------------------- - --- | The function splits the given string to substrings --- using the 'searchPathSeparator'. -parseSearchPath :: String -> [FilePath] -parseSearchPath path = split searchPathSeparator path - where - split :: Char -> String -> [String] - split c s = - case rest of - [] -> [chunk] - _:rest' -> chunk : split c rest' - where - (chunk, rest) = break (==c) s - --- | The function concatenates the given paths to form a --- single string where the paths are separated with 'searchPathSeparator'. -mkSearchPath :: [FilePath] -> String -mkSearchPath paths = concat (intersperse [searchPathSeparator] paths) - - --------------------------------------------------------------- --- * Separators --------------------------------------------------------------- - --- | Checks whether the character is a valid path separator for the host --- platform. The valid character is a 'pathSeparator' but since the Windows --- operating system also accepts a slash (\"\/\") since DOS 2, the function --- checks for it on this platform, too. -isPathSeparator :: Char -> Bool -isPathSeparator ch = ch == pathSeparator || ch == '/' - --- | Provides a platform-specific character used to separate directory levels in --- a path string that reflects a hierarchical file system organization. The --- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash --- (@\"\\\"@) on the Windows operating system. -pathSeparator :: Char -#ifdef mingw32_TARGET_OS -pathSeparator = '\\' -#else -pathSeparator = '/' -#endif - --- ToDo: This should be determined via autoconf (PATH_SEPARATOR) --- | A platform-specific character used to separate search path strings in --- environment variables. The separator is a colon (@\":\"@) on Unix and --- Macintosh, and a semicolon (@\";\"@) on the Windows operating system. -searchPathSeparator :: Char -#ifdef mingw32_TARGET_OS -searchPathSeparator = ';' -#else -searchPathSeparator = ':' -#endif - --- ToDo: This should be determined via autoconf (AC_EXEEXT) --- | Extension for executable files --- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2) -exeExtension :: String -#ifdef mingw32_TARGET_OS -exeExtension = "exe" -#else -exeExtension = "" -#endif - --- ToDo: This should be determined via autoconf (AC_OBJEXT) --- | Extension for object files. For GHC and NHC the extension is @\"o\"@. --- Hugs uses either @\"o\"@ or @\"obj\"@ depending on the used C compiler. -objExtension :: String -objExtension = "o" - --- | Extension for dynamically linked (or shared) libraries --- (typically @\"so\"@ on Unix and @\"dll\"@ on Windows) -dllExtension :: String -#ifdef mingw32_TARGET_OS -dllExtension = "dll" -#else -dllExtension = "so" -#endif -- 1.7.10.4