-- | A module for 'FilePath' operations exposing "System.FilePath" plus some additional operations.
--
--   /Windows note:/ The extension methods ('<.>', 'takeExtension' etc) use the Posix variants since on
--   Windows @\"\/\/\*\" '<.>' \"txt\"@ produces @\"\/\/\*\\\\.txt\"@
--   (which is bad for 'Development.Shake.FilePattern' values).
module Development.Shake.FilePath(
    module System.FilePath, module System.FilePath.Posix,
    dropDirectory1, takeDirectory1, replaceDirectory1,
    makeRelativeEx, normaliseEx,
    toNative, toStandard,
    exe
    ) where

import System.Directory (canonicalizePath)
import System.Info.Extra
import Data.List.Extra
import qualified System.FilePath as Native

import System.FilePath hiding
    (splitExtension, takeExtension, replaceExtension, dropExtension, addExtension
    ,hasExtension, (<.>), splitExtensions, takeExtensions, dropExtensions
    )
import System.FilePath.Posix
    (splitExtension, takeExtension, replaceExtension, dropExtension, addExtension
    ,hasExtension, (<.>), splitExtensions, takeExtensions, dropExtensions
    )


-- | Drop the first directory from a 'FilePath'. Should only be used on
--   relative paths.
--
-- > dropDirectory1 "aaa/bbb" == "bbb"
-- > dropDirectory1 "aaa/" == ""
-- > dropDirectory1 "aaa" == ""
-- > dropDirectory1 "" == ""
dropDirectory1 :: FilePath -> FilePath
dropDirectory1 :: FilePath -> FilePath
dropDirectory1 = FilePath -> FilePath
forall a. [a] -> [a]
drop1 (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPathSeparator)


-- | Take the first component of a 'FilePath'. Should only be used on
--   relative paths.
--
-- > takeDirectory1 "aaa/bbb" == "aaa"
-- > takeDirectory1 "aaa/" == "aaa"
-- > takeDirectory1 "aaa" == "aaa"
takeDirectory1 :: FilePath -> FilePath
takeDirectory1 :: FilePath -> FilePath
takeDirectory1 = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPathSeparator)



-- | Replace the first component of a 'FilePath'. Should only be used on
--   relative paths.
--
-- > replaceDirectory1 "root/file.ext" "directory" == "directory/file.ext"
-- > replaceDirectory1 "root/foo/bar/file.ext" "directory" == "directory/foo/bar/file.ext"
replaceDirectory1 :: FilePath -> String -> FilePath
replaceDirectory1 :: FilePath -> FilePath -> FilePath
replaceDirectory1 FilePath
x FilePath
dir = FilePath
dir FilePath -> FilePath -> FilePath
</> FilePath -> FilePath
dropDirectory1 FilePath
x

-- | Make a path relative. Returns Nothing only when the given paths are on
-- different drives. This will try the pure function makeRelative first. If that
-- fails, the paths are canonicalised (removing any indirection and symlinks)
-- and a relative path is derived from there.
--
-- > > -- Given that "/root/a/" is not a symlink
-- > > makeRelativeEx "/root/a/" "/root/b/file.out"
-- > Just "../b/file.out"
-- >
-- > > -- Given that "/root/c/" is a symlink to "/root/e/f/g/"
-- > > makeRelativeEx "/root/c/" "/root/b/file.out"
-- > Just "../../../b/file.out"
-- >
-- > > -- On Windows
-- > > makeRelativeEx "C:\\foo" "D:\\foo\\bar"
-- > Nothing
--
makeRelativeEx :: FilePath -> FilePath -> IO (Maybe FilePath)
makeRelativeEx :: FilePath -> FilePath -> IO (Maybe FilePath)
makeRelativeEx FilePath
pathA FilePath
pathB
    | FilePath -> Bool
isRelative FilePath
makeRelativePathAPathB =
        Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
makeRelativePathAPathB)
    | Bool
otherwise = do
        FilePath
a' <- FilePath -> IO FilePath
canonicalizePath FilePath
pathA
        FilePath
b' <- FilePath -> IO FilePath
canonicalizePath FilePath
pathB
        if FilePath -> FilePath
takeDrive FilePath
a' FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> FilePath
takeDrive FilePath
b'
            then Maybe FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe FilePath
forall a. Maybe a
Nothing
            else FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath) -> IO FilePath -> IO (Maybe FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> FilePath -> IO FilePath
makeRelativeEx' FilePath
a' FilePath
b'
    where
        makeRelativePathAPathB :: FilePath
makeRelativePathAPathB = FilePath -> FilePath -> FilePath
makeRelative FilePath
pathA FilePath
pathB

        makeRelativeEx' :: FilePath -> FilePath -> IO FilePath
        makeRelativeEx' :: FilePath -> FilePath -> IO FilePath
makeRelativeEx' FilePath
a FilePath
b = do
            let rel :: FilePath
rel = FilePath -> FilePath -> FilePath
makeRelative FilePath
a FilePath
b
                parent :: FilePath
parent = FilePath -> FilePath
takeDirectory FilePath
a
            if FilePath -> Bool
isRelative FilePath
rel
                then FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
rel
                else if FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
parent
                    then do
                        FilePath
parentToB <- FilePath -> FilePath -> IO FilePath
makeRelativeEx' FilePath
parent FilePath
b
                        FilePath -> IO FilePath
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath
".." FilePath -> FilePath -> FilePath
</> FilePath
parentToB)

                    -- Impossible: makeRelative should have succeeded in finding
                    -- a relative path once `a == "/"`.
                    else FilePath -> IO FilePath
forall a. HasCallStack => FilePath -> a
error (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"Error calculating relative path from \""
                                FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pathA FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\" to \"" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
pathB FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"\""

-- | Normalise a 'FilePath', applying the rules:
--
-- * All 'pathSeparators' become 'pathSeparator' (@\/@ on Linux, @\\@ on Windows)
--
-- * @foo\/bar\/..\/baz@ becomes @foo\/baz@ (not universally true in the presence of symlinks)
--
-- * @foo\/.\/bar@ becomes @foo\/bar@
--
-- * @foo\/\/bar@ becomes @foo\/bar@
--
--   This function is not based on the 'normalise' function from the @filepath@ library, as that function
--   is quite broken.
normaliseEx :: FilePath -> FilePath
normaliseEx :: FilePath -> FilePath
normaliseEx FilePath
xs | Char
a:Char
b:FilePath
xs <- FilePath
xs, Bool
isWindows Bool -> Bool -> Bool
&& Char -> Bool
sep Char
a Bool -> Bool -> Bool
&& Char -> Bool
sep Char
b = Char
'/' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
f (Char
'/'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
xs) -- account for UNC paths being double //
               | Bool
otherwise = FilePath -> FilePath
f FilePath
xs
    where
        sep :: Char -> Bool
sep = Char -> Bool
Native.isPathSeparator
        f :: FilePath -> FilePath
f FilePath
o = FilePath -> FilePath
toNative (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> FilePath
deslash FilePath
o (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
"/") (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> FilePath
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Char
'/'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:) ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ Int -> [FilePath] -> [FilePath]
g Int
0 ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
split FilePath
o

        deslash :: FilePath -> FilePath -> FilePath
deslash FilePath
o FilePath
x
            | FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"/" = case (Bool
pre,Bool
pos) of
                (Bool
True,Bool
True) -> FilePath
"/"
                (Bool
True,Bool
False) -> FilePath
"/."
                (Bool
False,Bool
True) -> FilePath
"./"
                (Bool
False,Bool
False) -> FilePath
"."
            | Bool
otherwise = (if Bool
pre then FilePath -> FilePath
forall a. a -> a
id else FilePath -> FilePath
forall a. [a] -> [a]
tail) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (if Bool
pos then FilePath -> FilePath
forall a. a -> a
id else FilePath -> FilePath
forall a. [a] -> [a]
init) FilePath
x
            where pre :: Bool
pre = Char -> Bool
sep (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Char
forall a. [a] -> a
head (FilePath -> Char) -> FilePath -> Char
forall a b. (a -> b) -> a -> b
$ FilePath
o FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" "
                  pos :: Bool
pos = Char -> Bool
sep (Char -> Bool) -> Char -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Char
forall a. [a] -> a
last (FilePath -> Char) -> FilePath -> Char
forall a b. (a -> b) -> a -> b
$ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
o

        g :: Int -> [FilePath] -> [FilePath]
g Int
i [] = Int -> FilePath -> [FilePath]
forall a. Int -> a -> [a]
replicate Int
i FilePath
".."
        g Int
i (FilePath
"..":[FilePath]
xs) = Int -> [FilePath] -> [FilePath]
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) [FilePath]
xs
        g Int
i (FilePath
".":[FilePath]
xs) = Int -> [FilePath] -> [FilePath]
g Int
i [FilePath]
xs
        g Int
0 (FilePath
x:[FilePath]
xs) = FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: Int -> [FilePath] -> [FilePath]
g Int
0 [FilePath]
xs
        g Int
i (FilePath
_:[FilePath]
xs) = Int -> [FilePath] -> [FilePath]
g (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [FilePath]
xs -- equivalent to eliminating ../x

        split :: FilePath -> [FilePath]
split FilePath
xs = if FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
ys then [] else FilePath
a FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
split FilePath
b
            where (FilePath
a,FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
sep FilePath
ys
                  ys :: FilePath
ys = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
sep FilePath
xs


-- | Convert to native path separators, namely @\\@ on Windows.
toNative :: FilePath -> FilePath
toNative :: FilePath -> FilePath
toNative = if Bool
isWindows then (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' then Char
'\\' else Char
x) else FilePath -> FilePath
forall a. a -> a
id

-- | Convert all path separators to @/@, even on Windows.
toStandard :: FilePath -> FilePath
toStandard :: FilePath -> FilePath
toStandard = if Bool
isWindows then (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (\Char
x -> if Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' then Char
'/' else Char
x) else FilePath -> FilePath
forall a. a -> a
id


-- | The extension of executables, @\"exe\"@ on Windows and @\"\"@ otherwise.
exe :: String
exe :: FilePath
exe = if Bool
isWindows then FilePath
"exe" else FilePath
""