{- path manipulation
 -
 - Copyright 2010-2014 Joey Hess <id@joeyh.name>
 -
 - License: BSD-2-clause
 -}

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -fno-warn-tabs #-}

module Utility.Path where

import System.FilePath
import Data.List
import Data.Maybe
import Data.Char
import Control.Applicative
import Prelude

import Utility.Monad
import Utility.UserInfo
import Utility.Directory
import Utility.Split

{- Simplifies a path, removing any "." component, collapsing "dir/..", 
 - and removing the trailing path separator.
 -
 - On Windows, preserves whichever style of path separator might be used in
 - the input FilePaths. This is done because some programs in Windows
 - demand a particular path separator -- and which one actually varies!
 -
 - This does not guarantee that two paths that refer to the same location,
 - and are both relative to the same location (or both absolute) will
 - yeild the same result. Run both through normalise from System.FilePath
 - to ensure that.
 -}
simplifyPath :: FilePath -> FilePath
simplifyPath :: FilePath -> FilePath
simplifyPath FilePath
path = FilePath -> FilePath
dropTrailingPathSeparator forall a b. (a -> b) -> a -> b
$ 
	FilePath -> FilePath -> FilePath
joinDrive FilePath
drive forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
joinPath forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath] -> [FilePath]
norm [] forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitPath FilePath
path'
  where
	(FilePath
drive, FilePath
path') = FilePath -> (FilePath, FilePath)
splitDrive FilePath
path

	norm :: [FilePath] -> [FilePath] -> [FilePath]
norm [FilePath]
c [] = forall a. [a] -> [a]
reverse [FilePath]
c
	norm [FilePath]
c (FilePath
p:[FilePath]
ps)
		| FilePath
p' forall a. Eq a => a -> a -> Bool
== FilePath
".." Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
c) Bool -> Bool -> Bool
&& FilePath -> FilePath
dropTrailingPathSeparator ([FilePath]
c forall a. [a] -> Int -> a
!! Int
0) forall a. Eq a => a -> a -> Bool
/= FilePath
".." = 
			[FilePath] -> [FilePath] -> [FilePath]
norm (forall a. Int -> [a] -> [a]
drop Int
1 [FilePath]
c) [FilePath]
ps
		| FilePath
p' forall a. Eq a => a -> a -> Bool
== FilePath
"." = [FilePath] -> [FilePath] -> [FilePath]
norm [FilePath]
c [FilePath]
ps
		| Bool
otherwise = [FilePath] -> [FilePath] -> [FilePath]
norm (FilePath
pforall a. a -> [a] -> [a]
:[FilePath]
c) [FilePath]
ps
	  where
		p' :: FilePath
p' = FilePath -> FilePath
dropTrailingPathSeparator FilePath
p

{- Makes a path absolute.
 -
 - 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 :: FilePath -> FilePath -> FilePath
absPathFrom :: FilePath -> FilePath -> FilePath
absPathFrom FilePath
dir FilePath
path = FilePath -> FilePath
simplifyPath (FilePath -> FilePath -> FilePath
combine FilePath
dir FilePath
path)

{- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
parentDir :: FilePath -> FilePath
parentDir :: FilePath -> FilePath
parentDir = FilePath -> FilePath
takeDirectory forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropTrailingPathSeparator

{- Just the parent directory of a path, or Nothing if the path has no
- parent (ie for "/" or ".") -}
upFrom :: FilePath -> Maybe FilePath
upFrom :: FilePath -> Maybe FilePath
upFrom FilePath
dir
	| forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
dirs forall a. Ord a => a -> a -> Bool
< Int
2 = forall a. Maybe a
Nothing
	| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
joinDrive FilePath
drive forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
intercalate FilePath
s forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
init [FilePath]
dirs
  where
	-- on Unix, the drive will be "/" when the dir is absolute,
	-- otherwise ""
	(FilePath
drive, FilePath
path) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
dir
	s :: FilePath
s = [Char
pathSeparator]
	dirs :: [FilePath]
dirs = forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [[a]]
split FilePath
s FilePath
path

prop_upFrom_basics :: FilePath -> Bool
prop_upFrom_basics :: FilePath -> Bool
prop_upFrom_basics FilePath
dir
	| forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir = Bool
True
	| FilePath
dir forall a. Eq a => a -> a -> Bool
== FilePath
"/" = Maybe FilePath
p forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing
	| Bool
otherwise = Maybe FilePath
p forall a. Eq a => a -> a -> Bool
/= forall a. a -> Maybe a
Just FilePath
dir
  where
	p :: Maybe FilePath
p = FilePath -> Maybe FilePath
upFrom FilePath
dir

{- Checks if the first FilePath is, or could be said to contain the second.
 - For example, "foo/" contains "foo/bar". Also, "foo", "./foo", "foo/" etc
 - are all equivilant.
 -}
dirContains :: FilePath -> FilePath -> Bool
dirContains :: FilePath -> FilePath -> Bool
dirContains FilePath
a FilePath
b = FilePath
a forall a. Eq a => a -> a -> Bool
== FilePath
b Bool -> Bool -> Bool
|| FilePath
a' forall a. Eq a => a -> a -> Bool
== FilePath
b' Bool -> Bool -> Bool
|| (FilePath -> FilePath
addTrailingPathSeparator FilePath
a') forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
b'
  where
	a' :: FilePath
a' = FilePath -> FilePath
norm FilePath
a
	b' :: FilePath
b' = FilePath -> FilePath
norm FilePath
b
	norm :: FilePath -> FilePath
norm = FilePath -> FilePath
normalise forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
simplifyPath

{- Converts a filename into an absolute path.
 -
 - Unlike Directory.canonicalizePath, this does not require the path
 - already exists. -}
absPath :: FilePath -> IO FilePath
absPath :: FilePath -> IO FilePath
absPath FilePath
file = do
	FilePath
cwd <- IO FilePath
getCurrentDirectory
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
absPathFrom FilePath
cwd FilePath
file

{- Constructs a relative path from the CWD to a file.
 -
 - For example, assuming CWD is /tmp/foo/bar:
 -    relPathCwdToFile "/tmp/foo" == ".."
 -    relPathCwdToFile "/tmp/foo/bar" == "" 
 -}
relPathCwdToFile :: FilePath -> IO FilePath
relPathCwdToFile :: FilePath -> IO FilePath
relPathCwdToFile FilePath
f = do
	FilePath
c <- IO FilePath
getCurrentDirectory
	FilePath -> FilePath -> IO FilePath
relPathDirToFile FilePath
c FilePath
f

{- Constructs a relative path from a directory to a file. -}
relPathDirToFile :: FilePath -> FilePath -> IO FilePath
relPathDirToFile :: FilePath -> FilePath -> IO FilePath
relPathDirToFile FilePath
from FilePath
to = FilePath -> FilePath -> FilePath
relPathDirToFileAbs forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
absPath FilePath
from forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> FilePath -> IO FilePath
absPath FilePath
to

{- This requires the first path to be absolute, and the
 - second path cannot contain ../ or ./
 -
 - On Windows, if the paths are on different drives,
 - a relative path is not possible and the path is simply
 - returned as-is.
 -}
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs :: FilePath -> FilePath -> FilePath
relPathDirToFileAbs FilePath
from FilePath
to
#ifdef mingw32_HOST_OS
	| normdrive from /= normdrive to = to
#endif
	| Bool
otherwise = [FilePath] -> FilePath
joinPath forall a b. (a -> b) -> a -> b
$ [FilePath]
dotdots forall a. [a] -> [a] -> [a]
++ [FilePath]
uncommon
  where
	pfrom :: [FilePath]
pfrom = FilePath -> [FilePath]
sp FilePath
from
	pto :: [FilePath]
pto = FilePath -> [FilePath]
sp FilePath
to
	sp :: FilePath -> [FilePath]
sp = forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
dropTrailingPathSeparator forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitPath forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropDrive
	common :: [FilePath]
common = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile forall {a}. Eq a => (a, a) -> Bool
same forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
pfrom [FilePath]
pto
	same :: (a, a) -> Bool
same (a
c,a
d) = a
c forall a. Eq a => a -> a -> Bool
== a
d
	uncommon :: [FilePath]
uncommon = forall a. Int -> [a] -> [a]
drop Int
numcommon [FilePath]
pto
	dotdots :: [FilePath]
dotdots = forall a. Int -> a -> [a]
replicate (forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
pfrom forall a. Num a => a -> a -> a
- Int
numcommon) FilePath
".."
	numcommon :: Int
numcommon = forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
common
#ifdef mingw32_HOST_OS
	normdrive = map toLower . takeWhile (/= ':') . takeDrive
#endif

prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
prop_relPathDirToFile_basics FilePath
from FilePath
to
	| forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
from Bool -> Bool -> Bool
|| forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
to = Bool
True
	| FilePath
from forall a. Eq a => a -> a -> Bool
== FilePath
to = forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r
	| Bool
otherwise = Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
r)
  where
	r :: FilePath
r = FilePath -> FilePath -> FilePath
relPathDirToFileAbs FilePath
from FilePath
to 

prop_relPathDirToFile_regressionTest :: Bool
prop_relPathDirToFile_regressionTest :: Bool
prop_relPathDirToFile_regressionTest = Bool
same_dir_shortcurcuits_at_difference
  where
	{- Two paths have the same directory component at the same
	 - location, but it's not really the same directory.
	 - Code used to get this wrong. -}
	same_dir_shortcurcuits_at_difference :: Bool
same_dir_shortcurcuits_at_difference =
		FilePath -> FilePath -> FilePath
relPathDirToFileAbs ([FilePath] -> FilePath
joinPath [Char
pathSeparator forall a. a -> [a] -> [a]
: FilePath
"tmp", FilePath
"r", FilePath
"lll", FilePath
"xxx", FilePath
"yyy", FilePath
"18"])
			([FilePath] -> FilePath
joinPath [Char
pathSeparator forall a. a -> [a] -> [a]
: FilePath
"tmp", FilePath
"r", FilePath
".git", FilePath
"annex", FilePath
"objects", FilePath
"18", FilePath
"gk", FilePath
"SHA256-foo", FilePath
"SHA256-foo"])
				forall a. Eq a => a -> a -> Bool
== [FilePath] -> FilePath
joinPath [FilePath
"..", FilePath
"..", FilePath
"..", FilePath
"..", FilePath
".git", FilePath
"annex", FilePath
"objects", FilePath
"18", FilePath
"gk", FilePath
"SHA256-foo", FilePath
"SHA256-foo"]

{- Given an original list of paths, and an expanded list derived from it,
 - which may be arbitrarily reordered, generates a list of lists, where
 - each sublist corresponds to one of the original paths.
 -
 - When the original path is a directory, any items in the expanded list
 - that are contained in that directory will appear in its segment.
 -
 - The order of the original list of paths is attempted to be preserved in
 - the order of the returned segments. However, doing so has a O^NM
 - growth factor. So, if the original list has more than 100 paths on it,
 - we stop preserving ordering at that point. Presumably a user passing
 - that many paths in doesn't care too much about order of the later ones.
 -}
segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths :: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [] [FilePath]
new = [[FilePath]
new]
segmentPaths [FilePath
_] [FilePath]
new = [[FilePath]
new] -- optimisation
segmentPaths (FilePath
l:[FilePath]
ls) [FilePath]
new = [FilePath]
found forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [FilePath]
ls [FilePath]
rest
  where
	([FilePath]
found, [FilePath]
rest) = if forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
ls forall a. Ord a => a -> a -> Bool
< Int
100
		then forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (FilePath
l FilePath -> FilePath -> Bool
`dirContains`) [FilePath]
new
		else forall a. (a -> Bool) -> [a] -> ([a], [a])
break (\FilePath
p -> Bool -> Bool
not (FilePath
l FilePath -> FilePath -> Bool
`dirContains` FilePath
p)) [FilePath]
new

{- This assumes that it's cheaper to call segmentPaths on the result,
 - than it would be to run the action separately with each path. In
 - the case of git file list commands, that assumption tends to hold.
 -}
runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
runSegmentPaths :: ([FilePath] -> IO [FilePath]) -> [FilePath] -> IO [[FilePath]]
runSegmentPaths [FilePath] -> IO [FilePath]
a [FilePath]
paths = [FilePath] -> [FilePath] -> [[FilePath]]
segmentPaths [FilePath]
paths forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [FilePath] -> IO [FilePath]
a [FilePath]
paths

{- Converts paths in the home directory to use ~/ -}
relHome :: FilePath -> IO String
relHome :: FilePath -> IO FilePath
relHome FilePath
path = do
	FilePath
home <- IO FilePath
myHomeDir
	forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if FilePath -> FilePath -> Bool
dirContains FilePath
home FilePath
path
		then FilePath
"~/" forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath -> FilePath
relPathDirToFileAbs FilePath
home FilePath
path
		else FilePath
path

{- Checks if a command is available in PATH.
 -
 - The command may be fully-qualified, in which case, this succeeds as
 - long as it exists. -}
inPath :: String -> IO Bool
inPath :: FilePath -> IO Bool
inPath FilePath
command = forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
searchPath FilePath
command

{- Finds a command in PATH and returns the full path to it.
 -
 - The command may be fully qualified already, in which case it will
 - be returned if it exists.
 -
 - Note that this will find commands in PATH that are not executable.
 -}
searchPath :: String -> IO (Maybe FilePath)
searchPath :: FilePath -> IO (Maybe FilePath)
searchPath FilePath
command
	| FilePath -> Bool
isAbsolute FilePath
command = FilePath -> IO (Maybe FilePath)
check FilePath
command
	| Bool
otherwise = IO [FilePath]
getSearchPath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
getM FilePath -> IO (Maybe FilePath)
indir
  where
	indir :: FilePath -> IO (Maybe FilePath)
indir FilePath
d = FilePath -> IO (Maybe FilePath)
check forall a b. (a -> b) -> a -> b
$ FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
command
	check :: FilePath -> IO (Maybe FilePath)
check FilePath
f = forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m (Maybe a)
firstM FilePath -> IO Bool
doesFileExist
#ifdef mingw32_HOST_OS
		[f, f ++ ".exe"]
#else
		[FilePath
f]
#endif

{- Checks if a filename is a unix dotfile. All files inside dotdirs
 - count as dotfiles. -}
dotfile :: FilePath -> Bool
dotfile :: FilePath -> Bool
dotfile FilePath
file
	| FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
"." = Bool
False
	| FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
".." = Bool
False
	| FilePath
f forall a. Eq a => a -> a -> Bool
== FilePath
"" = Bool
False
	| Bool
otherwise = FilePath
"." forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` FilePath
f Bool -> Bool -> Bool
|| FilePath -> Bool
dotfile (FilePath -> FilePath
takeDirectory FilePath
file)
  where
	f :: FilePath
f = FilePath -> FilePath
takeFileName FilePath
file

{- Given a string that we'd like to use as the basis for FilePath, but that
 - was provided by a third party and is not to be trusted, returns the closest
 - sane FilePath.
 -
 - All spaces and punctuation and other wacky stuff are replaced
 - with '_', except for '.'
 - "../" will thus turn into ".._", which is safe.
 -}
sanitizeFilePath :: String -> FilePath
sanitizeFilePath :: FilePath -> FilePath
sanitizeFilePath = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
sanitize
  where
	sanitize :: Char -> Char
sanitize Char
c
		| Char
c forall a. Eq a => a -> a -> Bool
== Char
'.' = Char
c
		| Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char -> Bool
isPunctuation Char
c Bool -> Bool -> Bool
|| Char -> Bool
isSymbol Char
c Bool -> Bool -> Bool
|| Char -> Bool
isControl Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'/' = Char
'_'
		| Bool
otherwise = Char
c

{- Similar to splitExtensions, but knows that some things in FilePaths
 - after a dot are too long to be extensions. -}
splitShortExtensions :: FilePath -> (FilePath, [String])
splitShortExtensions :: FilePath -> (FilePath, [FilePath])
splitShortExtensions = Int -> FilePath -> (FilePath, [FilePath])
splitShortExtensions' Int
5 -- enough for ".jpeg"
splitShortExtensions' :: Int -> FilePath -> (FilePath, [String])
splitShortExtensions' :: Int -> FilePath -> (FilePath, [FilePath])
splitShortExtensions' Int
maxextension = [FilePath] -> FilePath -> (FilePath, [FilePath])
go []
  where
	go :: [FilePath] -> FilePath -> (FilePath, [FilePath])
go [FilePath]
c FilePath
f
		| Int
len forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
len forall a. Ord a => a -> a -> Bool
<= Int
maxextension Bool -> Bool -> Bool
&& Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
base) = 
			[FilePath] -> FilePath -> (FilePath, [FilePath])
go (FilePath
extforall a. a -> [a] -> [a]
:[FilePath]
c) FilePath
base
		| Bool
otherwise = (FilePath
f, [FilePath]
c)
	  where
		(FilePath
base, FilePath
ext) = FilePath -> (FilePath, FilePath)
splitExtension FilePath
f
		len :: Int
len = forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
ext