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

    {-# LANGUAGE PackageImports, 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

    #ifdef mingw32_HOST_OS
    import qualified System.FilePath.Posix as Posix
    #else
    import System.Posix.Files
    import Utility.Exception
    #endif

    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 path = dropTrailingPathSeparator $
    	joinDrive drive $ joinPath $ norm [] $ splitPath path'
      where
    	(drive, path') = splitDrive path

    	norm c [] = reverse c
    	norm c (p:ps)
    		| p' == ".." && not (null c) && dropTrailingPathSeparator (c !! 0) /= ".." =
    			norm (drop 1 c) ps
    		| p' == "." = norm c ps
    		| otherwise = norm (p:c) ps
    	  where
    		p' = dropTrailingPathSeparator 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 dir path = simplifyPath (combine dir path)

    {- takeDirectory "foo/bar/" is "foo/bar". This instead yields "foo" -}
    parentDir :: FilePath -> FilePath
    parentDir = takeDirectory . dropTrailingPathSeparator

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

    prop_upFrom_basics :: FilePath -> Bool
    prop_upFrom_basics dir
    	| null dir = True
    	| dir == "/" = p == Nothing
    	| otherwise = p /= Just dir
      where
    	p = upFrom 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 a b = a == b || a' == b' || (addTrailingPathSeparator a') `isPrefixOf` b'
      where
    	a' = norm a
    	b' = norm b
    	norm = normalise . simplifyPath

    {- Converts a filename into an absolute path.
     -
     - Unlike Directory.canonicalizePath, this does not require the path
     - already exists. -}
    absPath :: FilePath -> IO FilePath
    absPath file = do
    	cwd <- getCurrentDirectory
    	return $ absPathFrom cwd 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 f = do
    	c <- getCurrentDirectory
    	relPathDirToFile c f

    {- Constructs a relative path from a directory to a file. -}
    relPathDirToFile :: FilePath -> FilePath -> IO FilePath
    relPathDirToFile from to = relPathDirToFileAbs <$> absPath from <*> absPath 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 from to
    	| takeDrive from /= takeDrive to = to
    	| otherwise = joinPath $ dotdots ++ uncommon
      where
    	pfrom = sp from
    	pto = sp to
    	sp = map dropTrailingPathSeparator . splitPath
    	common = map fst $ takeWhile same $ zip pfrom pto
    	same (c,d) = c == d
    	uncommon = drop numcommon pto
    	dotdots = replicate (length pfrom - numcommon) ".."
    	numcommon = length common

    prop_relPathDirToFile_basics :: FilePath -> FilePath -> Bool
    prop_relPathDirToFile_basics from to
    	| null from || null to = True
    	| from == to = null r
    	| otherwise = not (null r)
      where
    	r = relPathDirToFileAbs from to

    prop_relPathDirToFile_regressionTest :: Bool
    prop_relPathDirToFile_regressionTest = 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 =
    		relPathDirToFileAbs (joinPath [pathSeparator : "tmp", "r", "lll", "xxx", "yyy", "18"])
    			(joinPath [pathSeparator : "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])
    				== joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "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 [] new = [new]
    segmentPaths [_] new = [new] -- optimisation
    segmentPaths (l:ls) new = found : segmentPaths ls rest
      where
    	(found, rest) = if length ls < 100
    		then partition (l `dirContains`) new
    		else break (\p -> not (l `dirContains` p)) 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 a paths = segmentPaths paths <$> a paths

    {- Converts paths in the home directory to use ~/ -}
    relHome :: FilePath -> IO String
    relHome path = do
    	home <- myHomeDir
    	return $ if dirContains home path
    		then "~/" ++ relPathDirToFileAbs home path
    		else 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 command = isJust <$> searchPath 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 command
    	| isAbsolute command = check command
    	| otherwise = getSearchPath >>= getM indir
      where
    	indir d = check $ d </> command
    	check f = firstM doesFileExist
    #ifdef mingw32_HOST_OS
    		[f, f ++ ".exe"]
    #else
    		[f]
    #endif

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

    {- Converts a DOS style path to a msys2 style path. Only on Windows.
     - Any trailing '\' is preserved as a trailing '/'
     -
     - Taken from: http://sourceforge.net/p/msys2/wiki/MSYS2%20introduction/i
     -
     - The virtual filesystem contains:
     -  /c, /d, ...	mount points for Windows drives
     -}
    toMSYS2Path :: FilePath -> FilePath
    #ifndef mingw32_HOST_OS
    toMSYS2Path = id
    #else
    toMSYS2Path p
    	| null drive = recombine parts
    	| otherwise = recombine $ "/" : driveletter drive : parts
      where
    	(drive, p') = splitDrive p
    	parts = splitDirectories p'
    	driveletter = map toLower . takeWhile (/= ':')
    	recombine = fixtrailing . Posix.joinPath
    	fixtrailing s
    		| hasTrailingPathSeparator p = Posix.addTrailingPathSeparator s
    		| otherwise = s
    #endif

    {- Maximum size to use for a file in a specified directory.
     -
     - Many systems have a 255 byte limit to the name of a file,
     - so that's taken as the max if the system has a larger limit, or has no
     - limit.
     -}
    fileNameLengthLimit :: FilePath -> IO Int
    #ifdef mingw32_HOST_OS
    fileNameLengthLimit _ = return 255
    #else
    fileNameLengthLimit dir = do
    	-- getPathVar can fail due to statfs(2) overflow
    	l <- catchDefaultIO 0 $
    		fromIntegral <$> getPathVar dir FileNameLimit
    	if l <= 0
    		then return 255
    		else return $ minimum [l, 255]
    #endif

    {- 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 = map sanitize
      where
    	sanitize c
    		| c == '.' = c
    		| isSpace c || isPunctuation c || isSymbol c || isControl c || c == '/' = '_'
    		| otherwise = 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 = splitShortExtensions' 5 -- enough for ".jpeg"
    splitShortExtensions' :: Int -> FilePath -> (FilePath, [String])
    splitShortExtensions' maxextension = go []
      where
    	go c f
    		| len > 0 && len <= maxextension && not (null base) =
    			go (ext:c) base
    		| otherwise = (f, c)
    	  where
    		(base, ext) = splitExtension f
    		len = length ext