[project @ 2005-01-11 12:12:36 by ross]

[ghc-base.git] / System / FilePath.hs

diff --git a/System/FilePath.hs b/System/FilePath.hs
index cf0a66a..4ae4a88 100644 (file)
--- a/System/FilePath.hs
+++ b/System/FilePath.hs
@@ -1,3 +1,5 @@
+{-# OPTIONS -fno-implicit-prelude #-}
+
 -----------------------------------------------------------------------------
 -- |
 -- Module      :  System.FilePath
@@ -24,6 +26,7 @@ module System.FilePath
          , changeFileExt
          , isRootedPath
          , isAbsolutePath
+         , dropAbsolutePrefix
 
          , 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
@@ -220,6 +229,18 @@ 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 @\"\/\"@.
+dropAbsolutePrefix :: FilePath -> FilePath
+dropAbsolutePrefix (c:cs) | isPathSeparator c = cs
+#ifdef mingw32_TARGET_OS
+dropAbsolutePrefix (_:':':c:cs) | isPathSeparator c = cs  -- path with drive letter
+dropAbsolutePrefix (_:':':cs)                       = cs
+#endif
+dropAbsolutePrefix 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