-- * Actions on files
, removeFile -- :: FilePath -> IO ()
, renameFile -- :: FilePath -> FilePath -> IO ()
-#ifdef __GLASGOW_HASKELL__
, copyFile -- :: FilePath -> FilePath -> IO ()
-#endif
+
+ , canonicalizePath
+ , findExecutable
-- * Existence tests
, doesFileExist -- :: FilePath -> IO Bool
#ifdef __NHC__
import Directory
-import System (getEnv)
#endif /* __NHC__ */
#ifdef __HUGS__
import Hugs.Directory
-import System.Environment (getEnv)
#endif /* __HUGS__ */
#ifdef __GLASGOW_HASKELL__
import System.Time ( ClockTime(..) )
import System.IO
import System.IO.Error
+import System.FilePath
+import System.Environment (getEnv)
import Foreign
import Foreign.C
import GHC.IOBase ( IOException(..), IOErrorType(..), ioException )
-#ifndef mingw32_TARGET_OS
-import System.Environment
-#endif
-
{- $intro
A directory contains a series of entries, each of which is a named
reference to a file system object (file, directory etc.). Some
-}
copyFile :: FilePath -> FilePath -> IO ()
copyFile fromFPath toFPath =
+#if (!(defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ > 600))
+ do readFile fromFPath >>= writeFile toFPath
+ try (getPermissions fromFPath >>= setPermissions toFPath)
+ return ()
+#else
(bracket (openBinaryFile fromFPath ReadMode) hClose $ \hFrom ->
bracket (openBinaryFile toFPath WriteMode) hClose $ \hTo ->
- allocaBytes bufferSize $ \buffer ->
- copyContents hFrom hTo buffer) `catch` (ioError . changeFunName)
+ allocaBytes bufferSize $ \buffer -> do
+ copyContents hFrom hTo buffer
+ try (getPermissions fromFPath >>= setPermissions toFPath)
+ return ()) `catch` (ioError . changeFunName)
where
bufferSize = 1024
when (count > 0) $ do
hPutBuf hTo buffer count
copyContents hFrom hTo buffer
+#endif
+
+-- | Given path referring to a file or directory, returns a
+-- canonicalized path, with the intent that two paths referring
+-- to the same file\/directory will map to the same canonicalized
+-- path. Note that it is impossible to guarantee that the
+-- implication (same file\/dir <=> same canonicalizedPath) holds
+-- in either direction: this function can make only a best-effort
+-- attempt.
+canonicalizePath :: FilePath -> IO FilePath
+canonicalizePath fpath =
+ withCString fpath $ \pInPath ->
+ allocaBytes long_path_size $ \pOutPath ->
+#if defined(mingw32_TARGET_OS)
+ alloca $ \ppFilePart ->
+ do c_GetFullPathName pInPath (fromIntegral long_path_size) pOutPath ppFilePart
+#else
+ do c_realpath pInPath pOutPath
+#endif
+ peekCString pOutPath
+
+#if defined(mingw32_TARGET_OS)
+foreign import stdcall unsafe "GetFullPathName"
+ c_GetFullPathName :: CString
+ -> CInt
+ -> CString
+ -> Ptr CString
+ -> IO CInt
+#else
+foreign import ccall unsafe "realpath"
+ c_realpath :: CString
+ -> CString
+ -> IO CString
+#endif
+
+-- | Given an executable file name, searches for such file
+-- in the directories listed in system PATH. The returned value
+-- is the path to the found executable or Nothing if there isn't
+-- such executable. For example (findExecutable \"ghc\")
+-- gives you the path to GHC.
+findExecutable :: String -> IO (Maybe FilePath)
+findExecutable binary = do
+ path <- getEnv "PATH"
+ search (parseSearchPath path)
+ where
+#ifdef mingw32_TARGET_OS
+ fileName = binary `joinFileExt` "exe"
+#else
+ fileName = binary
+#endif
+
+ search :: [FilePath] -> IO (Maybe FilePath)
+ search [] = return Nothing
+ search (d:ds) = do
+ let path = d `joinFileName` fileName
+ b <- doesFileExist path
+ if b then return (Just path)
+ else search ds
{- |@'getDirectoryContents' dir@ returns a list of /all/ entries
--- /dev/null
+-----------------------------------------------------------------------------\r
+-- |\r
+-- Module : System.FilePath\r
+-- Copyright : (c) The University of Glasgow 2004\r
+-- License : BSD-style (see the file libraries/base/LICENSE)\r
+-- \r
+-- Maintainer : libraries@haskell.org\r
+-- Stability : stable\r
+-- Portability : portable\r
+--\r
+-- System-independent pathname manipulations.\r
+--\r
+-----------------------------------------------------------------------------\r
+\r
+module System.FilePath\r
+ ( -- * File path\r
+ FilePath\r
+ , splitFileName\r
+ , splitFileExt\r
+ , splitFilePath\r
+ , joinFileName\r
+ , joinFileExt\r
+ , joinPaths \r
+ , changeFileExt\r
+ , isRootedPath\r
+ , isAbsolutePath\r
+\r
+ , pathParents\r
+ , commonParent\r
+\r
+ -- * Search path\r
+ , parseSearchPath\r
+ , mkSearchPath\r
+\r
+ -- * Separators\r
+ , isPathSeparator\r
+ , pathSeparator\r
+ , searchPathSeparator\r
+ ) where\r
+\r
+import Data.List(intersperse)
+
+--------------------------------------------------------------
+-- * FilePath
+--------------------------------------------------------------
+
+-- | Split the path into directory and file name\r
+--\r
+-- Examples:\r
+--\r
+-- \[Posix\]\r
+--\r
+-- > splitFileName "/" == ("/", "")\r
+-- > splitFileName "/foo/bar.ext" == ("/foo", "bar.ext")\r
+-- > splitFileName "bar.ext" == (".", "bar.ext")\r
+-- > splitFileName "/foo/." == ("/foo", ".")\r
+-- > splitFileName "/foo/.." == ("/foo", "..")\r
+--\r
+-- \[Windows\]\r
+--\r
+-- > splitFileName "\\" == ("\\", "")\r
+-- > splitFileName "c:\\foo\\bar.ext" == ("c:\\foo", "bar.ext")\r
+-- > splitFileName "bar.ext" == (".", "bar.ext")\r
+-- > splitFileName "c:\\foo\\." == ("c:\\foo", ".")\r
+-- > splitFileName "c:\\foo\\.." == ("c:\\foo", "..")\r
+--\r
+-- The first case in the above examples returns an empty file name.\r
+-- This is a special case because the \"\/\" (\"\\\\\" on Windows) \r
+-- path doesn\'t refer to an object (file or directory) which resides \r
+-- within a directory.\r
+splitFileName :: FilePath -> (String, String)
+splitFileName p = (reverse (path2++drive), reverse fname)
+ where
+#ifdef mingw32_TARGET_OS\r
+ (path,drive) = break (== ':') (reverse p)\r
+#else\r
+ (path,drive) = (reverse p,"")\r
+#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,\r
+-- the function will return empty string. The extension doesn\'t include a leading period.\r
+--\r
+-- Examples:\r
+--\r
+-- > splitFileExt "foo.ext" == ("foo", "ext")\r
+-- > splitFileExt "foo" == ("foo", "")\r
+-- > splitFileExt "." == (".", "")\r
+-- > splitFileExt ".." == ("..", "")
+splitFileExt :: FilePath -> (String, String)
+splitFileExt p =
+ case pre of
+ [] -> (p, [])
+ (_:pre) -> (reverse (pre++path), reverse suf)
+ where
+ (fname,path) = break isPathSeparator (reverse p)
+ (suf,pre) | fname == "." || fname == ".." = (fname,"")
+ | otherwise = break (== '.') fname
+
+-- | Split the path into directory, file name and extension. \r
+-- The function is an optimized version of the following equation:\r
+--\r
+-- > splitFilePath path = (dir,name,ext)\r
+-- > where\r
+-- > (dir,basename) = splitFileName path\r
+-- > (name,ext) = splitFileExt basename\r
+splitFilePath :: FilePath -> (String, String, String)\r
+splitFilePath p =\r
+ case pre of\r
+ [] -> (reverse real_dir, reverse suf, [])\r
+ (_:pre) -> (reverse real_dir, reverse pre, reverse suf)\r
+ where\r
+#ifdef mingw32_TARGET_OS\r
+ (path,drive) = break (== ':') (reverse p)\r
+#else\r
+ (path,drive) = (reverse p,"")\r
+#endif\r
+ (file,dir) = break isPathSeparator path\r
+ (suf,pre) = case file of\r
+ ".." -> ("..", "")\r
+ _ -> break (== '.') file\r
+ \r
+ real_dir = case dir of\r
+ [] -> '.':drive\r
+ [_] -> pathSeparator:drive\r
+ (_:dir) -> dir++drive\r
+
+-- | The 'joinFileName' function is the opposite of 'splitFileName'. \r
+-- It joins directory and file names to form complete file path.
+--
+-- The general rule is:
+--
+-- > dir `joinFileName` basename == path
+-- > where
+-- > (dir,basename) = splitFileName path
+--
+-- There might be an exeptions 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\r
+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'.\r
+-- It joins file name and extension to form 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
+\r
+-- | Given a directory path \"dir\" and a file\/directory path \"rel\",\r
+-- returns a merged path \"full\" with the property that\r
+-- (cd dir; do_something_with rel) is equivalent to\r
+-- (do_something_with full). If the \"rel\" path is an absolute path\r
+-- then the returned path is equal to \"rel\"\r
+joinPaths :: FilePath -> FilePath -> FilePath\r
+joinPaths path1 path2\r
+ | isRootedPath path2 = path2\r
+ | otherwise = \r
+#ifdef mingw32_TARGET_OS\r
+ case path2 of\r
+ d:':':path2' | take 2 path1 == [d,':'] -> path1 `joinFileName` path2'\r
+ | otherwise -> path2\r
+ _ -> path1 `joinFileName` path2\r
+#else\r
+ path1 `joinFileName` path2\r
+#endif\r
+ \r
+-- | Changes the extension of a file path.\r
+changeFileExt :: FilePath -- ^ The path information to modify.\r
+ -> String -- ^ The new extension (without a leading period).\r
+ -- Specify an empty string to remove an existing \r
+ -- extension from path.\r
+ -> FilePath -- ^ A string containing the modified path information.\r
+changeFileExt path ext = joinFileExt name ext
+ where
+ (name,_) = splitFileExt path
+\r
+-- | 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\r
+-- directory but may not include the drive letter while the absolute path always includes\r
+-- the drive letter and the full file path.\r
+isRootedPath :: FilePath -> Bool
+isRootedPath (c:_) | isPathSeparator c = True
+#ifdef mingw32_TARGET_OS
+isRootedPath (_:':':c:_) | isPathSeparator c = True -- path with drive letter
+#endif
+isRootedPath _ = False\r
+
+-- | Returns True if this path\'s meaning is independent of any OS\r
+-- "working directory", 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\r
+\r
+-- | Gets this path and all its parents.\r
+-- The function is useful in case if you want to create \r
+-- some file but you aren\'t sure whether all directories \r
+-- in the path exists or if you want to search upward for some file.\r
+-- \r
+-- Some examples:\r
+--\r
+-- \[Posix\]\r
+--\r
+-- > pathParents "/" == ["/"]\r
+-- > pathParents "/dir1" == ["/", "/dir1"]\r
+-- > pathParents "/dir1/dir2" == ["/", "/dir1", "/dir1/dir2"]\r
+-- > pathParents "dir1" == [".", "dir1"]\r
+-- > pathParents "dir1/dir2" == [".", "dir1", "dir1/dir2"]\r
+--\r
+-- In the above examples \"\/\" isn\'t included in the list \r
+-- because you can\'t create root directory.\r
+--\r
+-- \[Windows\]\r
+--\r
+-- > pathParents "c:" == ["c:."]\r
+-- > pathParents "c:\\" == ["c:\\"]\r
+-- > pathParents "c:\\dir1" == ["c:\\", "c:\\dir1"]\r
+-- > pathParents "c:\\dir1\\dir2" == ["c:\\", "c:\\dir1", "c:\\dir1\\dir2"]\r
+-- > pathParents "c:dir1" == ["c:.","c:dir1"]\r
+-- > pathParents "dir1\\dir2" == [".", "dir1", "dir1\\dir2"]\r
+--\r
+-- Note that if the file is relative then the the current directory (\".\") \r
+-- will be explicitly listed.\r
+pathParents :: FilePath -> [FilePath]\r
+pathParents p =\r
+ root'' : map ((++) root') (dropEmptyPath $ inits path')\r
+ where\r
+#ifdef mingw32_TARGET_OS\r
+ (root,path) = case break (== ':') p of\r
+ (path, "") -> ("",path)\r
+ (root,_:path) -> (root++":",path)\r
+#else\r
+ (root,path) = ("",p)\r
+#endif\r
+ (root',root'',path') = case path of\r
+ (c:path) | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path)\r
+ _ -> (root ,root++"." ,path)\r
+\r
+ dropEmptyPath ("":paths) = paths\r
+ dropEmptyPath paths = paths\r
+\r
+ inits :: String -> [String]\r
+ inits [] = [""]\r
+ inits cs = \r
+ case pre of\r
+ "." -> inits suf\r
+ ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf)\r
+ _ -> "" : map (joinFileName pre) (inits suf)\r
+ where\r
+ (pre,suf) = case break isPathSeparator cs of\r
+ (pre,"") -> (pre, "")\r
+ (pre,_:suf) -> (pre,suf)\r
+\r
+-- | Given a list of file paths, returns the longest common parent.\r
+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
+ getDrive (d:':':_) ds
+ | not (d `elem` ds) = d:ds
+ getDrive _ ds = ds
+
+ common i acc [] ps = checkSep i acc ps
+ common i acc (c:cs) ps\r
+ | isPathSeparator c = removeSep i acc cs [] ps\r
+ | otherwise = removeChar i acc c cs [] ps\r
+\r
+ checkSep i acc [] = Just (reverse acc)\r
+ checkSep i acc ([]:ps) = Just (reverse acc)\r
+ checkSep i acc ((c1:p):ps)\r
+ | isPathSeparator c1 = checkSep i acc ps\r
+ checkSep i acc ps = i\r
+\r
+ removeSep i acc cs pacc [] = \r
+ common (Just (reverse (pathSeparator:acc))) (pathSeparator:acc) cs pacc\r
+ removeSep i acc cs pacc ([] :ps) = Just (reverse acc)\r
+ removeSep i acc cs pacc ((c1:p):ps)\r
+ | isPathSeparator c1 = removeSep i acc cs (p:pacc) ps\r
+ removeSep i acc cs pacc ps = i\r
+\r
+ removeChar i acc c cs pacc [] = common i (c:acc) cs pacc\r
+ removeChar i acc c cs pacc ([] :ps) = i\r
+ removeChar i acc c cs pacc ((c1:p):ps)\r
+ | c == c1 = removeChar i acc c cs (p:pacc) ps\r
+ removeChar i acc c cs pacc ps = i\r
+\r
+--------------------------------------------------------------
+-- * Search path
+--------------------------------------------------------------
+
+-- | The function splits the given string to substrings
+-- using the 'searchPathSeparator'.
+parseSearchPath :: String -> [FilePath]
+parseSearchPath path = split searchPathSeparator path
+ where\r
+ split :: Char -> String -> [String]\r
+ split c s =\r
+ case rest of\r
+ [] -> [chunk] \r
+ _:rest' -> chunk : split c rest'\r
+ where\r
+ (chunk, rest) = break (==c) s\r
+\r
+-- | The function concatenates the given paths to form a\r
+-- single string where the paths are separated with 'searchPathSeparator'.\r
+mkSearchPath :: [FilePath] -> String
+mkSearchPath paths = concat (intersperse [searchPathSeparator] paths)
+\r
+
+--------------------------------------------------------------
+-- * Separators
+--------------------------------------------------------------
+
+-- | Checks whether the character is a valid path separator for the host platform.\r
+-- The valid character is a 'pathSeparator' but since the Windows operating system \r
+-- also accepts a backslash (\"\\\") the function also checks for \"\/\" on this platform.
+isPathSeparator :: Char -> Bool
+isPathSeparator ch =
+#ifdef mingw32_TARGET_OS
+ ch == '/' || ch == '\\'
+#else
+ ch == '/'
+#endif
+
+-- | Provides a platform-specific character used to separate directory levels in a \r
+-- path string that reflects a hierarchical file system organization.\r
+-- The separator is a slash (\"\/\") on Unix and Macintosh, and a backslash (\"\\\") on the \r
+-- Windows operating system.
+pathSeparator :: Char
+#ifdef mingw32_TARGET_OS
+pathSeparator = '\\'
+#else
+pathSeparator = '/'
+#endif
+
+-- | A platform-specific character used to separate search path strings in \r
+-- environment variables. The separator is a colon (\":\") on Unix and Macintosh, \r
+-- and a semicolon (\";\") on the Windows operating system.\r
+searchPathSeparator :: Char
+#ifdef mingw32_TARGET_OS
+searchPathSeparator = ';'
+#else
+searchPathSeparator = ':'
+#endif
projects / haskell-directory.git / commitdiff