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 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 exeptions 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 file name and extension to form 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", 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 exists 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 -- In the above examples \"\/\" isn\'t included in the list
 260 -- because you can\'t create root directory.
 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 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 #ifdef mingw32_TARGET_OS
 382 isPathSeparator ch = ch == '/' || ch == '\\'
 383 #else
 384 isPathSeparator ch = ch == '/'
 385 #endif
 386
 387 -- | Provides a platform-specific character used to separate directory levels in
 388 -- a path string that reflects a hierarchical file system organization. The
 389 -- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash
 390 -- (@\"\\\"@) on the Windows operating system.
 391 pathSeparator :: Char
 392 #ifdef mingw32_TARGET_OS
 393 pathSeparator = '\\'
 394 #else
 395 pathSeparator = '/'
 396 #endif
 397
 398 -- | A platform-specific character used to separate search path strings in
 399 -- environment variables. The separator is a colon (@\":\"@) on Unix and
 400 -- Macintosh, and a semicolon (@\";\"@) on the Windows operating system.
 401 searchPathSeparator :: Char
 402 #ifdef mingw32_TARGET_OS
 403 searchPathSeparator = ';'
 404 #else
 405 searchPathSeparator = ':'
 406 #endif
 407
 408 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
 409 -- | Extension for executable files
 410 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
 411 exeExtension :: String
 412 #ifdef mingw32_TARGET_OS
 413 exeExtension = "exe"
 414 #else
 415 exeExtension = ""
 416 #endif
 417
 418 -- ToDo: This should be determined via autoconf (AC_OBJEXT)
 419 -- | Extension for object files
 420 -- (typically @\"o\"@ on Unix and @\"obj\"@ on Windows)
 421 objExtension :: String
 422 #ifdef mingw32_TARGET_OS
 423 objExtension = "obj"
 424 #else
 425 objExtension = "o"
 426 #endif
 427
 428 -- | Extension for dynamically linked (or shared) libraries
 429 -- (typically @\"so\"@ on Unix and @\"dll\"@ on Windows)
 430 dllExtension :: String
 431 #ifdef mingw32_TARGET_OS
 432 dllExtension = "dll"
 433 #else
 434 dllExtension = "so"
 435 #endif