git-annex/Utility/Path/AbsRel.hs

{- 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