{-# LANGUAGE PatternGuards #-}

-- This template expects CPP definitions for:
--     MODULE_NAME = Posix | Windows
--     IS_WINDOWS  = False | True

-- |
-- Module      :  System.FilePath.MODULE_NAME
-- Copyright   :  (c) Neil Mitchell 2005-2014
-- License     :  BSD3
--
-- Maintainer  :  ndmitchell@gmail.com
-- Stability   :  stable
-- Portability :  portable
--
-- A library for 'FilePath' manipulations, using MODULE_NAME style paths on
-- all platforms. Importing "System.FilePath" is usually better.
--
-- Given the example 'FilePath': @\/directory\/file.ext@
--
-- We can use the following functions to extract pieces.
--
-- * 'takeFileName' gives @\"file.ext\"@
--
-- * 'takeDirectory' gives @\"\/directory\"@
--
-- * 'takeExtension' gives @\".ext\"@
--
-- * 'dropExtension' gives @\"\/directory\/file\"@
--
-- * 'takeBaseName' gives @\"file\"@
--
-- And we could have built an equivalent path with the following expressions:
--
-- * @\"\/directory\" '</>' \"file.ext\"@.
--
-- * @\"\/directory\/file" '<.>' \"ext\"@.
--
-- * @\"\/directory\/file.txt" '-<.>' \"ext\"@.
--
-- Each function in this module is documented with several examples,
-- which are also used as tests.
--
-- Here are a few examples of using the @filepath@ functions together:
--
-- /Example 1:/ Find the possible locations of a Haskell module @Test@ imported from module @Main@:
--
-- @['replaceFileName' path_to_main \"Test\" '<.>' ext | ext <- [\"hs\",\"lhs\"] ]@
--
-- /Example 2:/ Download a file from @url@ and save it to disk:
--
-- @do let file = 'makeValid' url
--   System.Directory.createDirectoryIfMissing True ('takeDirectory' file)@
--
-- /Example 3:/ Compile a Haskell file, putting the @.hi@ file under @interface@:
--
-- @'takeDirectory' file '</>' \"interface\" '</>' ('takeFileName' file '-<.>' \"hi\")@
--
-- References:
-- [1] <http://msdn.microsoft.com/en-us/library/windows/desktop/aa365247.aspx Naming Files, Paths and Namespaces> (Microsoft MSDN)
module System.FilePath.Windows
    (
    -- * Separator predicates
    FilePath,
    pathSeparator, pathSeparators, isPathSeparator,
    searchPathSeparator, isSearchPathSeparator,
    extSeparator, isExtSeparator,

    -- * @$PATH@ methods
    splitSearchPath, getSearchPath,

    -- * Extension functions
    splitExtension,
    takeExtension, replaceExtension, (-<.>), dropExtension, addExtension, hasExtension, (<.>),
    splitExtensions, dropExtensions, takeExtensions, replaceExtensions, isExtensionOf,
    stripExtension,

    -- * Filename\/directory functions
    splitFileName,
    takeFileName, replaceFileName, dropFileName,
    takeBaseName, replaceBaseName,
    takeDirectory, replaceDirectory,
    combine, (</>),
    splitPath, joinPath, splitDirectories,

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

    -- * Trailing slash functions
    hasTrailingPathSeparator,
    addTrailingPathSeparator,
    dropTrailingPathSeparator,

    -- * File name manipulations
    normalise, equalFilePath,
    makeRelative,
    isRelative, isAbsolute,
    isValid, makeValid
    )
    where

import Data.Char(toLower, toUpper, isAsciiLower, isAsciiUpper)
import Data.Maybe(isJust)
import Data.List(stripPrefix, isSuffixOf)

import System.Environment(getEnv)


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
isWindows :: Bool
isWindows = Bool
True


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

-- | The character that separates directories. In the case where more than
--   one character is possible, 'pathSeparator' is the \'ideal\' one.
--
-- > Windows: pathSeparator == '\\'
-- > Posix:   pathSeparator ==  '/'
-- > isPathSeparator pathSeparator
pathSeparator :: Char
pathSeparator :: Char
pathSeparator = if Bool
isWindows then Char
'\\' else 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
'/' = Bool
True
isPathSeparator Char
'\\' = Bool
isWindows
isPathSeparator Char
_ = Bool
False


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

-- | Is the character a file separator?
--
-- > isSearchPathSeparator a == (a == searchPathSeparator)
isSearchPathSeparator :: Char -> Bool
isSearchPathSeparator :: Char -> Bool
isSearchPathSeparator = (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
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)


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

-- | Take a string, split it on the 'searchPathSeparator' character.
--   Blank items are ignored on Windows, and converted to @.@ on Posix.
--   On Windows path elements are stripped of quotes.
--
--   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"]
-- > Windows: splitSearchPath "File1;\"File2\";File3" == ["File1","File2","File3"]
splitSearchPath :: String -> [FilePath]
splitSearchPath :: FilePath -> [FilePath]
splitSearchPath = FilePath -> [FilePath]
f
    where
    f :: FilePath -> [FilePath]
f FilePath
xs = case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isSearchPathSeparator FilePath
xs of
           (FilePath
pre, []    ) -> FilePath -> [FilePath]
g FilePath
pre
           (FilePath
pre, Char
_:FilePath
post) -> FilePath -> [FilePath]
g FilePath
pre [FilePath] -> [FilePath] -> [FilePath]
forall a. [a] -> [a] -> [a]
++ FilePath -> [FilePath]
f FilePath
post

    g :: FilePath -> [FilePath]
g FilePath
"" = [FilePath
"." | Bool
isPosix]
    g (Char
'\"':x :: FilePath
x@(Char
_:FilePath
_)) | Bool
isWindows Bool -> Bool -> Bool
&& FilePath -> Char
forall a. HasCallStack => [a] -> a
last FilePath
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"' = [FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
init FilePath
x]
    g FilePath
x = [FilePath
x]


-- | Get a list of 'FilePath's in the $PATH variable.
getSearchPath :: IO [FilePath]
getSearchPath :: IO [FilePath]
getSearchPath = (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> [FilePath]
splitSearchPath (FilePath -> IO FilePath
getEnv FilePath
"PATH")


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

-- | Split on the extension. 'addExtension' is the inverse.
--
-- > splitExtension "/directory/path.ext" == ("/directory/path",".ext")
-- > uncurry (++) (splitExtension x) == x
-- > Valid 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
nameDot of
                       FilePath
"" -> (FilePath
x,FilePath
"")
                       FilePath
_ -> (FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
init FilePath
nameDot, Char
extSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
ext)
    where
        (FilePath
dir,FilePath
file) = FilePath -> (FilePath, FilePath)
splitFileName_ FilePath
x
        (FilePath
nameDot,FilePath
ext) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
breakEnd Char -> Bool
isExtSeparator FilePath
file

-- | Get the extension of a file, returns @\"\"@ for no extension, @.ext@ otherwise.
--
-- > takeExtension "/directory/path.ext" == ".ext"
-- > 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

-- | Remove the current extension and add another, equivalent to 'replaceExtension'.
--
-- > "/directory/path.txt" -<.> "ext" == "/directory/path.ext"
-- > "/directory/path.txt" -<.> ".ext" == "/directory/path.ext"
-- > "foo.o" -<.> "c" == "foo.c"
(-<.>) :: FilePath -> String -> FilePath
-<.> :: FilePath -> FilePath -> FilePath
(-<.>) = FilePath -> FilePath -> FilePath
replaceExtension

-- | Set the extension of a file, overwriting one if already present, equivalent to '-<.>'.
--
-- > replaceExtension "/directory/path.txt" "ext" == "/directory/path.ext"
-- > replaceExtension "/directory/path.txt" ".ext" == "/directory/path.ext"
-- > 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 x y == addExtension (dropExtension x) y
replaceExtension :: FilePath -> String -> FilePath
replaceExtension :: FilePath -> FilePath -> FilePath
replaceExtension FilePath
x FilePath
y = FilePath -> FilePath
dropExtension FilePath
x FilePath -> FilePath -> FilePath
<.> FilePath
y

-- | Add an extension, even if there is already one there, equivalent to 'addExtension'.
--
-- > "/directory/path" <.> "ext" == "/directory/path.ext"
-- > "/directory/path" <.> ".ext" == "/directory/path.ext"
(<.>) :: FilePath -> String -> FilePath
<.> :: FilePath -> FilePath -> FilePath
(<.>) = FilePath -> FilePath -> FilePath
addExtension

-- | Remove last extension, and the \".\" preceding it.
--
-- > dropExtension "/directory/path.ext" == "/directory/path"
-- > 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, equivalent to '<.>'.
--
-- > addExtension "/directory/path" "ext" == "/directory/path.ext"
-- > addExtension "file.txt" "bib" == "file.txt.bib"
-- > addExtension "file." ".bib" == "file..bib"
-- > addExtension "file" ".bib" == "file.bib"
-- > addExtension "/" "x" == "/.x"
-- > 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?
--
-- > hasExtension "/directory/path.ext" == True
-- > hasExtension "/directory/path" == False
-- > 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


-- | Does the given filename have the specified extension?
--
-- > "png" `isExtensionOf` "/directory/file.png" == True
-- > ".png" `isExtensionOf` "/directory/file.png" == True
-- > ".tar.gz" `isExtensionOf` "bar/foo.tar.gz" == True
-- > "ar.gz" `isExtensionOf` "bar/foo.tar.gz" == False
-- > "png" `isExtensionOf` "/directory/file.png.jpg" == False
-- > "csv/table.csv" `isExtensionOf` "/data/csv/table.csv" == False
isExtensionOf :: String -> FilePath -> Bool
isExtensionOf :: FilePath -> FilePath -> Bool
isExtensionOf ext :: FilePath
ext@(Char
'.':FilePath
_) = FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf FilePath
ext (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtensions
isExtensionOf FilePath
ext         = FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isSuffixOf (Char
'.'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
ext) (FilePath -> Bool) -> (FilePath -> FilePath) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
takeExtensions

-- | Drop the given extension from a FilePath, and the @\".\"@ preceding it.
--   Returns 'Nothing' if the FilePath does not have the given extension, or
--   'Just' and the part before the extension if it does.
--
--   This function can be more predictable than 'dropExtensions', especially if the filename
--   might itself contain @.@ characters.
--
-- > stripExtension "hs.o" "foo.x.hs.o" == Just "foo.x"
-- > stripExtension "hi.o" "foo.x.hs.o" == Nothing
-- > dropExtension x == fromJust (stripExtension (takeExtension x) x)
-- > dropExtensions x == fromJust (stripExtension (takeExtensions x) x)
-- > stripExtension ".c.d" "a.b.c.d"  == Just "a.b"
-- > stripExtension ".c.d" "a.b..c.d" == Just "a.b."
-- > stripExtension "baz"  "foo.bar"  == Nothing
-- > stripExtension "bar"  "foobar"   == Nothing
-- > stripExtension ""     x          == Just x
stripExtension :: String -> FilePath -> Maybe FilePath
stripExtension :: FilePath -> FilePath -> Maybe FilePath
stripExtension []        FilePath
path = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path
stripExtension ext :: FilePath
ext@(Char
x:FilePath
_) FilePath
path = FilePath -> FilePath -> Maybe FilePath
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePath
dotExt FilePath
path
    where dotExt :: FilePath
dotExt = if Char -> Bool
isExtSeparator Char
x then FilePath
ext else Char
'.'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:FilePath
ext


-- | Split on all extensions.
--
-- > splitExtensions "/directory/path.ext" == ("/directory/path",".ext")
-- > splitExtensions "file.tar.gz" == ("file",".tar.gz")
-- > uncurry (++) (splitExtensions x) == x
-- > Valid x => uncurry addExtension (splitExtensions x) == x
-- > 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.
--
-- > dropExtensions "/directory/path.ext" == "/directory/path"
-- > dropExtensions "file.tar.gz" == "file"
-- > not $ hasExtension $ dropExtensions x
-- > not $ any isExtSeparator $ takeFileName $ 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 "/directory/path.ext" == ".ext"
-- > 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


-- | Replace all extensions of a file with a new extension. Note
--   that 'replaceExtension' and 'addExtension' both work for adding
--   multiple extensions, so only required when you need to drop
--   all extensions first.
--
-- > replaceExtensions "file.fred.bob" "txt" == "file.txt"
-- > replaceExtensions "file.fred.bob" "tar.gz" == "file.tar.gz"
replaceExtensions :: FilePath -> String -> FilePath
replaceExtensions :: FilePath -> FilePath -> FilePath
replaceExtensions FilePath
x FilePath
y = FilePath -> FilePath
dropExtensions FilePath
x FilePath -> FilePath -> FilePath
<.> FilePath
y



---------------------------------------------------------------------
-- 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 -> Bool
isAsciiLower Char
x Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
x


-- | Split a path into a drive and a path.
--   On Posix, \/ is a Drive.
--
-- > uncurry (++) (splitDrive x) == x
-- > Windows: splitDrive "file" == ("","file")
-- > Windows: splitDrive "c:/file" == ("c:/","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")
-- > Posix:   splitDrive "/test" == ("/","test")
-- > 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 | Just (FilePath, FilePath)
y <- FilePath -> Maybe (FilePath, FilePath)
readDriveLetter FilePath
x = (FilePath, FilePath)
y
splitDrive FilePath
x | Just (FilePath, FilePath)
y <- FilePath -> Maybe (FilePath, FilePath)
readDriveUNC FilePath
x = (FilePath, FilePath)
y
splitDrive FilePath
x | Just (FilePath, FilePath)
y <- FilePath -> Maybe (FilePath, FilePath)
readDriveShare FilePath
x = (FilePath, FilePath)
y
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

-- See [1].
-- "\\?\D:\<path>" or "\\?\UNC\<server>\<share>"
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
                 -- Extended-length path.
                 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.
--
-- > Valid x => uncurry joinDrive (splitDrive x) == x
-- > Windows: joinDrive "C:" "foo" == "C:foo"
-- > Windows: joinDrive "C:\\" "bar" == "C:\\bar"
-- > Windows: joinDrive "\\\\share" "foo" == "\\\\share\\foo"
-- > Windows: joinDrive "/:" "foo" == "/:\\foo"
joinDrive :: FilePath -> FilePath -> FilePath
joinDrive :: FilePath -> FilePath -> FilePath
joinDrive = FilePath -> FilePath -> FilePath
combineAlways

-- | 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)
-- > Posix:   hasDrive "/foo" == True
-- > Windows: hasDrive "C:\\foo" == True
-- > Windows: hasDrive "C:foo" == True
-- >          hasDrive "foo" == False
-- >          hasDrive "" == False
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
--
-- > Posix:   isDrive "/" == True
-- > Posix:   isDrive "/foo" == False
-- > Windows: isDrive "C:\\" == True
-- > Windows: isDrive "C:\\foo" == False
-- >          isDrive "" == False
isDrive :: FilePath -> Bool
isDrive :: FilePath -> Bool
isDrive FilePath
x = Bool -> Bool
not (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
x) Bool -> Bool -> Bool
&& FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null (FilePath -> FilePath
dropDrive FilePath
x)


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

-- | Split a filename into directory and file. '</>' is the inverse.
--   The first component will often end with a trailing slash.
--
-- > splitFileName "/directory/file.ext" == ("/directory/","file.ext")
-- > Valid x => uncurry (</>) (splitFileName x) == x || fst (splitFileName x) == "./"
-- > Valid x => isValid (fst (splitFileName 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 = (if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir then FilePath
"./" else FilePath
dir, FilePath
name)
    where
        (FilePath
dir, FilePath
name) = FilePath -> (FilePath, FilePath)
splitFileName_ FilePath
x

-- version of splitFileName where, if the FilePath has no directory
-- component, the returned directory is "" rather than "./".  This
-- is used in cases where we are going to combine the returned
-- directory to make a valid FilePath, and having a "./" appear would
-- look strange and upset simple equality properties.  See
-- e.g. replaceFileName.
splitFileName_ :: FilePath -> (String, String)
splitFileName_ :: FilePath -> (FilePath, FilePath)
splitFileName_ FilePath
x = (FilePath
drv FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
dir, FilePath
file)
    where
        (FilePath
drv,FilePath
pth) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
x
        (FilePath
dir,FilePath
file) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
breakEnd Char -> Bool
isPathSeparator FilePath
pth

-- | Set the filename.
--
-- > replaceFileName "/directory/other.txt" "file.ext" == "/directory/file.ext"
-- > Valid x => replaceFileName x (takeFileName x) == x
replaceFileName :: FilePath -> String -> FilePath
replaceFileName :: FilePath -> FilePath -> FilePath
replaceFileName FilePath
x FilePath
y = FilePath
a FilePath -> FilePath -> FilePath
</> FilePath
y where (FilePath
a,FilePath
_) = FilePath -> (FilePath, FilePath)
splitFileName_ FilePath
x

-- | Drop the filename. Unlike 'takeDirectory', this function will leave
--   a trailing path separator on the directory.
--
-- > dropFileName "/directory/file.ext" == "/directory/"
-- > 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 "/directory/file.ext" == "file.ext"
-- > 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 "/directory/file.ext" == "file"
-- > 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 "/directory/other.ext" "file" == "/directory/file.ext"
-- > replaceBaseName "file/test.txt" "bob" == "file/bob.txt"
-- > replaceBaseName "fred" "bill" == "bill"
-- > replaceBaseName "/dave/fred/bob.gz.tar" "new" == "/dave/fred/new.tar"
-- > Valid x => 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)


hasLeadingPathSeparator :: FilePath -> Bool
hasLeadingPathSeparator :: FilePath -> Bool
hasLeadingPathSeparator FilePath
"" = Bool
False
hasLeadingPathSeparator FilePath
x = Char -> Bool
isPathSeparator (FilePath -> Char
forall a. HasCallStack => [a] -> a
head FilePath
x)


-- | Add a trailing file path separator if one is not already present.
--
-- > hasTrailingPathSeparator (addTrailingPathSeparator x)
-- > hasTrailingPathSeparator x ==> addTrailingPathSeparator x == x
-- > Posix:    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"
-- >           dropTrailingPathSeparator "/" == "/"
-- > Windows:  dropTrailingPathSeparator "\\" == "\\"
-- > Posix:    not (hasTrailingPathSeparator (dropTrailingPathSeparator x)) || isDrive x
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' = (Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isPathSeparator FilePath
x
         in if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
x' then [FilePath -> Char
forall a. HasCallStack => [a] -> a
last FilePath
x] else FilePath
x'
    else FilePath
x


-- | Get the directory name, move up one level.
--
-- >           takeDirectory "/directory/other.ext" == "/directory"
-- >           takeDirectory x `isPrefixOf` x || takeDirectory x == "."
-- >           takeDirectory "foo" == "."
-- >           takeDirectory "/" == "/"
-- >           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"
-- > Windows:  takeDirectory "foo\\bar\\\\" == "foo\\bar"
-- > Windows:  takeDirectory "C:\\" == "C:\\"
takeDirectory :: FilePath -> FilePath
takeDirectory :: FilePath -> FilePath
takeDirectory = FilePath -> FilePath
dropTrailingPathSeparator (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
dropFileName

-- | Set the directory, keeping the filename the same.
--
-- > replaceDirectory "root/file.ext" "/directory/" == "/directory/file.ext"
-- > Valid x => 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)


-- | An alias for '</>'.
combine :: FilePath -> FilePath -> FilePath
combine :: FilePath -> FilePath -> FilePath
combine FilePath
a FilePath
b | FilePath -> Bool
hasLeadingPathSeparator FilePath
b Bool -> Bool -> Bool
|| FilePath -> Bool
hasDrive 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
                  | FilePath -> Bool
hasTrailingPathSeparator FilePath
a = FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
b
                  | Bool
otherwise = case FilePath
a of
                      [Char
a1,Char
':'] | Bool
isWindows Bool -> Bool -> Bool
&& 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


-- | Combine two paths with a path separator.
--   If the second path starts with a path separator or a drive letter, then it returns the second.
--   The intention is that @readFile (dir '</>' file)@ will access the same file as
--   @setCurrentDirectory dir; readFile file@.
--
-- > Posix:   "/directory" </> "file.ext" == "/directory/file.ext"
-- > Windows: "/directory" </> "file.ext" == "/directory\\file.ext"
-- >          "directory" </> "/file.ext" == "/file.ext"
-- > Valid x => (takeDirectory x </> takeFileName x) `equalFilePath` x
--
--   Combined:
--
-- > Posix:   "/" </> "test" == "/test"
-- > Posix:   "home" </> "bob" == "home/bob"
-- > Posix:   "x:" </> "foo" == "x:/foo"
-- > Windows: "C:\\foo" </> "bar" == "C:\\foo\\bar"
-- > Windows: "home" </> "bob" == "home\\bob"
--
--   Not combined:
--
-- > Posix:   "home" </> "/bob" == "/bob"
-- > Windows: "home" </> "C:\\bob" == "C:\\bob"
--
--   Not combined (tricky):
--
--   On Windows, if a filepath starts with a single slash, it is relative to the
--   root of the current drive. In [1], this is (confusingly) referred to as an
--   absolute path.
--   The current behavior of '</>' is to never combine these forms.
--
-- > Windows: "home" </> "/bob" == "/bob"
-- > Windows: "home" </> "\\bob" == "\\bob"
-- > Windows: "C:\\home" </> "\\bob" == "\\bob"
--
--   On Windows, from [1]: "If a file name begins with only a disk designator
--   but not the backslash after the colon, it is interpreted as a relative path
--   to the current directory on the drive with the specified letter."
--   The current behavior of '</>' is to never combine these forms.
--
-- > Windows: "D:\\foo" </> "C:bar" == "C:bar"
-- > Windows: "C:\\foo" </> "C:bar" == "C:bar"
(</>) :: FilePath -> FilePath -> FilePath
</> :: FilePath -> FilePath -> FilePath
(</>) = FilePath -> FilePath -> FilePath
combine


-- | Split a path by the directory separator.
--
-- > splitPath "/directory/file.ext" == ["/","directory/","file.ext"]
-- > 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])
span  Char -> Bool
isPathSeparator FilePath
b

-- | Just as 'splitPath', but don't add the trailing slashes to each element.
--
-- >          splitDirectories "/directory/file.ext" == ["/","directory","file.ext"]
-- >          splitDirectories "test/file" == ["test","file"]
-- >          splitDirectories "/test/file" == ["/","test","file"]
-- > Windows: splitDirectories "C:\\test\\file" == ["C:\\", "test", "file"]
-- >          Valid x => joinPath (splitDirectories x) `equalFilePath` x
-- >          splitDirectories "" == []
-- > Windows: splitDirectories "C:\\test\\\\\\file" == ["C:\\", "test", "file"]
-- >          splitDirectories "/test///file" == ["/","test","file"]
splitDirectories :: FilePath -> [FilePath]
splitDirectories :: FilePath -> [FilePath]
splitDirectories = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
dropTrailingPathSeparator ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitPath


-- | Join path elements back together.
--
-- > joinPath a == foldr (</>) "" a
-- > joinPath ["/","directory/","file.ext"] == "/directory/file.ext"
-- > Valid x => joinPath (splitPath x) == x
-- > joinPath [] == ""
-- > Posix: joinPath ["test","file","path"] == "test/file/path"
joinPath :: [FilePath] -> FilePath
-- Note that this definition on c:\\c:\\, join then split will give c:\\.
joinPath :: [FilePath] -> FilePath
joinPath = (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
""






---------------------------------------------------------------------
-- 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.
--
-- Similar to 'normalise', this does not expand @".."@, because of symlinks.
--
-- >          x == y ==> equalFilePath x y
-- >          normalise x == normalise y ==> equalFilePath x y
-- >          equalFilePath "foo" "foo/"
-- >          not (equalFilePath "/a/../c" "/c")
-- >          not (equalFilePath "foo" "/foo")
-- > Posix:   not (equalFilePath "foo" "FOO")
-- > Windows: equalFilePath "foo" "FOO"
-- > Windows: not (equalFilePath "C:" "C:/")
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
dropTrailingPathSeparator (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
dropTrailingPathSeparator (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
normalise FilePath
x


-- | Contract a filename, based on a relative path. Note that the resulting path
--   will never introduce @..@ paths, as the presence of symlinks means @..\/b@
--   may not reach @a\/b@ if it starts from @a\/c@. For a worked example see
--   <http://neilmitchell.blogspot.co.uk/2015/10/filepaths-are-subtle-symlinks-are-hard.html this blog post>.
--
--   The corresponding @makeAbsolute@ function can be found in
--   @System.Directory@.
--
-- >          makeRelative "/directory" "/directory/file.ext" == "file.ext"
-- >          Valid x => makeRelative (takeDirectory x) x `equalFilePath` takeFileName x
-- >          makeRelative x x == "."
-- >          Valid x y => equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x
-- > Windows: makeRelative "C:\\Home" "c:\\home\\bob" == "bob"
-- > 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"
-- > Windows: makeRelative "/" "//" == "//"
-- > 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 FilePath
x | FilePath -> Bool
hasLeadingPathSeparator FilePath
x Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
hasDrive FilePath
x) = FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
tail FilePath
x
        dropAbs FilePath
x = FilePath -> FilePath
dropDrive FilePath
x

        takeAbs :: FilePath -> FilePath
takeAbs FilePath
x | FilePath -> Bool
hasLeadingPathSeparator FilePath
x Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
hasDrive FilePath
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'
--
-- * .\/ -> \"\"
--
-- Does not remove @".."@, because of symlinks.
--
-- > 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 "/a/../c" == "/a/../c"
-- > Posix:   normalise "./bob/fred/" == "bob/fred/"
-- > Windows: normalise "c:\\file/bob\\" == "C:\\file\\bob\\"
-- > Windows: normalise "c:\\" == "C:\\"
-- > Windows: normalise "C:.\\" == "C:"
-- > Windows: normalise "\\\\server\\test" == "\\\\server\\test"
-- > Windows: normalise "//server/test" == "\\\\server\\test"
-- > Windows: normalise "c:/file" == "C:\\file"
-- > Windows: normalise "/file" == "\\file"
-- > Windows: normalise "\\" == "\\"
-- > Windows: normalise "/./" == "\\"
-- >          normalise "." == "."
-- > Posix:   normalise "./" == "./"
-- > Posix:   normalise "./." == "./"
-- > Posix:   normalise "/./" == "/"
-- > Posix:   normalise "/" == "/"
-- > Posix:   normalise "bob/fred/." == "bob/fred/"
-- > Posix:   normalise "//home" == "/home"
normalise :: FilePath -> FilePath
normalise :: FilePath -> FilePath
normalise FilePath
path = FilePath
result FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator | Bool
addPathSeparator]
    where
        (FilePath
drv,FilePath
pth) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
path
        result :: FilePath
result = FilePath -> FilePath -> FilePath
joinDrive' (FilePath -> FilePath
normaliseDrive FilePath
drv) (FilePath -> FilePath
f FilePath
pth)

        joinDrive' :: FilePath -> FilePath -> FilePath
joinDrive' FilePath
"" FilePath
"" = FilePath
"."
        joinDrive' FilePath
d FilePath
p = FilePath -> FilePath -> FilePath
joinDrive FilePath
d FilePath
p

        addPathSeparator :: Bool
addPathSeparator = FilePath -> Bool
isDirPath FilePath
pth
            Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
hasTrailingPathSeparator FilePath
result)
            Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
isRelativeDrive FilePath
drv)

        isDirPath :: FilePath -> Bool
isDirPath FilePath
xs = FilePath -> Bool
hasTrailingPathSeparator FilePath
xs
            Bool -> Bool -> Bool
|| Bool -> Bool
not (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
xs) Bool -> Bool -> Bool
&& FilePath -> Char
forall a. HasCallStack => [a] -> a
last FilePath
xs Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
&& FilePath -> Bool
hasTrailingPathSeparator (FilePath -> FilePath
forall a. HasCallStack => [a] -> [a]
init FilePath
xs)

        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]
dropDots ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
propSep ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories

        propSep :: [FilePath] -> [FilePath]
propSep (FilePath
x:[FilePath]
xs) | (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPathSeparator FilePath
x = [Char
pathSeparator] FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs
                       | Bool
otherwise = FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs
        propSep [] = []

        dropDots :: [FilePath] -> [FilePath]
dropDots = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (FilePath
"." FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/=)

normaliseDrive :: FilePath -> FilePath
normaliseDrive :: FilePath -> FilePath
normaliseDrive FilePath
"" = FilePath
""
normaliseDrive FilePath
_ | Bool
isPosix = [Char
pathSeparator]
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
x2
    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

-- Information for validity functions on Windows. See [1].
isBadCharacter :: Char -> Bool
isBadCharacter :: Char -> Bool
isBadCharacter Char
x = Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\0' Bool -> Bool -> Bool
&& Char
x Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\31' Bool -> Bool -> Bool
|| Char
x Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
":*?><|\""

badElements :: [FilePath]
badElements :: [FilePath]
badElements =
    [FilePath
"CON",FilePath
"PRN",FilePath
"AUX",FilePath
"NUL",FilePath
"CLOCK$"
    ,FilePath
"COM1",FilePath
"COM2",FilePath
"COM3",FilePath
"COM4",FilePath
"COM5",FilePath
"COM6",FilePath
"COM7",FilePath
"COM8",FilePath
"COM9"
    ,FilePath
"LPT1",FilePath
"LPT2",FilePath
"LPT3",FilePath
"LPT4",FilePath
"LPT5",FilePath
"LPT6",FilePath
"LPT7",FilePath
"LPT8",FilePath
"LPT9"]


-- | Is a FilePath valid, i.e. could you create a file like it? This function checks for invalid names,
--   and invalid characters, but does not check if length limits are exceeded, as these are typically
--   filesystem dependent.
--
-- >          isValid "" == False
-- >          isValid "\0" == 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
-- > Windows: isValid "\\\\\\foo" == False
-- > Windows: isValid "\\\\?\\D:file" == False
-- > Windows: isValid "foo\tbar" == False
-- > Windows: isValid "nul .txt" == False
-- > Windows: isValid " nul.txt" == True
isValid :: FilePath -> Bool
isValid :: FilePath -> Bool
isValid FilePath
"" = Bool
False
isValid FilePath
x | Char
'\0' Char -> FilePath -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
x = Bool
False
isValid FilePath
_ | Bool
isPosix = Bool
True
isValid FilePath
path =
        Bool -> Bool
not ((Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isBadCharacter FilePath
x2) Bool -> Bool -> Bool
&&
        Bool -> Bool
not ((FilePath -> Bool) -> [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any FilePath -> Bool
f ([FilePath] -> Bool) -> [FilePath] -> Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitDirectories FilePath
x2) Bool -> Bool -> Bool
&&
        Bool -> Bool
not (Maybe (FilePath, FilePath) -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe (FilePath, FilePath)
readDriveShare FilePath
x1) Bool -> Bool -> Bool
&& (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPathSeparator FilePath
x1) Bool -> Bool -> Bool
&&
        Bool -> Bool
not (Maybe (FilePath, FilePath) -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe (FilePath, FilePath)
readDriveUNC FilePath
x1) Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
hasTrailingPathSeparator FilePath
x1))
    where
        (FilePath
x1,FilePath
x2) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
path
        f :: FilePath -> Bool
f FilePath
x = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
dropExtensions FilePath
x) FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
badElements


-- | Take a FilePath and make it valid; does not change already valid FilePaths.
--
-- > isValid (makeValid x)
-- > isValid x ==> makeValid x == x
-- > makeValid "" == "_"
-- > makeValid "file\0name" == "file_name"
-- > Windows: makeValid "c:\\already\\/valid" == "c:\\already\\/valid"
-- > 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"
-- > Windows: makeValid "\\\\\\foo" == "\\\\drive"
-- > Windows: makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file"
-- > Windows: makeValid "nul .txt" == "nul _.txt"
makeValid :: FilePath -> FilePath
makeValid :: FilePath -> FilePath
makeValid FilePath
"" = FilePath
"_"
makeValid FilePath
path
        | Bool
isPosix = (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
'\0' then Char
'_' else Char
x) FilePath
path
        | Maybe (FilePath, FilePath) -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe (FilePath, FilePath)
readDriveShare FilePath
drv) Bool -> Bool -> Bool
&& (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPathSeparator FilePath
drv = Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
2 FilePath
drv FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"drive"
        | Maybe (FilePath, FilePath) -> Bool
forall a. Maybe a -> Bool
isJust (FilePath -> Maybe (FilePath, FilePath)
readDriveUNC FilePath
drv) Bool -> Bool -> Bool
&& Bool -> Bool
not (FilePath -> Bool
hasTrailingPathSeparator FilePath
drv) =
            FilePath -> FilePath
makeValid (FilePath
drv FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator] FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
pth)
        | Bool
otherwise = FilePath -> FilePath -> FilePath
joinDrive FilePath
drv (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
validElements (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
validChars FilePath
pth
    where
        (FilePath
drv,FilePath
pth) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
path

        validChars :: FilePath -> FilePath
validChars = (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
f
        f :: Char -> Char
f Char
x = if Char -> Bool
isBadCharacter Char
x then Char
'_' else Char
x

        validElements :: FilePath -> FilePath
validElements FilePath
x = [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath) -> [FilePath] -> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
g ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitPath FilePath
x
        g :: FilePath -> FilePath
g FilePath
x = FilePath -> FilePath
h FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [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
x
        h :: FilePath -> FilePath
h FilePath
x = if (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper ((Char -> Bool) -> FilePath -> FilePath
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') FilePath
a) FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
badElements then FilePath
a FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"_" FilePath -> FilePath -> FilePath
<.> FilePath
b else FilePath
x
            where (FilePath
a,FilePath
b) = FilePath -> (FilePath, FilePath)
splitExtensions FilePath
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:\\" == False
-- > Windows: isRelative "c:/" == False
-- > Windows: isRelative "c:" == True
-- > Windows: isRelative "\\\\foo" == False
-- > Windows: isRelative "\\\\?\\foo" == False
-- > Windows: isRelative "\\\\?\\UNC\\foo" == False
-- > Windows: isRelative "/foo" == True
-- > Windows: isRelative "\\foo" == True
-- > Posix:   isRelative "test/path" == True
-- > Posix:   isRelative "/test" == False
-- > Posix:   isRelative "/" == False
--
-- According to [1]:
--
-- * "A UNC name of any format [is never relative]."
--
-- * "You cannot use the "\\?\" prefix with a relative path."
isRelative :: FilePath -> Bool
isRelative :: FilePath -> Bool
isRelative FilePath
x = FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
drive Bool -> Bool -> Bool
|| FilePath -> Bool
isRelativeDrive FilePath
drive
    where drive :: FilePath
drive = FilePath -> FilePath
takeDrive FilePath
x


{- c:foo -}
-- From [1]: "If a file name begins with only a disk designator but not the
-- backslash after the colon, it is interpreted as a relative path to the
-- current directory on the drive with the specified letter."
isRelativeDrive :: String -> Bool
isRelativeDrive :: FilePath -> Bool
isRelativeDrive FilePath
x =
    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
. FilePath -> Bool
hasTrailingPathSeparator (FilePath -> Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> Bool
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


-----------------------------------------------------------------------------
-- dropWhileEnd (>2) [1,2,3,4,1,2,3,4] == [1,2,3,4,1,2])
-- Note that Data.List.dropWhileEnd is only available in base >= 4.5.
dropWhileEnd :: (a -> Bool) -> [a] -> [a]
dropWhileEnd :: forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd a -> Bool
p = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile a -> Bool
p ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

-- takeWhileEnd (>2) [1,2,3,4,1,2,3,4] == [3,4])
takeWhileEnd :: (a -> Bool) -> [a] -> [a]
takeWhileEnd :: forall a. (a -> Bool) -> [a] -> [a]
takeWhileEnd a -> Bool
p = [a] -> [a]
forall a. [a] -> [a]
reverse ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile a -> Bool
p ([a] -> [a]) -> ([a] -> [a]) -> [a] -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> [a]
forall a. [a] -> [a]
reverse

-- spanEnd (>2) [1,2,3,4,1,2,3,4] = ([1,2,3,4,1,2], [3,4])
spanEnd :: (a -> Bool) -> [a] -> ([a], [a])
spanEnd :: forall a. (a -> Bool) -> [a] -> ([a], [a])
spanEnd a -> Bool
p [a]
xs = ((a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd a -> Bool
p [a]
xs, (a -> Bool) -> [a] -> [a]
forall a. (a -> Bool) -> [a] -> [a]
takeWhileEnd a -> Bool
p [a]
xs)

-- breakEnd (< 2) [1,2,3,4,1,2,3,4] == ([1,2,3,4,1],[2,3,4])
breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
breakEnd :: forall a. (a -> Bool) -> [a] -> ([a], [a])
breakEnd a -> Bool
p = (a -> Bool) -> [a] -> ([a], [a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
spanEnd (Bool -> Bool
not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Bool
p)

-- | The stripSuffix function drops the given suffix from a list. It returns
-- Nothing if the list did not end with the suffix given, or Just the list
-- before the suffix, if it does.
stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
stripSuffix :: forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [a]
xs [a]
ys = ([a] -> [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> [a]
forall a. [a] -> [a]
reverse (Maybe [a] -> Maybe [a]) -> Maybe [a] -> Maybe [a]
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> Maybe [a]
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
xs) ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
ys)