halfs-0.2: Halfs/CompatFilePath.hs
{-# OPTIONS -cpp #-}
module Halfs.CompatFilePath
( -- * File path
FilePath
, splitFileName
, splitFileExt
, splitFilePath
, joinFileName
, joinFileExt
, joinPaths
, changeFileExt
, isRootedPath
, isAbsolutePath
, pathParents
, commonParent
-- * Search path
, parseSearchPath
, mkSearchPath
-- * Separators
, isPathSeparator
, pathSeparator
, searchPathSeparator
) where
#if !__GLASGOW_HASKELL__ || __GLASGOW_HASKELL__ >= 623
import System.FilePath
#else /* to end of file... */
#include "ghcconfig.h"
import Data.List(intersperse)
--------------------------------------------------------------
-- * 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) = break (== ':') (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:ps) | isPathSeparator c -> ps
_ -> 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 :: FilePath -> (String, String)
splitFileExt p =
case pre of
[] -> (p, [])
(_:ps) -> (reverse (ps++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.
-- 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, [])
(_:ps) -> (reverse real_dir, reverse ps, reverse suf)
where
#ifdef mingw32_TARGET_OS
(path,drive) = break (== ':') (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
(_:ds) -> ds++drive
-- | The 'joinFileName' function is the opposite of 'splitFileName'.
-- 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
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 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
-- | 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", 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
-- | 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 exists 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"]
--
-- In the above examples \"\/\" isn\'t included in the list
-- because you can\'t create root directory.
--
-- \[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 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:ps) | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],ps)
_ -> (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
(as,"") -> (as, "")
(as,_:bs) -> (as, bs)
-- | 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 ->
let
getDrive (d:':':_) ds
| not (d `elem` ds) = d:ds
getDrive _ ds = ds
in
case foldr getDrive [] paths of
[] -> Just "."
[d] -> Just [d,':']
_ -> Nothing
#else
Nothing | all (not . isAbsolutePath) paths -> Just "."
#endif
mb_path -> mb_path
where
common i acc [] rs = checkSep i acc rs
common i acc (c:cs) rs
| isPathSeparator c = removeSep i acc cs [] rs
| otherwise = removeChar i acc c cs [] rs
checkSep _ acc [] = Just (reverse acc)
checkSep _ acc ([]:_ps) = Just (reverse acc)
checkSep i acc ((c1:_):rs)
| isPathSeparator c1 = checkSep i acc rs
checkSep i _acc _ps = i
removeSep _ acc cs pacc [] =
common (Just (reverse (pathSeparator:acc))) (pathSeparator:acc) cs pacc
removeSep _ acc _cs _pacc ([] :_ps) = Just (reverse acc)
removeSep i acc cs pacc ((c1:p1):rs)
| isPathSeparator c1 = removeSep i acc cs (p1:pacc) rs
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 ([]:_) = i
removeChar i acc c cs pacc ((c1:p1):rs)
| c == c1 = removeChar i acc c cs (p1:pacc) rs
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 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
-- 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
-- | 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
#endif