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