System/FilePath.hs

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