4bf7940d6b
Fix behavior of several commands, including reinject, addurl, and rmurl when given an absolute path to an unlocked file, or a relative path that leaves and re-enters the repository. To avoid slowing down all the cases where the paths are already ok with an unncessary call to getCurrentDirectory, put in an optimisation in relPathCwdToFile. That will probably also speed up other parts of git-annex by some small amount, but I have not benchmarked. Note that I did not convert branchFileRef, because it seems likely that it will be used with a file that is not provided by the user, so is already in a sane format. This is certainly true for the way git-annex uses it, though maybe arguable to the extent Git.Ref is a reusable library.
99 lines
2.8 KiB
Haskell
99 lines
2.8 KiB
Haskell
{- absolute and relative path manipulation
|
|
-
|
|
- Copyright 2010-2021 Joey Hess <id@joeyh.name>
|
|
-
|
|
- License: BSD-2-clause
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
{-# LANGUAGE CPP #-}
|
|
{-# OPTIONS_GHC -fno-warn-tabs #-}
|
|
|
|
module Utility.Path.AbsRel (
|
|
absPathFrom,
|
|
absPath,
|
|
relPathCwdToFile,
|
|
relPathDirToFile,
|
|
relPathDirToFileAbs,
|
|
relHome,
|
|
) where
|
|
|
|
import System.FilePath.ByteString
|
|
import qualified Data.ByteString as B
|
|
#ifdef mingw32_HOST_OS
|
|
import System.Directory (getCurrentDirectory)
|
|
#else
|
|
import System.Posix.Directory.ByteString (getWorkingDirectory)
|
|
#endif
|
|
import Control.Applicative
|
|
import Prelude
|
|
|
|
import Utility.Path
|
|
import Utility.UserInfo
|
|
import Utility.FileSystemEncoding
|
|
|
|
{- Makes a path absolute.
|
|
-
|
|
- Also simplifies it using simplifyPath.
|
|
-
|
|
- The first parameter is a base directory (ie, the cwd) to use if the path
|
|
- is not already absolute, and should itsef be absolute.
|
|
-
|
|
- Does not attempt to deal with edge cases or ensure security with
|
|
- untrusted inputs.
|
|
-}
|
|
absPathFrom :: RawFilePath -> RawFilePath -> RawFilePath
|
|
absPathFrom dir path = simplifyPath (combine dir path)
|
|
|
|
{- Converts a filename into an absolute path.
|
|
-
|
|
- Also simplifies it using simplifyPath.
|
|
-
|
|
- Unlike Directory.canonicalizePath, this does not require the path
|
|
- already exists. -}
|
|
absPath :: RawFilePath -> IO RawFilePath
|
|
absPath file
|
|
-- Avoid unncessarily getting the current directory when the path
|
|
-- is already absolute. absPathFrom uses simplifyPath
|
|
-- so also used here for consistency.
|
|
| isAbsolute file = return $ simplifyPath file
|
|
| otherwise = do
|
|
#ifdef mingw32_HOST_OS
|
|
cwd <- toRawFilePath <$> getCurrentDirectory
|
|
#else
|
|
cwd <- getWorkingDirectory
|
|
#endif
|
|
return $ absPathFrom cwd 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
|
|
-- 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
|
|
#else
|
|
c <- getWorkingDirectory
|
|
#endif
|
|
relPathDirToFile c f
|
|
|
|
{- Constructs a minimal relative path from a directory to a file. -}
|
|
relPathDirToFile :: RawFilePath -> RawFilePath -> IO RawFilePath
|
|
relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath to
|
|
|
|
{- Converts paths in the home directory to use ~/ -}
|
|
relHome :: FilePath -> IO String
|
|
relHome path = do
|
|
let path' = toRawFilePath path
|
|
home <- toRawFilePath <$> myHomeDir
|
|
return $ if dirContains home path'
|
|
then fromRawFilePath ("~/" <> relPathDirToFileAbs home path')
|
|
else path
|