System/Directory/Internals.hs

   1 {-# OPTIONS_GHC -fno-implicit-prelude #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  System.Directory.Internals
   5 -- Copyright   :  (c) The University of Glasgow 2005
   6 -- License     :  BSD-style (see the file libraries/base/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  hidden
  10 -- Portability :  portable
  11 --
  12 -- System-independent pathname manipulations.
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 -- #hide
  17 module System.Directory.Internals (
  18         joinFileName,
  19         joinFileExt,
  20         parseSearchPath,
  21         pathParents,
  22         exeExtension,
  23   ) where
  24
  25 #if __GLASGOW_HASKELL__
  26 import GHC.Base
  27 import GHC.IOBase (FilePath)
  28 #endif
  29 import Data.List
  30
  31 -- | The 'joinFileName' function is the opposite of 'splitFileName'.
  32 -- It joins directory and file names to form a complete file path.
  33 --
  34 -- The general rule is:
  35 --
  36 -- > dir `joinFileName` basename == path
  37 -- >   where
  38 -- >     (dir,basename) = splitFileName path
  39 --
  40 -- There might be an exceptions to the rule but in any case the
  41 -- reconstructed path will refer to the same object (file or directory).
  42 -- An example exception is that on Windows some slashes might be converted
  43 -- to backslashes.
  44 joinFileName :: String -> String -> FilePath
  45 joinFileName ""  fname = fname
  46 joinFileName "." fname = fname
  47 joinFileName dir ""    = dir
  48 joinFileName dir fname
  49   | isPathSeparator (last dir) = dir++fname
  50   | otherwise                  = dir++pathSeparator:fname
  51
  52 -- | The 'joinFileExt' function is the opposite of 'splitFileExt'.
  53 -- It joins a file name and an extension to form a complete file path.
  54 --
  55 -- The general rule is:
  56 --
  57 -- > filename `joinFileExt` ext == path
  58 -- >   where
  59 -- >     (filename,ext) = splitFileExt path
  60 joinFileExt :: String -> String -> FilePath
  61 joinFileExt path ""  = path
  62 joinFileExt path ext = path ++ '.':ext
  63
  64 -- | Gets this path and all its parents.
  65 -- The function is useful in case if you want to create
  66 -- some file but you aren\'t sure whether all directories
  67 -- in the path exist or if you want to search upward for some file.
  68 --
  69 -- Some examples:
  70 --
  71 -- \[Posix\]
  72 --
  73 -- >  pathParents "/"          == ["/"]
  74 -- >  pathParents "/dir1"      == ["/", "/dir1"]
  75 -- >  pathParents "/dir1/dir2" == ["/", "/dir1", "/dir1/dir2"]
  76 -- >  pathParents "dir1"       == [".", "dir1"]
  77 -- >  pathParents "dir1/dir2"  == [".", "dir1", "dir1/dir2"]
  78 --
  79 -- \[Windows\]
  80 --
  81 -- >  pathParents "c:"             == ["c:."]
  82 -- >  pathParents "c:\\"           == ["c:\\"]
  83 -- >  pathParents "c:\\dir1"       == ["c:\\", "c:\\dir1"]
  84 -- >  pathParents "c:\\dir1\\dir2" == ["c:\\", "c:\\dir1", "c:\\dir1\\dir2"]
  85 -- >  pathParents "c:dir1"         == ["c:.","c:dir1"]
  86 -- >  pathParents "dir1\\dir2"     == [".", "dir1", "dir1\\dir2"]
  87 --
  88 -- Note that if the file is relative then the current directory (\".\")
  89 -- will be explicitly listed.
  90 pathParents :: FilePath -> [FilePath]
  91 pathParents p =
  92     root'' : map ((++) root') (dropEmptyPath $ inits path')
  93     where
  94 #ifdef mingw32_HOST_OS
  95        (root,path) = case break (== ':') p of
  96           (path,    "") -> ("",path)
  97           (root,_:path) -> (root++":",path)
  98 #else
  99        (root,path) = ("",p)
 100 #endif
 101        (root',root'',path') = case path of
 102          (c:path) | isPathSeparator c -> (root++[pathSeparator],root++[pathSeparator],path)
 103          _                            -> (root                 ,root++"."            ,path)
 104
 105        dropEmptyPath ("":paths) = paths
 106        dropEmptyPath paths      = paths
 107
 108        inits :: String -> [String]
 109        inits [] =  [""]
 110        inits cs =
 111          case pre of
 112            "."  -> inits suf
 113            ".." -> map (joinFileName pre) (dropEmptyPath $ inits suf)
 114            _    -> "" : map (joinFileName pre) (inits suf)
 115          where
 116            (pre,suf) = case break isPathSeparator cs of
 117               (pre,"")    -> (pre, "")
 118               (pre,_:suf) -> (pre,suf)
 119
 120 --------------------------------------------------------------
 121 -- * Search path
 122 --------------------------------------------------------------
 123
 124 -- | The function splits the given string to substrings
 125 -- using the 'searchPathSeparator'.
 126 parseSearchPath :: String -> [FilePath]
 127 parseSearchPath path = split path
 128   where
 129     split :: String -> [String]
 130     split s =
 131       case rest' of
 132         []     -> [chunk]
 133         _:rest -> chunk : split rest
 134       where
 135         chunk =
 136           case chunk' of
 137 #ifdef mingw32_HOST_OS
 138             ('\"':xs@(_:_)) | last xs == '\"' -> init xs
 139 #endif
 140             _                                 -> chunk'
 141
 142         (chunk', rest') = break (==searchPathSeparator) s
 143
 144 --------------------------------------------------------------
 145 -- * Separators
 146 --------------------------------------------------------------
 147
 148 -- | Checks whether the character is a valid path separator for the host
 149 -- platform. The valid character is a 'pathSeparator' but since the Windows
 150 -- operating system also accepts a slash (\"\/\") since DOS 2, the function
 151 -- checks for it on this platform, too.
 152 isPathSeparator :: Char -> Bool
 153 isPathSeparator ch = ch == pathSeparator || ch == '/'
 154
 155 -- | Provides a platform-specific character used to separate directory levels in
 156 -- a path string that reflects a hierarchical file system organization. The
 157 -- separator is a slash (@\"\/\"@) on Unix and Macintosh, and a backslash
 158 -- (@\"\\\"@) on the Windows operating system.
 159 pathSeparator :: Char
 160 #ifdef mingw32_HOST_OS
 161 pathSeparator = '\\'
 162 #else
 163 pathSeparator = '/'
 164 #endif
 165
 166 -- ToDo: This should be determined via autoconf (PATH_SEPARATOR)
 167 -- | A platform-specific character used to separate search path strings in
 168 -- environment variables. The separator is a colon (@\":\"@) on Unix and
 169 -- Macintosh, and a semicolon (@\";\"@) on the Windows operating system.
 170 searchPathSeparator :: Char
 171 #ifdef mingw32_HOST_OS
 172 searchPathSeparator = ';'
 173 #else
 174 searchPathSeparator = ':'
 175 #endif
 176
 177 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
 178 -- | Extension for executable files
 179 -- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
 180 exeExtension :: String
 181 #ifdef mingw32_HOST_OS
 182 exeExtension = "exe"
 183 #else
 184 exeExtension = ""
 185 #endif
 186