summaryrefslogtreecommitdiff
path: root/Utility/Path/AbsRel.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/Path/AbsRel.hs')
-rw-r--r--Utility/Path/AbsRel.hs20
1 files changed, 13 insertions, 7 deletions
diff --git a/Utility/Path/AbsRel.hs b/Utility/Path/AbsRel.hs
index 0026bd6..857dd5e 100644
--- a/Utility/Path/AbsRel.hs
+++ b/Utility/Path/AbsRel.hs
@@ -1,6 +1,6 @@
{- absolute and relative path manipulation
-
- - Copyright 2010-2020 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
-
- License: BSD-2-clause
-}
@@ -19,6 +19,7 @@ module Utility.Path.AbsRel (
) where
import System.FilePath.ByteString
+import qualified Data.ByteString as B
#ifdef mingw32_HOST_OS
import System.Directory (getCurrentDirectory)
#else
@@ -64,22 +65,27 @@ absPath file
#endif
return $ absPathFrom cwd file
-{- Constructs a relative path from the CWD to a file.
+{- Constructs the minimal relative path from the CWD to a file.
-
- For example, assuming CWD is /tmp/foo/bar:
- relPathCwdToFile "/tmp/foo" == ".."
- relPathCwdToFile "/tmp/foo/bar" == ""
+ - relPathCwdToFile "../bar/baz" == "baz"
-}
relPathCwdToFile :: RawFilePath -> IO RawFilePath
-relPathCwdToFile f = do
+relPathCwdToFile f
+ -- Optimisation: Avoid doing any IO when the path is relative
+ -- and does not contain any ".." component.
+ | isRelative f && not (".." `B.isInfixOf` f) = return f
+ | otherwise = do
#ifdef mingw32_HOST_OS
- c <- toRawFilePath <$> getCurrentDirectory
+ c <- toRawFilePath <$> getCurrentDirectory
#else
- c <- getWorkingDirectory
+ c <- getWorkingDirectory
#endif
- relPathDirToFile c f
+ relPathDirToFile c f
-{- Constructs a relative path from a directory to a file. -}
+{- Constructs a minimal relative path from a directory to a file. -}
relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath
relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to