[project @ 2005-01-26 14:36:42 by malcolm]
[haskell-directory.git] / System / FilePath.hs
index bb85ba1..2ed786a 100644 (file)
@@ -1,3 +1,5 @@
+{-# OPTIONS_GHC -fno-implicit-prelude #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.FilePath
@@ -5,7 +7,7 @@
 -- License     :  BSD-style (see the file libraries/base/LICENSE)
 -- 
 -- Maintainer  :  libraries@haskell.org
--- Stability   :  stable
+-- Stability   :  highly experimental
 -- Portability :  portable
 --
 -- System-independent pathname manipulations.
@@ -24,6 +26,7 @@ module System.FilePath
          , changeFileExt
          , isRootedPath
          , isAbsolutePath
+         , splitAbsolutePrefix
 
          , pathParents
          , commonParent
@@ -43,9 +46,15 @@ module System.FilePath
         , dllExtension
          ) where
 
+#ifdef __GLASGOW_HASKELL__
+import GHC.Base
+import GHC.IOBase(FilePath)
+import GHC.Num
+#else
 import Prelude -- necessary to get dependencies right
-
-import Data.List(intersperse)
+#endif
+import Data.Maybe
+import Data.List
 
 --------------------------------------------------------------
 -- * FilePath
@@ -79,7 +88,9 @@ splitFileName :: FilePath -> (String, String)
 splitFileName p = (reverse (path2++drive), reverse fname)
   where
 #ifdef mingw32_TARGET_OS
-    (path,drive) = break (== ':') (reverse p)
+    (path,drive) = case p of
+       (c:':':p) -> (reverse p,[':',c])
+       _         -> (reverse p,"")
 #else
     (path,drive) = (reverse p,"")
 #endif
@@ -100,15 +111,14 @@ splitFileName p = (reverse (path2++drive), reverse fname)
 -- > splitFileExt "foo"     == ("foo", "")
 -- > splitFileExt "."       == (".",   "")
 -- > splitFileExt ".."      == ("..",  "")
+-- > splitFileExt "foo.bar."== ("foo.bar.", "")
 splitFileExt :: FilePath -> (String, String)
 splitFileExt p =
-  case pre of
-       []      -> (p, [])
-       (_:pre) -> (reverse (pre++path), reverse suf)
+  case break (== '.') fname of
+       (suf@(_:_),_:pre) -> (reverse (pre++path), reverse suf)
+       _                 -> (p, [])
   where
     (fname,path) = break isPathSeparator (reverse p)
-    (suf,pre) | fname == "." || fname == ".." = (fname,"")
-              | otherwise                     = break (== '.') fname
 
 -- | Split the path into directory, file name and extension. 
 -- The function is an optimized version of the following equation:
@@ -124,7 +134,9 @@ splitFilePath p =
     (_:pre) -> (reverse real_dir, reverse pre, reverse suf)
   where
 #ifdef mingw32_TARGET_OS
-    (path,drive) = break (== ':') (reverse p)
+    (path,drive) = case p of
+       (c:':':p) -> (reverse p,[':',c])
+       _         -> (reverse p,"")
 #else
     (path,drive) = (reverse p,"")
 #endif
@@ -139,7 +151,7 @@ splitFilePath p =
       (_:dir) -> dir++drive
 
 -- | The 'joinFileName' function is the opposite of 'splitFileName'. 
--- It joins directory and file names to form complete file path.
+-- It joins directory and file names to form a complete file path.
 --
 -- The general rule is:
 --
@@ -147,7 +159,7 @@ splitFilePath p =
 -- >   where
 -- >     (dir,basename) = splitFileName path
 --
--- There might be an exeptions to the rule but in any case the
+-- There might be an exceptions to the rule but in any case the
 -- reconstructed path will refer to the same object (file or directory).
 -- An example exception is that on Windows some slashes might be converted
 -- to backslashes.
@@ -160,7 +172,7 @@ joinFileName dir fname
   | otherwise                  = dir++pathSeparator:fname
 
 -- | The 'joinFileExt' function is the opposite of 'splitFileExt'.
--- It joins file name and extension to form complete file path.
+-- It joins a file name and an extension to form a complete file path.
 --
 -- The general rule is:
 --
@@ -210,8 +222,8 @@ isRootedPath (_:':':c:_) | isPathSeparator c = True  -- path with drive letter
 #endif
 isRootedPath _ = False
 
--- | Returns True if this path\'s meaning is independent of any OS
--- "working directory", False if it isn\'t.
+-- | Returns 'True' if this path\'s meaning is independent of any OS
+-- \"working directory\", or 'False' if it isn\'t.
 isAbsolutePath :: FilePath -> Bool
 #ifdef mingw32_TARGET_OS
 isAbsolutePath (_:':':c:_) | isPathSeparator c = True
@@ -220,10 +232,22 @@ isAbsolutePath (c:_)       | isPathSeparator c = True
 #endif
 isAbsolutePath _ = False
 
+-- | If the function is applied to an absolute path then it returns a
+-- local path obtained by dropping the absolute prefix from the path.
+-- Under Windows the prefix is @\"\\\"@, @\"c:\"@ or @\"c:\\\"@.
+-- Under Unix the prefix is always @\"\/\"@.
+splitAbsolutePrefix :: FilePath -> (String,FilePath)
+splitAbsolutePrefix (c:cs) | isPathSeparator c = ([c],cs)
+#ifdef mingw32_TARGET_OS
+splitAbsolutePrefix (d:':':c:cs) | isPathSeparator c = ([d,':',c],cs)  -- path with drive letter
+splitAbsolutePrefix (d:':':cs)                       = ([d,':'],  cs)
+#endif
+splitAbsolutePrefix cs = ("",cs)
+
 -- | Gets this path and all its parents.
 -- The function is useful in case if you want to create 
 -- some file but you aren\'t sure whether all directories 
--- in the path exists or if you want to search upward for some file.
+-- in the path exist or if you want to search upward for some file.
 -- 
 -- Some examples:
 --
@@ -235,9 +259,6 @@ isAbsolutePath _ = False
 -- >  pathParents "dir1"       == [".", "dir1"]
 -- >  pathParents "dir1/dir2"  == [".", "dir1", "dir1/dir2"]
 --
--- In the above examples \"\/\" isn\'t included in the list 
--- because you can\'t create root directory.
---
 -- \[Windows\]
 --
 -- >  pathParents "c:"             == ["c:."]
@@ -247,7 +268,7 @@ isAbsolutePath _ = False
 -- >  pathParents "c:dir1"         == ["c:.","c:dir1"]
 -- >  pathParents "dir1\\dir2"     == [".", "dir1", "dir1\\dir2"]
 --
--- Note that if the file is relative then the the current directory (\".\") 
+-- Note that if the file is relative then the current directory (\".\") 
 -- will be explicitly listed.
 pathParents :: FilePath -> [FilePath]
 pathParents p =
@@ -357,11 +378,7 @@ mkSearchPath paths = concat (intersperse [searchPathSeparator] paths)
 -- operating system also accepts a slash (\"\/\") since DOS 2, the function
 -- checks for it on this platform, too.
 isPathSeparator :: Char -> Bool
-#ifdef mingw32_TARGET_OS
-isPathSeparator ch = ch == '/' || ch == '\\'
-#else
-isPathSeparator ch = ch == '/'
-#endif
+isPathSeparator ch = ch == pathSeparator || ch == '/'
 
 -- | Provides a platform-specific character used to separate directory levels in
 -- a path string that reflects a hierarchical file system organization. The
@@ -374,6 +391,7 @@ pathSeparator = '\\'
 pathSeparator = '/'
 #endif
 
+-- ToDo: This should be determined via autoconf (PATH_SEPARATOR)
 -- | A platform-specific character used to separate search path strings in
 -- environment variables. The separator is a colon (@\":\"@) on Unix and
 -- Macintosh, and a semicolon (@\";\"@) on the Windows operating system.
@@ -386,7 +404,7 @@ searchPathSeparator = ':'
 
 -- ToDo: This should be determined via autoconf (AC_EXEEXT)
 -- | Extension for executable files
--- (typically @\"\"@ on Unix and @\".exe\"@ on Windows or OS\/2)
+-- (typically @\"\"@ on Unix and @\"exe\"@ on Windows or OS\/2)
 exeExtension :: String
 #ifdef mingw32_TARGET_OS
 exeExtension = "exe"
@@ -395,17 +413,13 @@ exeExtension = ""
 #endif
 
 -- ToDo: This should be determined via autoconf (AC_OBJEXT)
--- | Extension for object files
--- (typically @\".o\"@ on Unix and @\".obj\"@ on Windows)
+-- | Extension for object files. For GHC and NHC the extension is @\"o\"@.
+-- Hugs uses either @\"o\"@ or @\"obj\"@ depending on the used C compiler.
 objExtension :: String
-#ifdef mingw32_TARGET_OS
-objExtension = "obj"
-#else
 objExtension = "o"
-#endif
 
 -- | Extension for dynamically linked (or shared) libraries
--- (typically @\".so\"@ on Unix and @\".dll\"@ on Windows)
+-- (typically @\"so\"@ on Unix and @\"dll\"@ on Windows)
 dllExtension :: String
 #ifdef mingw32_TARGET_OS
 dllExtension = "dll"