System/FilePath.hs

   1 {-# OPTIONS -fno-implicit-prelude #-}
   2
   3 -----------------------------------------------------------------------------
   4 -- |
   5 -- Module      :  System.FilePath
   6 -- Copyright   :  (c) The University of Glasgow 2004
   7 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   8 --
   9 -- Maintainer  :  libraries@haskell.org
  10 -- Stability   :  stable
  11 -- Portability :  portable
  12 --
  13 -- System-independent pathname manipulations.
  14 --
  15 -----------------------------------------------------------------------------
  16
  17 module System.FilePath
  18          ( -- * File path
  19            FilePath
  20          , splitFileName
  21          , splitFileExt
  22          , splitFilePath
  23          , joinFileName
  24          , joinFileExt
  25          , joinPaths
  26          , changeFileExt
  27          , isRootedPath
  28          , isAbsolutePath
  29
  30          , pathParents
  31          , commonParent
  32
  33          -- * Search path
  34          , parseSearchPath
  35          , mkSearchPath
  36
  37          -- * Separators
  38          , isPathSeparator
  39          , pathSeparator
  40          , searchPathSeparator
  41
  42          -- * Filename extensions
  43          , exeExtension
  44          , objExtension
  45          , dllExtension
  46          ) where
  47
  48 #ifdef __GLASGOW_HASKELL__
  49 import GHC.Base
  50 import GHC.IOBase(FilePath)
  51 import GHC.Num
  52 #else
  53 import Prelude -- necessary to get dependencies right
  54 #endif
  55 import Data.Maybe
  56 import Data.List
  57
  58 --------------------------------------------------------------
  59 -- * FilePath
  60 --------------------------------------------------------------
  61
  62 -- | Split the path into directory and file name
  63 --
  64 -- Examples:
  65 --
  66 -- \[Posix\]
  67 --
  68 -- > splitFileName "/"            == ("/",    "")
  69 -- > splitFileName "/foo/bar.ext" == ("/foo", "bar.ext")
  70 -- > splitFileName "bar.ext"      == (".",    "bar.ext")
  71 -- > splitFileName "/foo/."       == ("/foo", ".")
  72 -- > splitFileName "/foo/.."      == ("/foo", "..")
  73 --
  74 -- \[Windows\]
  75 --
  76 -- > splitFileName "\\"               == ("\\",      "")
  77 -- > splitFileName "c:\\foo\\bar.ext" == ("c:\\foo", "bar.ext")
  78 -- > splitFileName "bar.ext"          == (".",       "bar.ext")
  79 -- > splitFileName "c:\\foo\\."       == ("c:\\foo", ".")
  80 -- > splitFileName "c:\\foo\\.."      == ("c:\\foo", "..")
  81 --
  82 -- The first case in the above examples returns an empty file name.
  83 -- This is a special case because the \"\/\" (\"\\\\\" on Windows)
  84 -- path doesn\'t refer to an object (file or directory) which resides
  85 -- within a directory.
  86 splitFileName :: FilePath -> (String, String)
  87 splitFileName p = (reverse (path2++drive), reverse fname)
  88   where
  89 #ifdef mingw32_TARGET_OS
  90     (path,drive) = break (== ':') (reverse p)
  91 #else
  92     (path,drive) = (reverse p,"")
  93 #endif
  94     (fname,path1) = break isPathSeparator path
  95     path2 = case path1 of
  96       []                           -> "."
  97       [_]                          -> path1   -- don't remove the trailing slash if
  98                                               -- there is only one character
  99       (c:path) | isPathSeparator c -> path
 100       _                            -> path1
 101
 102 -- | Split the path into file name and extension. If the file doesn\'t have extension,
 103 -- the function will return empty string. The extension doesn\'t include a leading period.
 104 --
 105 -- Examples:
 106 --
 107 -- > splitFileExt "foo.ext" == ("foo", "ext")
 108 -- > splitFileExt "foo"     == ("foo", "")
 109 -- > splitFileExt "."       == (".",   "")
 110 -- > splitFileExt ".."      == ("..",  "")
 111 splitFileExt :: FilePath -> (String, String)
 112 splitFileExt p =
 113   case pre of
 114         []      -> (p, [])
 115         (_:pre) -> (reverse (pre++path), reverse suf)
 116   where
 117     (fname,path) = break isPathSeparator (reverse p)
 118     (suf,pre) | fname == "." || fname == ".." = (fname,"")
 119               | otherwise                     = break (== '.') fname
 120
 121 -- | Split the path into directory, file name and extension.
 122 -- The function is an optimized version of the following equation:
 123 --
 124 -- > splitFilePath path = (dir,name,ext)
 125 -- >   where
 126 -- >     (dir,basename) = splitFileName path
 127 -- >     (name,ext)     = splitFileExt  basename
 128 splitFilePath :: FilePath -> (String, String, String)
 129 splitFilePath p =
 130   case pre of
 131     []      -> (reverse real_dir, reverse suf, [])
 132     (_:pre) -> (reverse real_dir, reverse pre, reverse suf)
 133   where
 134 #ifdef mingw32_TARGET_OS
 135     (path,drive) = break (== ':') (reverse p)
 136 #else
 137     (path,drive) = (reverse p,"")
 138 #endif
 139     (file,dir)   = break isPathSeparator path
 140     (suf,pre)    = case file of
 141                      ".." -> ("..", "")
 142                      _    -> break (== '.') file
 143
 144     real_dir = case dir of
 145       []      -> '.':drive
 146       [_]     -> pathSeparator:drive
 147       (_:dir) -> dir++drive
 148
 149 -- | The 'joinFileName' function is the opposite of 'splitFileName'.
 150 -- It joins directory and file names to form complete file path.
 151 --
 152 -- The general rule is:
 153 --
 154 -- > dir `joinFileName` basename == path
 155 -- >   where
 156 -- >     (dir,basename) = splitFileName path
 157 --
 158 -- There might be an exeptions to the rule but in any case the
 159 -- reconstructed path will refer to the same object (file or directory).
 160 -- An example exception is that on Windows some slashes might be converted
 161 -- to backslashes.
 162 joinFileName :: String -> String -> FilePath
 163 joinFileName ""  fname = fname
 164 joinFileName "." fname = fname
 165 joinFileName dir ""    = dir
 166 joinFileName dir fname
 167   | isPathSeparator (last dir) = dir++fname
 168   | otherwise                  = dir++pathSeparator:fname
 169
 170 -- | The 'joinFileExt' function is the opposite of 'splitFileExt'.
 171 -- It joins file name and extension to form complete file path.
 172 --
 173 -- The general rule is:
 174 --
 175 -- > filename `joinFileExt` ext == path
 176 -- >   where
 177 -- >     (filename,ext) = splitFileExt path
 178 joinFileExt :: String -> String -> FilePath
 179 joinFileExt path ""  = path
 180 joinFileExt path ext = path ++ '.':ext
 181
 182 -- | Given a directory path \"dir\" and a file\/directory path \"rel\",
 183 -- returns a merged path \"full\" with the property that
 184 -- (cd dir; do_something_with rel) is equivalent to
 185 -- (do_something_with full). If the \"rel\" path is an absolute path
 186 -- then the returned path is equal to \"rel\"
 187 joinPaths :: FilePath -> FilePath -> FilePath
 188 joinPaths path1 path2
 189   | isRootedPath path2 = path2
 190   | otherwise          =
 191 #ifdef mingw32_TARGET_OS
 192         case path2 of
 193           d:':':path2' | take 2 path1 == [d,':'] -> path1 `joinFileName` path2'
 194                        | otherwise               -> path2
 195           _                                      -> path1 `joinFileName` path2
 196 #else
 197         path1 `joinFileName` path2
 198 #endif
 199
 200 -- | Changes the extension of a file path.
 201 changeFileExt :: FilePath           -- ^ The path information to modify.
 202           -> String                 -- ^ The new extension (without a leading period).
 203                                     -- Specify an empty string to remove an existing
 204                                     -- extension from path.
 205           -> FilePath               -- ^ A string containing the modified path information.
 206 changeFileExt path ext = joinFileExt name ext
 207   where
 208     (name,_) = splitFileExt path
 209
 210 -- | On Unix and Macintosh the 'isRootedPath' function is a synonym to 'isAbsolutePath'.
 211 -- The difference is important only on Windows. The rooted path must start from the root
 212 -- directory but may not include the drive letter while the absolute path always includes
 213 -- the drive letter and the full file path.
 214 isRootedPath :: FilePath -> Bool
 215 isRootedPath (c:_) | isPathSeparator c = True
 216 #ifdef mingw32_TARGET_OS
 217 isRootedPath (_:':':c:_) | isPathSeparator c = True  -- path with drive letter
 218 #endif
 219 isRootedPath _ = False
 220
 221 -- | Returns True if this path\'s meaning is independent of any OS
 222 -- "working directory", False if it isn\'t.
 223 isAbsolutePath :: FilePath -> Bool
 224 #ifdef mingw32_TARGET_OS
 225 isAbsolutePath (_:':':c:_) | isPathSeparator c = True
 226 #else
 227 isAbsolutePath (c:_)       | isPathSeparator c = True
 228 #endif
 229 isAbsolutePath _ = False
 230
 231 -- | Gets this path and all its parents.
 232 -- The function is useful in case if you want to create
 233 -- some file but you aren\'t sure whether all directories
 234 -- in the path exists or if you want to search upward for some file.
 235 --
 236 -- Some examples:
 237 --
 238 -- \[Posix\]
 239 --
 240 -- >  pathParents "/"          == ["/"]
 241 -- >  pathParents "/dir1"      == ["/", "/dir1"]
 242 -- >  pathParents "/dir1/dir2" == ["/", "/dir1", "/dir1/dir2"]
 243 -- >  pathParents "dir1"       == [".", "dir1"]
 244 -- >  pathParents "dir1/dir2"  == [".", "dir1", "dir1/dir2"]
 245 --
 246 -- In the above examples \"\/\" isn\'t included in the list
 247 -- because you can\'t create root directory.
 248 --
 249 -- \[Windows\]
 250 --
 251 -- >  pathParents "c:"             == ["c:."]
 252 -- >  pathParents "c:\\"           == ["c:\\"]
 253 -- >  pathParents "c:\\dir1"       == ["c:\\", "c:\\dir1"]
 254 -- >  pathParents "c:\\dir1\\dir2" == ["c:\\", "c:\\dir1", "c:\\dir1\\dir2"]
 255 -- >  pathParents "c:dir1"         == ["c:.","c:dir1"]
 256 -- >  pathParents "dir1\\dir2"     == [".", "dir1", "dir1\\dir2"]
 257 --
 258 -- Note that if the file is relative then the the current directory (\".\")
 259 -- will be explicitly listed.
 260 pathParents :: FilePath -> [FilePath]
 261 pathParents p =
 262     root'' : map ((++) root') (dropEmptyPath $ inits path')
 263     where
 264 #ifdef mingw32_TARGET_OS
 265        (root,path) = case break (== ':') p of
 266           (path,    "") -> ("",path)
 267           (root,_:path) -> (root++":",path)
 268 #else
 269        (root,path) = ("",p)
 270 #endif
 271        (root',root'',path') = case path of
 272          (c:path) | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path)
 273          _                            -> (root                 ,root++"."            ,path)
 274
 275        dropEmptyPath ("":paths) = paths
 276        dropEmptyPath paths      = paths
 277
 278        inits :: String -> [String]
 279        inits [] =  [""]
 280        inits cs =
 281          case pre of
 282            "."  -> inits suf
 283            ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf)
 284            _    -> "" : map (joinFileName pre) (inits suf)
 285          where
 286            (pre,suf) = case break isPathSeparator cs of
 287               (pre,"")    -> (pre, "")
 288               (pre,_:suf) -> (pre,suf)
 289
 290 -- | Given a list of file paths, returns the longest common parent.
 291 commonParent :: [FilePath] -> Maybe FilePath
 292 commonParent []           = Nothing
 293 commonParent paths@(p:ps) =
 294   case common Nothing "" p ps of
 295 #ifdef mingw32_TARGET_OS
 296     Nothing | all (not . isAbsolutePath) paths ->
 297       case foldr getDrive [] paths of
 298         []  -> Just "."
 299         [d] -> Just [d,':']
 300         _   -> Nothing
 301 #else
 302     Nothing | all (not . isAbsolutePath) paths -> Just "."
 303 #endif
 304     mb_path   -> mb_path
 305   where
 306 #ifdef mingw32_TARGET_OS
 307     getDrive (d:':':_) ds
 308       | not (d `elem` ds) = d:ds
 309     getDrive _         ds = ds
 310 #endif
 311
 312     common i acc []     ps = checkSep   i acc         ps
 313     common i acc (c:cs) ps
 314       | isPathSeparator c  = removeSep  i acc   cs [] ps
 315       | otherwise          = removeChar i acc c cs [] ps
 316
 317     checkSep i acc []      = Just (reverse acc)
 318     checkSep i acc ([]:ps) = Just (reverse acc)
 319     checkSep i acc ((c1:p):ps)
 320       | isPathSeparator c1 = checkSep i acc ps
 321     checkSep i acc ps      = i
 322
 323     removeSep i acc cs pacc []          =
 324       common (Just (reverse (pathSeparator:acc))) (pathSeparator:acc) cs pacc
 325     removeSep i acc cs pacc ([]    :ps) = Just (reverse acc)
 326     removeSep i acc cs pacc ((c1:p):ps)
 327       | isPathSeparator c1              = removeSep i acc cs (p:pacc) ps
 328     removeSep i acc cs pacc ps          = i
 329
 330     removeChar i acc c cs pacc []          = common i (c:acc) cs pacc
 331     removeChar i acc c cs pacc ([]    :ps) = i
 332     removeChar i acc c cs pacc ((c1:p):ps)
 333       | c == c1                            = removeChar i acc c cs (p:pacc) ps
 334     removeChar i acc c cs pacc ps          = i
 335
 336 --------------------------------------------------------------
 337 -- * Search path
 338 --------------------------------------------------------------
 339
 340 -- | The function splits the given string to substrings
 341 -- using the 'searchPathSeparator'.
 342 parseSearchPath :: String -> [FilePath]
 343 parseSearchPath path = split searchPathSeparator path
 344   where
 345     split :: Char -> String -> [String]
 346     split c s =
 347       case rest of
 348         []      -> [chunk]
 349         _:rest' -> chunk : split c rest'
 350       where
 351         (chunk, rest) = break (==c) s
 352
 353 -- | The function concatenates the given paths to form a
 354 -- single string where the paths are separated with 'searchPathSeparator'.
 355 mkSearchPath :: [FilePath] -> String
 356 mkSearchPath paths = concat (intersperse [searchPathSeparator] paths)
 357
 358
 359 --------------------------------------------------------------
 360 -- * Separators
 361 --------------------------------------------------------------
 362
 363 -- | Checks whether the character is a valid path separator for the host
 364 -- platform. The valid character is a 'pathSeparator' but since the Windows
 365 -- operating system also accepts a slash (\"\/\") since DOS 2, the function
 366 -- checks for it on this platform, too.
 367 isPathSeparator :: Char -> Bool
 368 #ifdef mingw32_TARGET_OS
 369 isPathSeparator ch = ch == '/' || ch == '\\'
 370 #else
 371 isPathSeparator ch = ch == '/'
 372 #endif
 373
 374 -- | Provides a platform-specific character used to separate directory levels in
 375 -- a path string that reflects a hierarchical file system organization. The
 376 -- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash
 377 -- (@\"\\\"@) on the Windows operating system.
 378 pathSeparator :: Char
 379 #ifdef mingw32_TARGET_OS
 380 pathSeparator = '\\'
 381 #else
 382 pathSeparator = '/'
 383 #endif
 384
 385 -- | A platform-specific character used to separate search path strings in
 386 -- environment variables. The separator is a colon (@\":\"@) on Unix and
 387 -- Macintosh, and a semicolon (@\";\"@) on the Windows operating system.
 388 searchPathSeparator :: Char
 389 #ifdef mingw32_TARGET_OS
 390 searchPathSeparator = ';'
 391 #else
 392 searchPathSeparator = ':'
 393 #endif
 394
 395 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
 396 -- | Extension for executable files
 397 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
 398 exeExtension :: String
 399 #ifdef mingw32_TARGET_OS
 400 exeExtension = "exe"
 401 #else
 402 exeExtension = ""
 403 #endif
 404
 405 -- ToDo: This should be determined via autoconf (AC_OBJEXT)
 406 -- | Extension for object files
 407 -- (typically @\"o\"@ on Unix and @\"obj\"@ on Windows)
 408 objExtension :: String
 409 #ifdef mingw32_TARGET_OS
 410 objExtension = "obj"
 411 #else
 412 objExtension = "o"
 413 #endif
 414
 415 -- | Extension for dynamically linked (or shared) libraries
 416 -- (typically @\"so\"@ on Unix and @\"dll\"@ on Windows)
 417 dllExtension :: String
 418 #ifdef mingw32_TARGET_OS
 419 dllExtension = "dll"
 420 #else
 421 dllExtension = "so"
 422 #endif