{-# LANGUAGE CPP #-}

{-
  This module based on System.FilePath.Internal of file-path.
  The code was copied with the permission from the author
  of file-path, Neil Mitchell. Thanks!
  See the copyright at the end of file.
-}

module System.EasyFile.FilePath (
    -- * Separator predicates
    FilePath,
    pathSeparator, pathSeparators, isPathSeparator,
{- xxx
    searchPathSeparator, isSearchPathSeparator,
-}
    extSeparator, isExtSeparator,

{- xxx
    -- * Path methods (environment $PATH)
    splitSearchPath, getSearchPath,
-}

    -- * Extension methods
    splitExtension,
    takeExtension, replaceExtension, dropExtension, addExtension, hasExtension, (<.>),
    splitExtensions, dropExtensions, takeExtensions,

    -- * Drive methods
    splitDrive, joinDrive,
    takeDrive, hasDrive, dropDrive, isDrive,

    -- * Operations on a FilePath, as a list of directories
    splitFileName,
    takeFileName, replaceFileName, dropFileName,
    takeBaseName, replaceBaseName,
    takeDirectory, replaceDirectory,
    combine, (</>),
    splitPath, joinPath, splitDirectories,

    -- * Low level FilePath operators
    hasTrailingPathSeparator,
    addTrailingPathSeparator,
    dropTrailingPathSeparator,

    -- * File name manipulators
    normalise, equalFilePath,
    makeRelative,
    isRelative, isAbsolute,
{- xxx
    isValid, makeValid
-}

#ifdef TESTING
    , isRelativeDrive
#endif

    )
    where

import Data.Char(toLower, toUpper)
import Data.Maybe(isJust, fromJust)

-- import System.Environment(getEnv) -- xxx


infixr 7  <.>
infixr 5  </>





---------------------------------------------------------------------
-- Platform Abstraction Methods (private)

-- | Is the operating system Unix or Linux like
isPosix :: Bool
isPosix :: Bool
isPosix = Bool -> Bool
not Bool
isWindows

-- | Is the operating system Windows like
isWindows :: Bool
#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
isWindows = True
#else
isWindows :: Bool
isWindows = Bool
False
#endif

---------------------------------------------------------------------
-- The basic functions

-- | The character that separates directories.
--
-- > pathSeparator ==  '/'
-- > isPathSeparator pathSeparator
pathSeparator :: Char
pathSeparator :: Char
pathSeparator = Char
'/'

-- | The list of all possible separators.
--
-- > Windows: pathSeparators == ['\\', '/']
-- > Posix:   pathSeparators == ['/']
-- > pathSeparator `elem` pathSeparators
pathSeparators :: [Char]
pathSeparators :: FilePath
pathSeparators = if Bool
isWindows then FilePath
"\\/" else FilePath
"/"

-- | Rather than using @(== 'pathSeparator')@, use this. Test if something
--   is a path separator.
--
-- > isPathSeparator a == (a `elem` pathSeparators)
isPathSeparator :: Char -> Bool
isPathSeparator :: Char -> Bool
isPathSeparator = (Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
pathSeparators)


{- xxx
-- | The character that is used to separate the entries in the $PATH environment variable.
--
-- > Windows: searchPathSeparator == ';'
-- > Posix:   searchPathSeparator == ':'
searchPathSeparator :: Char
searchPathSeparator = if isWindows then ';' else ':'

-- | Is the character a file separator?
--
-- > isSearchPathSeparator a == (a == searchPathSeparator)
isSearchPathSeparator :: Char -> Bool
isSearchPathSeparator = (== searchPathSeparator)
-}

-- | File extension character
--
-- > extSeparator == '.'
extSeparator :: Char
extSeparator :: Char
extSeparator = Char
'.'

-- | Is the character an extension character?
--
-- > isExtSeparator a == (a == extSeparator)
isExtSeparator :: Char -> Bool
isExtSeparator :: Char -> Bool
isExtSeparator = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
extSeparator)




{- xxx
---------------------------------------------------------------------
-- Path methods (environment $PATH)

-- | Take a string, split it on the 'searchPathSeparator' character.
--
--   Follows the recommendations in
--   <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>
--
-- > Posix:   splitSearchPath "File1:File2:File3"  == ["File1","File2","File3"]
-- > Posix:   splitSearchPath "File1::File2:File3" == ["File1",".","File2","File3"]
-- > Windows: splitSearchPath "File1;File2;File3"  == ["File1","File2","File3"]
-- > Windows: splitSearchPath "File1;;File2;File3" == ["File1","File2","File3"]
splitSearchPath :: String -> [FilePath]
splitSearchPath = f
    where
    f xs = case break isSearchPathSeparator xs of
           (pre, []    ) -> g pre
           (pre, _:post) -> g pre ++ f post

    g "" = ["." | isPosix]
    g x = [x]


-- | Get a list of filepaths in the $PATH.
getSearchPath :: IO [FilePath]
getSearchPath = fmap splitSearchPath (getEnv "PATH")
-}

---------------------------------------------------------------------
-- Extension methods

-- | Split on the extension. 'addExtension' is the inverse.
--
-- > uncurry (++) (splitExtension x) == x
-- > uncurry addExtension (splitExtension x) == x
-- > splitExtension "file.txt" == ("file",".txt")
-- > splitExtension "file" == ("file","")
-- > splitExtension "file/file.txt" == ("file/file",".txt")
-- > splitExtension "file.txt/boris" == ("file.txt/boris","")
-- > splitExtension "file.txt/boris.ext" == ("file.txt/boris",".ext")
-- > splitExtension "file/path.txt.bob.fred" == ("file/path.txt.bob",".fred")
-- > splitExtension "file/path.txt/" == ("file/path.txt/","")
splitExtension :: FilePath -> (String, String)
splitExtension :: FilePath -> (FilePath, FilePath)
splitExtension FilePath
x = case FilePath
d of
                       FilePath
"" -> (FilePath
x,FilePath
"")
                       (Char
y:FilePath
ys) -> (FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
ys, Char
y Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
c)
    where
        (FilePath
a,FilePath
b) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
x
        (FilePath
c,FilePath
d) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isExtSeparator (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
b

-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
--
-- > takeExtension x == snd (splitExtension x)
-- > Valid x => takeExtension (addExtension x "ext") == ".ext"
-- > Valid x => takeExtension (replaceExtension x "ext") == ".ext"
takeExtension :: FilePath -> String
takeExtension :: FilePath -> FilePath
takeExtension = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitExtension

-- | Set the extension of a file, overwriting one if already present.
--
-- > replaceExtension "file.txt" ".bob" == "file.bob"
-- > replaceExtension "file.txt" "bob" == "file.bob"
-- > replaceExtension "file" ".bob" == "file.bob"
-- > replaceExtension "file.txt" "" == "file"
-- > replaceExtension "file.fred.bob" "txt" == "file.fred.txt"
replaceExtension :: FilePath -> String -> FilePath
replaceExtension :: FilePath -> FilePath -> FilePath
replaceExtension FilePath
x FilePath
y = FilePath -> FilePath
dropExtension FilePath
x FilePath -> FilePath -> FilePath
<.> FilePath
y

-- | Alias to 'addExtension', for people who like that sort of thing.
(<.>) :: FilePath -> String -> FilePath
<.> :: FilePath -> FilePath -> FilePath
(<.>) = FilePath -> FilePath -> FilePath
addExtension

-- | Remove last extension, and the \".\" preceding it.
--
-- > dropExtension x == fst (splitExtension x)
dropExtension :: FilePath -> FilePath
dropExtension :: FilePath -> FilePath
dropExtension = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitExtension

-- | Add an extension, even if there is already one there.
--   E.g. @addExtension \"foo.txt\" \"bat\" -> \"foo.txt.bat\"@.
--
-- > addExtension "file.txt" "bib" == "file.txt.bib"
-- > addExtension "file." ".bib" == "file..bib"
-- > addExtension "file" ".bib" == "file.bib"
-- > addExtension "/" "x" == "/.x"
-- > Valid x => takeFileName (addExtension (addTrailingPathSeparator x) "ext") == ".ext"
-- > Windows: addExtension "\\\\share" ".txt" == "\\\\share\\.txt"
addExtension :: FilePath -> String -> FilePath
addExtension :: FilePath -> FilePath -> FilePath
addExtension FilePath
file FilePath
"" = FilePath
file
addExtension FilePath
file xs :: FilePath
xs@(Char
x:FilePath
_) = FilePath -> FilePath -> FilePath
joinDrive FilePath
a FilePath
res
    where
        res :: FilePath
res = if Char -> Bool
isExtSeparator Char
x then FilePath
b FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
xs
              else FilePath
b FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
extSeparator] FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
xs

        (FilePath
a,FilePath
b) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
file

-- | Does the given filename have an extension?
--
-- > null (takeExtension x) == not (hasExtension x)
hasExtension :: FilePath -> Bool
hasExtension :: FilePath -> Bool
hasExtension = (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isExtSeparator (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeFileName


-- | Split on all extensions
--
-- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
splitExtensions :: FilePath -> (FilePath, String)
splitExtensions :: FilePath -> (FilePath, FilePath)
splitExtensions FilePath
x = (FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
c, FilePath
d)
    where
        (FilePath
a,FilePath
b) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
x
        (FilePath
c,FilePath
d) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isExtSeparator FilePath
b

-- | Drop all extensions
--
-- > not $ hasExtension (dropExtensions x)
dropExtensions :: FilePath -> FilePath
dropExtensions :: FilePath -> FilePath
dropExtensions = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitExtensions

-- | Get all extensions
--
-- > takeExtensions "file.tar.gz" == ".tar.gz"
takeExtensions :: FilePath -> String
takeExtensions :: FilePath -> FilePath
takeExtensions = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitExtensions



---------------------------------------------------------------------
-- Drive methods

-- | Is the given character a valid drive letter?
-- only a-z and A-Z are letters, not isAlpha which is more unicodey
isLetter :: Char -> Bool
isLetter :: Char -> Bool
isLetter Char
x = (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'a' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'z') Bool -> Bool -> Bool
|| (Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'A' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Z')


-- | Split a path into a drive and a path.
--   On Unix, \/ is a Drive.
--
-- > uncurry (++) (splitDrive x) == x
-- > Windows: splitDrive "file" == ("","file")
-- > Windows: splitDrive "c:/file" == ("c:/","file")
-- > Windows: splitDrive "\\\\shared\\test" == ("\\\\shared\\","test")
-- > Windows: splitDrive "\\\\shared" == ("\\\\shared","")
-- > Windows: splitDrive "\\\\?\\UNC\\shared\\file" == ("\\\\?\\UNC\\shared\\","file")
-- > Windows: splitDrive "\\\\?\\UNCshared\\file" == ("\\\\?\\","UNCshared\\file")
-- > Windows: splitDrive "\\\\?\\d:\\file" == ("\\\\?\\d:\\","file")
-- > Windows: splitDrive "/d" == ("","/d") -- xxx
-- > Posix:   splitDrive "/test" == ("/","test") -- xxx
-- > Posix:   splitDrive "//test" == ("//","test")
-- > Posix:   splitDrive "test/file" == ("","test/file")
-- > Posix:   splitDrive "file" == ("","file")
splitDrive :: FilePath -> (FilePath, FilePath)
splitDrive :: FilePath -> (FilePath, FilePath)
splitDrive FilePath
x | Bool
isPosix = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/') FilePath
x

splitDrive FilePath
x | Maybe (FilePath, FilePath) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (FilePath, FilePath)
y = Maybe (FilePath, FilePath) -> (FilePath, FilePath)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (FilePath, FilePath)
y
    where y :: Maybe (FilePath, FilePath)
y = FilePath -> Maybe (FilePath, FilePath)
readDriveLetter FilePath
x

splitDrive FilePath
x | Maybe (FilePath, FilePath) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (FilePath, FilePath)
y = Maybe (FilePath, FilePath) -> (FilePath, FilePath)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (FilePath, FilePath)
y
    where y :: Maybe (FilePath, FilePath)
y = FilePath -> Maybe (FilePath, FilePath)
readDriveUNC FilePath
x

splitDrive FilePath
x | Maybe (FilePath, FilePath) -> Bool
forall a. Maybe a -> Bool
isJust Maybe (FilePath, FilePath)
y = Maybe (FilePath, FilePath) -> (FilePath, FilePath)
forall a. HasCallStack => Maybe a -> a
fromJust Maybe (FilePath, FilePath)
y
    where y :: Maybe (FilePath, FilePath)
y = FilePath -> Maybe (FilePath, FilePath)
readDriveShare FilePath
x

splitDrive FilePath
x = (FilePath
"",FilePath
x)

addSlash :: FilePath -> FilePath -> (FilePath, FilePath)
addSlash :: FilePath -> FilePath -> (FilePath, FilePath)
addSlash FilePath
a FilePath
xs = (FilePath
aFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
c,FilePath
d)
    where (FilePath
c,FilePath
d) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isPathSeparator FilePath
xs

-- http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp
-- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"
-- a is "\\?\"
readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)
readDriveUNC :: FilePath -> Maybe (FilePath, FilePath)
readDriveUNC (Char
s1:Char
s2:Char
'?':Char
s3:FilePath
xs) | (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPathSeparator [Char
s1,Char
s2,Char
s3] =
    case (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper FilePath
xs of
        (Char
'U':Char
'N':Char
'C':Char
s4:FilePath
_) | Char -> Bool
isPathSeparator Char
s4 ->
            let (FilePath
a,FilePath
b) = FilePath -> (FilePath, FilePath)
readDriveShareName (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
4 FilePath
xs)
            in (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just (Char
s1Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
s2Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'?'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
s3Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
4 FilePath
xs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
a, FilePath
b)
        FilePath
_ -> case FilePath -> Maybe (FilePath, FilePath)
readDriveLetter FilePath
xs of
                 Just (FilePath
a,FilePath
b) -> (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just (Char
s1Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
s2Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
'?'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
s3Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
a,FilePath
b)
                 Maybe (FilePath, FilePath)
Nothing -> Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing
readDriveUNC FilePath
_ = Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing

{- c:\ -}
readDriveLetter :: String -> Maybe (FilePath, FilePath)
readDriveLetter :: FilePath -> Maybe (FilePath, FilePath)
readDriveLetter (Char
x:Char
':':Char
y:FilePath
xs) | Char -> Bool
isLetter Char
x Bool -> Bool -> Bool
&& Char -> Bool
isPathSeparator Char
y = (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just ((FilePath, FilePath) -> Maybe (FilePath, FilePath))
-> (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> (FilePath, FilePath)
addSlash [Char
x,Char
':'] (Char
yChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
xs)
readDriveLetter (Char
x:Char
':':FilePath
xs) | Char -> Bool
isLetter Char
x = (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just ([Char
x,Char
':'], FilePath
xs)
readDriveLetter FilePath
_ = Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing

{- \\sharename\ -}
readDriveShare :: String -> Maybe (FilePath, FilePath)
readDriveShare :: FilePath -> Maybe (FilePath, FilePath)
readDriveShare (Char
s1:Char
s2:FilePath
xs) | Char -> Bool
isPathSeparator Char
s1 Bool -> Bool -> Bool
&& Char -> Bool
isPathSeparator Char
s2 =
        (FilePath, FilePath) -> Maybe (FilePath, FilePath)
forall a. a -> Maybe a
Just (Char
s1Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:Char
s2Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
a,FilePath
b)
    where (FilePath
a,FilePath
b) = FilePath -> (FilePath, FilePath)
readDriveShareName FilePath
xs
readDriveShare FilePath
_ = Maybe (FilePath, FilePath)
forall a. Maybe a
Nothing

{- assume you have already seen \\ -}
{- share\bob -> "share","\","bob" -}
readDriveShareName :: String -> (FilePath, FilePath)
readDriveShareName :: FilePath -> (FilePath, FilePath)
readDriveShareName FilePath
name = FilePath -> FilePath -> (FilePath, FilePath)
addSlash FilePath
a FilePath
b
    where (FilePath
a,FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator FilePath
name



-- | Join a drive and the rest of the path.
--
-- >          uncurry joinDrive (splitDrive x) == x
-- > Windows: joinDrive "C:" "foo" == "C:foo"
-- > Windows: joinDrive "C:/" "bar" == "C:/bar"
-- > Windows: joinDrive "\\\\share" "foo" == "\\\\share/foo" -- xxx
-- > Windows: joinDrive "/:" "foo" == "/:/foo" -- xxx
joinDrive :: FilePath -> FilePath -> FilePath
joinDrive :: FilePath -> FilePath -> FilePath
joinDrive FilePath
a FilePath
b | Bool
isPosix = FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b
              | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
a = FilePath
b
              | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
b = FilePath
a
              | Char -> Bool
isPathSeparator (FilePath -> Char
forall a. HasCallStack => [a] -> a
last FilePath
a) = FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b
              | Bool
otherwise = case FilePath
a of
                                [Char
a1,Char
':'] | Char -> Bool
isLetter Char
a1 -> FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b
                                FilePath
_ -> FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator] FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b

-- | Get the drive from a filepath.
--
-- > takeDrive x == fst (splitDrive x)
takeDrive :: FilePath -> FilePath
takeDrive :: FilePath -> FilePath
takeDrive = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitDrive

-- | Delete the drive, if it exists.
--
-- > dropDrive x == snd (splitDrive x)
dropDrive :: FilePath -> FilePath
dropDrive :: FilePath -> FilePath
dropDrive = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitDrive

-- | Does a path have a drive.
--
-- > not (hasDrive x) == null (takeDrive x)
hasDrive :: FilePath -> Bool
hasDrive :: FilePath -> Bool
hasDrive = Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeDrive


-- | Is an element a drive
isDrive :: FilePath -> Bool
isDrive :: FilePath -> Bool
isDrive = FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropDrive


---------------------------------------------------------------------
-- Operations on a filepath, as a list of directories

-- | Split a filename into directory and file. 'combine' is the inverse.
--
-- > uncurry (++) (splitFileName x) == x
-- > Valid x => uncurry combine (splitFileName x) == x
-- > splitFileName "file/bob.txt" == ("file/", "bob.txt")
-- > splitFileName "file/" == ("file/", "")
-- > splitFileName "bob" == ("", "bob")
-- > Posix:   splitFileName "/" == ("/","")
-- > Windows: splitFileName "c:" == ("c:","")
splitFileName :: FilePath -> (String, String)
splitFileName :: FilePath -> (FilePath, FilePath)
splitFileName FilePath
x = (FilePath
c FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
b, FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
a)
    where
        (FilePath
a,FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
d
        (FilePath
c,FilePath
d) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
x


-- | Set the filename.
--
-- > Valid x => replaceFileName x (takeFileName x) == x
replaceFileName :: FilePath -> String -> FilePath
replaceFileName :: FilePath -> FilePath -> FilePath
replaceFileName FilePath
x FilePath
y = FilePath -> FilePath
dropFileName FilePath
x FilePath -> FilePath -> FilePath
</> FilePath
y

-- | Drop the filename.
--
-- > dropFileName x == fst (splitFileName x)
dropFileName :: FilePath -> FilePath
dropFileName :: FilePath -> FilePath
dropFileName = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitFileName


-- | Get the file name.
--
-- > takeFileName "test/" == ""
-- > takeFileName x `isSuffixOf` x
-- > takeFileName x == snd (splitFileName x)
-- > Valid x => takeFileName (replaceFileName x "fred") == "fred"
-- > Valid x => takeFileName (x </> "fred") == "fred"
-- > Valid x => isRelative (takeFileName x)
takeFileName :: FilePath -> FilePath
takeFileName :: FilePath -> FilePath
takeFileName = (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> (FilePath -> (FilePath, FilePath)) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
splitFileName

-- | Get the base name, without an extension or path.
--
-- > takeBaseName "file/test.txt" == "test"
-- > takeBaseName "dave.ext" == "dave"
-- > takeBaseName "" == ""
-- > takeBaseName "test" == "test"
-- > takeBaseName (addTrailingPathSeparator x) == ""
-- > takeBaseName "file/file.tar.gz" == "file.tar"
takeBaseName :: FilePath -> String
takeBaseName :: FilePath -> FilePath
takeBaseName = FilePath -> FilePath
dropExtension (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeFileName

-- | Set the base name.
--
-- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt"
-- > replaceBaseName "fred" "bill" == "bill"
-- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"
-- > replaceBaseName x (takeBaseName x) == x
replaceBaseName :: FilePath -> String -> FilePath
replaceBaseName :: FilePath -> FilePath -> FilePath
replaceBaseName FilePath
pth FilePath
nam = FilePath -> FilePath -> FilePath
combineAlways FilePath
a (FilePath
nam FilePath -> FilePath -> FilePath
<.> FilePath
ext)
    where
        (FilePath
a,FilePath
b) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
pth
        ext :: FilePath
ext = FilePath -> FilePath
takeExtension FilePath
b

-- | Is an item either a directory or the last character a path separator?
--
-- > hasTrailingPathSeparator "test" == False
-- > hasTrailingPathSeparator "test/" == True
hasTrailingPathSeparator :: FilePath -> Bool
hasTrailingPathSeparator :: FilePath -> Bool
hasTrailingPathSeparator FilePath
"" = Bool
False
hasTrailingPathSeparator FilePath
x = Char -> Bool
isPathSeparator (FilePath -> Char
forall a. HasCallStack => [a] -> a
last FilePath
x)


-- | Add a trailing file path separator if one is not already present.
--
-- > hasTrailingPathSeparator (addTrailingPathSeparator x)
-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x
-- > addTrailingPathSeparator "test/rest" == "test/rest/"
addTrailingPathSeparator :: FilePath -> FilePath
addTrailingPathSeparator :: FilePath -> FilePath
addTrailingPathSeparator FilePath
x = if FilePath -> Bool
hasTrailingPathSeparator FilePath
x then FilePath
x else FilePath
x FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]


-- | Remove any trailing path separators
--
-- > dropTrailingPathSeparator "file/test/" == "file/test"
-- > not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
-- > dropTrailingPathSeparator "/" == "/"
dropTrailingPathSeparator :: FilePath -> FilePath
dropTrailingPathSeparator :: FilePath -> FilePath
dropTrailingPathSeparator FilePath
x =
    if FilePath -> Bool
hasTrailingPathSeparator FilePath
x Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
isDrive FilePath
x)
    then let x' :: FilePath
x' = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
x
         in if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
x' then [Char
pathSeparator] else FilePath
x'
    else FilePath
x


-- | Get the directory name, move up one level.
--
-- >           takeDirectory x `isPrefixOf` x
-- >           takeDirectory "foo" == ""
-- >           takeDirectory "/foo/bar/baz" == "/foo/bar"
-- >           takeDirectory "/foo/bar/baz/" == "/foo/bar/baz"
-- >           takeDirectory "foo/bar/baz" == "foo/bar"
-- > Windows:  takeDirectory "foo\\bar\\\\" == "foo\\bar" -- xxx
-- > Windows:  takeDirectory "C:/" == "C:/"
takeDirectory :: FilePath -> FilePath
takeDirectory :: FilePath -> FilePath
takeDirectory FilePath
x = if FilePath -> Bool
isDrive FilePath
file then FilePath
file
                  else if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
res Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
file) then FilePath
file
                  else FilePath
res
    where
        res :: FilePath
res = FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
file
        file :: FilePath
file = FilePath -> FilePath
dropFileName FilePath
x

-- | Set the directory, keeping the filename the same.
--
-- > replaceDirectory x (takeDirectory x) `equalFilePath` x
replaceDirectory :: FilePath -> String -> FilePath
replaceDirectory :: FilePath -> FilePath -> FilePath
replaceDirectory FilePath
x FilePath
dir = FilePath -> FilePath -> FilePath
combineAlways FilePath
dir (FilePath -> FilePath
takeFileName FilePath
x)


-- | Combine two paths, if the second path 'isAbsolute', then it returns the second.
--
-- > Valid x => combine (takeDirectory x) (takeFileName x) `equalFilePath` x
-- > combine "/" "test" == "/test"
-- > combine "home" "bob" == "home/bob"
combine :: FilePath -> FilePath -> FilePath
combine :: FilePath -> FilePath -> FilePath
combine FilePath
a FilePath
b | FilePath -> Bool
hasDrive FilePath
b Bool -> Bool -> Bool
|| (Bool -> Bool
not (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
b) Bool -> Bool -> Bool
&& Char -> Bool
isPathSeparator (FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
b)) = FilePath
b
            | Bool
otherwise = FilePath -> FilePath -> FilePath
combineAlways FilePath
a FilePath
b

-- | Combine two paths, assuming rhs is NOT absolute.
combineAlways :: FilePath -> FilePath -> FilePath
combineAlways :: FilePath -> FilePath -> FilePath
combineAlways FilePath
a FilePath
b | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
a = FilePath
b
                  | FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
b = FilePath
a
                  | Char -> Bool
isPathSeparator (FilePath -> Char
forall a. HasCallStack => [a] -> a
last FilePath
a) = FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b
                  | FilePath -> Bool
isDrive FilePath
a = FilePath -> FilePath -> FilePath
joinDrive FilePath
a FilePath
b
                  | Bool
otherwise = FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator] FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b


-- | A nice alias for 'combine'.
(</>) :: FilePath -> FilePath -> FilePath
</> :: FilePath -> FilePath -> FilePath
(</>) = FilePath -> FilePath -> FilePath
combine


-- | Split a path by the directory separator.
--
-- > concat (splitPath x) == x
-- > splitPath "test//item/" == ["test//","item/"]
-- > splitPath "test/item/file" == ["test/","item/","file"]
-- > splitPath "" == []
-- > Windows: splitPath "c:/test/path" == ["c:/","test/","path"]
-- > Posix:   splitPath "/file/test" == ["/","file/","test"]
splitPath :: FilePath -> [FilePath]
splitPath :: FilePath -> [FilePath]
splitPath FilePath
x = [FilePath
drive | FilePath
drive FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
""] [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
f FilePath
path
    where
        (FilePath
drive,FilePath
path) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
x

        f :: FilePath -> [FilePath]
f FilePath
"" = []
        f FilePath
y = (FilePath
aFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++FilePath
c) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
f FilePath
d
            where
                (FilePath
a,FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator FilePath
y
                (FilePath
c,FilePath
d) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPathSeparator) FilePath
b

-- | Just as 'splitPath', but don't add the trailing slashes to each element.
--
-- > splitDirectories "test/file" == ["test","file"]
-- > splitDirectories "/test/file" == ["/","test","file"]
-- > Valid x => joinPath (splitDirectories x) `equalFilePath` x
-- > splitDirectories "" == []
splitDirectories :: FilePath -> [FilePath]
splitDirectories :: FilePath -> [FilePath]
splitDirectories FilePath
path =
        if FilePath -> Bool
hasDrive FilePath
path then [FilePath] -> FilePath
forall a. HasCallStack => [a] -> a
head [FilePath]
pathComponents FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath] -> [FilePath]
f ([FilePath] -> [FilePath]
forall a. HasCallStack => [a] -> [a]
tail [FilePath]
pathComponents)
        else [FilePath] -> [FilePath]
f [FilePath]
pathComponents
    where
        pathComponents :: [FilePath]
pathComponents = FilePath -> [FilePath]
splitPath FilePath
path

        f :: [FilePath] -> [FilePath]
f [FilePath]
xs = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
g [FilePath]
xs
        g :: FilePath -> FilePath
g FilePath
x = if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
res then FilePath
x else FilePath
res
            where res :: FilePath
res = (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) FilePath
x


-- | Join path elements back together.
--
-- > Valid x => joinPath (splitPath x) == x
-- > joinPath [] == ""
-- > Posix: joinPath ["test","file","path"] == "test/file/path"

-- Note that this definition on c:\\c:\\, join then split will give c:\\.
joinPath :: [FilePath] -> FilePath
joinPath :: [FilePath] -> FilePath
joinPath [FilePath]
x = (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> FilePath -> FilePath
combine FilePath
"" [FilePath]
x






---------------------------------------------------------------------
-- File name manipulators

-- | Equality of two 'FilePath's.
--   If you call @System.Directory.canonicalizePath@
--   first this has a much better chance of working.
--   Note that this doesn't follow symlinks or DOSNAM~1s.
--
-- >          x == y ==> equalFilePath x y
-- >          normalise x == normalise y ==> equalFilePath x y
-- > Posix:   equalFilePath "foo" "foo/"
-- > Posix:   not (equalFilePath "foo" "/foo")
-- > Posix:   not (equalFilePath "foo" "FOO")
-- > Windows: equalFilePath "foo" "FOO"
equalFilePath :: FilePath -> FilePath -> Bool
equalFilePath :: FilePath -> FilePath -> Bool
equalFilePath FilePath
a FilePath
b = FilePath -> FilePath
f FilePath
a FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> FilePath
f FilePath
b
    where
        f :: FilePath -> FilePath
f FilePath
x | Bool
isWindows = FilePath -> FilePath
dropTrailSlash (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
normalise FilePath
x
            | Bool
otherwise = FilePath -> FilePath
dropTrailSlash (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
normalise FilePath
x

        dropTrailSlash :: FilePath -> FilePath
dropTrailSlash FilePath
x | FilePath -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length FilePath
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Char -> Bool
isPathSeparator (FilePath -> Char
forall a. HasCallStack => [a] -> a
last FilePath
x) = FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
init FilePath
x
                         | Bool
otherwise = FilePath
x


-- | Contract a filename, based on a relative path.
--
--   There is no corresponding @makeAbsolute@ function, instead use
--   @System.Directory.canonicalizePath@ which has the same effect.
--
-- >          Valid y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x
-- >          makeRelative x x == "."
-- >          null y || equalFilePath (makeRelative x (x </> y)) y || null (takeFileName x)
-- > Windows: makeRelative "C:/Home" "c:/home/bob" == "bob"
-- > Windows: makeRelative "C:/Home" "D:/Home/Bob" == "D:/Home/Bob"
-- > Windows: makeRelative "C:/Home" "C:Home/Bob" == "C:Home/Bob"
-- > Windows: makeRelative "/Home" "/home/bob" == "bob"
-- > Posix:   makeRelative "/Home" "/home/bob" == "/home/bob"
-- > Posix:   makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"
-- > Posix:   makeRelative "/fred" "bob" == "bob"
-- > Posix:   makeRelative "/file/test" "/file/test/fred" == "fred"
-- > Posix:   makeRelative "/file/test" "/file/test/fred/" == "fred/"
-- > Posix:   makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
makeRelative :: FilePath -> FilePath -> FilePath
makeRelative :: FilePath -> FilePath -> FilePath
makeRelative FilePath
root FilePath
path
 | FilePath -> FilePath -> Bool
equalFilePath FilePath
root FilePath
path = FilePath
"."
 | FilePath -> FilePath
takeAbs FilePath
root FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath -> FilePath
takeAbs FilePath
path = FilePath
path
 | Bool
otherwise = FilePath -> FilePath -> FilePath
f (FilePath -> FilePath
dropAbs FilePath
root) (FilePath -> FilePath
dropAbs FilePath
path)
    where
        f :: FilePath -> FilePath -> FilePath
f FilePath
"" FilePath
y = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator FilePath
y
        f FilePath
x FilePath
y = let (FilePath
x1,FilePath
x2) = FilePath -> (FilePath, FilePath)
g FilePath
x
                    (FilePath
y1,FilePath
y2) = FilePath -> (FilePath, FilePath)
g FilePath
y
                in if FilePath -> FilePath -> Bool
equalFilePath FilePath
x1 FilePath
y1 then FilePath -> FilePath -> FilePath
f FilePath
x2 FilePath
y2 else FilePath
path

        g :: FilePath -> (FilePath, FilePath)
g FilePath
x = ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator FilePath
a, (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator FilePath
b)
            where (FilePath
a,FilePath
b) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSeparator (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isPathSeparator FilePath
x

        -- on windows, need to drop '/' which is kind of absolute, but not a drive
        dropAbs :: FilePath -> FilePath
dropAbs (Char
x:FilePath
xs) | Char -> Bool
isPathSeparator Char
x = FilePath
xs
        dropAbs FilePath
x = FilePath -> FilePath
dropDrive FilePath
x

        takeAbs :: FilePath -> FilePath
takeAbs (Char
x:FilePath
_) | Char -> Bool
isPathSeparator Char
x = [Char
pathSeparator]
        takeAbs FilePath
x = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (\Char
y -> if Char -> Bool
isPathSeparator Char
y then Char
pathSeparator else Char -> Char
toLower Char
y) (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
takeDrive FilePath
x

-- | Normalise a file
--
-- * \/\/ outside of the drive can be made blank
--
-- * \/ -> 'pathSeparator'
--
-- * .\/ -> \"\"
--
-- > Posix:   normalise "/file/\\test////" == "/file/\\test/"
-- > Posix:   normalise "/file/./test" == "/file/test"
-- > Posix:   normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"
-- > Posix:   normalise "../bob/fred/" == "../bob/fred/"
-- > Posix:   normalise "./bob/fred/" == "bob/fred/"
-- > Windows: normalise "c:\\file/bob\\" == "C:/file/bob/"
-- > Windows: normalise "c:/" == "C:/"
-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test" -- xxx
-- > Windows: normalise "." == "."
-- > Posix:   normalise "./" == "./"
normalise :: FilePath -> FilePath
normalise :: FilePath -> FilePath
normalise FilePath
path = FilePath -> FilePath -> FilePath
joinDrive (FilePath -> FilePath
normaliseDrive FilePath
drv) (FilePath -> FilePath
f FilePath
pth)
              FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator | Bool -> Bool
not (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
pth) Bool -> Bool -> Bool
&& Char -> Bool
isPathSeparator (FilePath -> Char
forall a. HasCallStack => [a] -> a
last FilePath
pth)]
    where
        (FilePath
drv,FilePath
pth) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
path

        f :: FilePath -> FilePath
f = [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath] -> [FilePath]
dropDots [] ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
propSep

        propSep :: FilePath -> FilePath
propSep (Char
a:Char
b:FilePath
xs)
         | Char -> Bool
isPathSeparator Char
a Bool -> Bool -> Bool
&& Char -> Bool
isPathSeparator Char
b = FilePath -> FilePath
propSep (Char
aChar -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
xs)
        propSep (Char
a:FilePath
xs)
         | Char -> Bool
isPathSeparator Char
a = Char
pathSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
propSep FilePath
xs
        propSep (Char
x:FilePath
xs) = Char
x Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath -> FilePath
propSep FilePath
xs
        propSep [] = []

        dropDots :: [FilePath] -> [FilePath] -> [FilePath]
dropDots [FilePath]
acc (FilePath
".":[FilePath]
xs) | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [FilePath] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
xs = [FilePath] -> [FilePath] -> [FilePath]
dropDots [FilePath]
acc [FilePath]
xs
        dropDots [FilePath]
acc (FilePath
x:[FilePath]
xs) = [FilePath] -> [FilePath] -> [FilePath]
dropDots (FilePath
xFilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:[FilePath]
acc) [FilePath]
xs
        dropDots [FilePath]
acc [] = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse [FilePath]
acc

normaliseDrive :: FilePath -> FilePath
normaliseDrive :: FilePath -> FilePath
normaliseDrive FilePath
drive | Bool
isPosix = FilePath
drive
normaliseDrive FilePath
drive = if Maybe (FilePath, FilePath) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (FilePath, FilePath) -> Bool)
-> Maybe (FilePath, FilePath) -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe (FilePath, FilePath)
readDriveLetter FilePath
x2
                       then (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper FilePath
x2
                       else FilePath
drive
    where
        x2 :: FilePath
x2 = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
repSlash FilePath
drive

        repSlash :: Char -> Char
repSlash Char
x = if Char -> Bool
isPathSeparator Char
x then Char
pathSeparator else Char
x

{- xxx
-- information for validity functions on Windows
-- see http://msdn.microsoft.com/library/default.asp?url=/library/en-us/fileio/fs/naming_a_file.asp
badCharacters :: [Char]
badCharacters = ":*?><|\""
badElements :: [FilePath]
badElements = ["CON", "PRN", "AUX", "NUL", "COM1", "COM2", "COM3", "COM4", "COM5", "COM6", "COM7", "COM8", "COM9", "LPT1", "LPT2", "LPT3", "LPT4", "LPT5", "LPT6", "LPT7", "LPT8", "LPT9", "CLOCK$"]

-- | Is a FilePath valid, i.e. could you create a file like it?
--
-- >          isValid "" == False
-- > Posix:   isValid "/random_ path:*" == True
-- > Posix:   isValid x == not (null x)
-- > Windows: isValid "c:\\test" == True
-- > Windows: isValid "c:\\test:of_test" == False
-- > Windows: isValid "test*" == False
-- > Windows: isValid "c:\\test\\nul" == False
-- > Windows: isValid "c:\\test\\prn.txt" == False
-- > Windows: isValid "c:\\nul\\file" == False
-- > Windows: isValid "\\\\" == False
isValid :: FilePath -> Bool
isValid "" = False
isValid _ | isPosix = True
isValid path =
        not (any (`elem` badCharacters) x2) &&
        not (any f $ splitDirectories x2) &&
        not (length path >= 2 && all isPathSeparator path)
    where
        x2 = dropDrive path
        f x = map toUpper (dropExtensions x) `elem` badElements


-- | Take a FilePath and make it valid; does not change already valid FilePaths.
--
-- > isValid (makeValid x)
-- > isValid x ==> makeValid x == x
-- > makeValid "" == "_"
-- > Windows: makeValid "c:\\test:of_test" == "c:\\test_of_test"
-- > Windows: makeValid "test*" == "test_"
-- > Windows: makeValid "c:\\test\\nul" == "c:\\test\\nul_"
-- > Windows: makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"
-- > Windows: makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"
-- > Windows: makeValid "c:\\nul\\file" == "c:\\nul_\\file"
makeValid :: FilePath -> FilePath
makeValid "" = "_"
makeValid path | isPosix = path
makeValid x | length x >= 2 && all isPathSeparator x = take 2 x ++ "drive"
makeValid path = joinDrive drv $ validElements $ validChars pth
    where
        (drv,pth) = splitDrive path

        validChars x = map f x
        f x | x `elem` badCharacters = '_'
            | otherwise = x

        validElements x = joinPath $ map g $ splitPath x
        g x = h (reverse b) ++ reverse a
            where (a,b) = span isPathSeparator $ reverse x
        h x = if map toUpper a `elem` badElements then a ++ "_" <.> b else x
            where (a,b) = splitExtensions x
-}

-- | Is a path relative, or is it fixed to the root?
--
-- > Windows: isRelative "path\\test" == True
-- > Windows: isRelative "c:\\test" == False
-- > Windows: isRelative "c:test" == True
-- > Windows: isRelative "c:" == True
-- > Windows: isRelative "\\\\foo" == False
-- > Windows: isRelative "/foo" == True
-- > Posix:   isRelative "test/path" == True
-- > Posix:   isRelative "/test" == False
isRelative :: FilePath -> Bool
isRelative :: FilePath -> Bool
isRelative = FilePath -> Bool
isRelativeDrive (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeDrive


-- > isRelativeDrive "" == True
-- > Windows: isRelativeDrive "c:\\" == False
-- > Windows: isRelativeDrive "c:/" == False
-- > Windows: isRelativeDrive "c:" == True
-- > Windows: isRelativeDrive "\\\\foo" == False
-- > Posix:   isRelativeDrive "/" == False
isRelativeDrive :: String -> Bool
isRelativeDrive :: FilePath -> Bool
isRelativeDrive FilePath
x = FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
x Bool -> Bool -> Bool
||
    Bool
-> ((FilePath, FilePath) -> Bool)
-> Maybe (FilePath, FilePath)
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> Bool
not (Bool -> Bool)
-> ((FilePath, FilePath) -> Bool) -> (FilePath, FilePath) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isPathSeparator (Char -> Bool)
-> ((FilePath, FilePath) -> Char) -> (FilePath, FilePath) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Char
forall a. HasCallStack => [a] -> a
last (FilePath -> Char)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst) (FilePath -> Maybe (FilePath, FilePath)
readDriveLetter FilePath
x)


-- | @not . 'isRelative'@
--
-- > isAbsolute x == not (isRelative x)
isAbsolute :: FilePath -> Bool
isAbsolute :: FilePath -> Bool
isAbsolute = Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Bool
isRelative

{-
Copyright Neil Mitchell 2005-2007.
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are
met:

    * Redistributions of source code must retain the above copyright
      notice, this list of conditions and the following disclaimer.

    * Redistributions in binary form must reproduce the above
      copyright notice, this list of conditions and the following
      disclaimer in the documentation and/or other materials provided
      with the distribution.

    * Neither the name of Neil Mitchell nor the names of other
      contributors may be used to endorse or promote products derived
      from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-}