{-# LANGUAGE CPP, ViewPatterns, PatternSynonyms #-}

#if defined(mingw32_HOST_OS) || defined(__MINGW32__)
#else
#define IS_POSIX
#endif

{- |
    Module      :  Data.FilePath
    Copyright   :  (c) Andrey Mulik 2020
    License     :  BSD-style
    Maintainer  :  work.a.mulik@gmail.com
    Portability :  non-portable (GHC extensions)
    
    @Data.FilePath@ provides pattern synonyms similar to @System.FilePath@
    functions. So you don't need the @filepath@ package, when use @sdp-io@.
-}
module Data.FilePath
(
  -- * FilePath
  FilePath, isPathSep, isValid, isRelative, isAbsolute,
  
  makeValid, normalise, equalFilePath, makeRelative,
  
  -- * @$PATH@
  getPath,
  
  -- * Patterns
  pattern PathSep,
  
  -- ** Drive
  pattern (:\\),
  
  -- ** Extensions
  pattern (:.), pattern (:..),
  
  -- ** Split path
  pattern (:/), pattern (://), pattern Path, pattern Dirs
)
where

import Prelude ()
import SDP.SafePrelude hiding ( many )
import SDP.Linear

import Data.Char

#ifndef IS_POSIX
import Data.Maybe

import Text.ParserCombinators.ReadPrec ( lift )
import Text.ParserCombinators.ReadP

import Text.Read.SDP ( readMaybeBy )
#endif

import System.Environment

default ()

infixr 7 :., :.. -- like <.>
infixr 5 :/, :// -- like </>

--------------------------------------------------------------------------------

-- | Separator check.
isPathSep :: Char -> Bool
#ifdef IS_POSIX
isPathSep :: Char -> Bool
isPathSep =  (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')
#else
isPathSep =  (\ c -> c == '/' || c == '\\')
#endif

-- | Default path separator.
pattern PathSep :: Char
#ifdef IS_POSIX
pattern $bPathSep :: Char
$mPathSep :: forall r. Char -> (Void# -> r) -> (Void# -> r) -> r
PathSep =  '/'
#else
pattern PathSep <- ((\ c -> c == '/' || c == '\\') -> True) where PathSep = '\\'
#endif

--------------------------------------------------------------------------------

{- PATH parse. -}

-- | Get a list of 'FilePath's in the $PATH.
getPath :: IO [FilePath]
getPath :: IO [FilePath]
getPath =
#ifdef IS_POSIX
    (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (\ FilePath
dir -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? FilePath
"." (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> [FilePath]
forall s e. Split s e => (e -> Bool) -> s -> [s]
splitsBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':') (FilePath -> [FilePath]) -> IO FilePath -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
getEnv FilePath
"PATH"
#else
    select (null ?- literal) . splitsBy (== ';') <$> getEnv "PATH"
  where
    literal ('"' : (path :< '"')) = path
    literal         path          = path
#endif

--------------------------------------------------------------------------------

{- Path/extension split and join. -}

{-# COMPLETE (:.) #-}

{- |
  Add an extension.
  
  > "/directory/path" :. "ext" == "/directory/path.ext"
  > "file.txt" :. "tar" == "file.txt.tar"
  > "file." :. ".tar" == "file..tar"
  > "file" :. ".xml" == "file.xml"
  > "/" :. "d" == "/.d"
  
  Windows:
  > "\\\\share" :. ".txt" == "\\\\share\\.txt"
  
  Split on the extension. Note that points are discarded.
  
  > ("file" :. "") <- "file"
  > ("out" :. "txt") <- "out.txt"
  > ("/etc/pam.d/" :. "") <- "/etc/pam.d/"
  > ("dir.d/fnya" :. "") <- "dir.d/fnya"
  > ("dir.d/data" :. "bak") <- "dir.d/data.bak"
  > ("/directory/path" :. "ext") <- "/directory/path.ext"
  > ("file/path.txt.alice" :. "bob") <- "file/path.txt.alice.bob"
  
  Note that filenames starting with a @.@ are handled correctly:
  
  > (".bashrc" :. "") <- ".bashrc"
-}
pattern (:.) :: FilePath -> String -> FilePath
pattern path $b:. :: FilePath -> FilePath -> FilePath
$m:. :: forall r.
FilePath -> (FilePath -> FilePath -> r) -> (Void# -> r) -> r
:. ext <- (splitExt -> (path, ext)) where (:.) = FilePath -> FilePath -> FilePath
addExt

splitExt :: FilePath -> (String, String)
splitExt :: FilePath -> (FilePath, FilePath)
splitExt FilePath
path = FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
name Bool
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> (FilePath, FilePath)
forall a. Bool -> a -> a -> a
? (FilePath
path, FilePath
"") ((FilePath, FilePath) -> (FilePath, FilePath))
-> (FilePath, FilePath) -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ (FilePath
dir FilePath -> FilePath -> FilePath
forall l e. Linear l e => l -> l -> l
++ FilePath
name, FilePath
ext)
  where
    (FilePath
name, FilePath
ext) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall s e. Split s e => (e -> Bool) -> s -> (s, s)
divideBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
file
    (FilePath
dir, FilePath
file) = FilePath -> (FilePath, FilePath)
dirName FilePath
path

addExt :: FilePath -> String -> FilePath
addExt :: FilePath -> FilePath -> FilePath
addExt FilePath
file FilePath
"" = FilePath
file
addExt (FilePath
drive :\\ FilePath
path) ext :: FilePath
ext@(Char
'.' : FilePath
_) = FilePath
drive FilePath -> FilePath -> FilePath
:\\ (FilePath
path FilePath -> FilePath -> FilePath
forall l e. Linear l e => l -> l -> l
++ FilePath
ext)
addExt (FilePath
drive :\\ FilePath
path) FilePath
ext = FilePath
drive FilePath -> FilePath -> FilePath
:\\ (FilePath
path FilePath -> FilePath -> FilePath
forall l e. Linear l e => l -> l -> l
++ Char
'.' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
ext)

{-# COMPLETE (:..) #-}

{- |
  Add an extensions.
  
  > x :.. [] = x -- forall x
  > path :.. [ext] = path :. ext -- forall path ext
  
  > "dir/file" :.. ["fb2", "zip"] == "dir/file.fb2.zip"
  > "dir/file" :.. ["fb2", ".zip"] == "dir/file.fb2.zip"
  > "pacman" :.. ["pkg", "tar", "xz"] == "pacman.pkg.tar.xz"
  
  Split on the extensions. Note that points are discarded.
  
  > ("file" :.. []) <- "file"
  > ("out" :.. ["txt"]) <- "out.txt"
  > ("/etc/pam.d/" :.. []) <- "/etc/pam.d/"
  > ("dir.d/fnya" :.. []) <- "dir.d/fnya"
  > ("dir.d/data" :.. ["bak"]) <- "dir.d/data.bak"
  > ("/directory/path" :.. ["ext"]) <- "/directory/path.ext"
  > ("file/path." :.. ["txt", "alice", "bob"]) <- "file/path.txt.alice.bob"
  
  This function separates the extensions and also considers the case when the
  file name begins with a period.
  
  > splitExtensions "file/.path.txt.alice.bob" == ("file/", ".path.txt.alice.bob")
  > ("file/.path" :.. [txt, alice, bob]) <- "file/.path.txt.alice.bob"
  > splitExtensions ".bashrc" == ("", ".bashrc")
  > (".bashrc" :.. []) <- ".bashrc"
-}
pattern (:..) :: FilePath -> [String] -> FilePath
pattern path $b:.. :: FilePath -> [FilePath] -> FilePath
$m:.. :: forall r.
FilePath -> (FilePath -> [FilePath] -> r) -> (Void# -> r) -> r
:.. exts <- (splitExts -> (path, exts)) where (:..) = (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl FilePath -> FilePath -> FilePath
(:.)

splitExts :: FilePath -> (FilePath, [String])
splitExts :: FilePath -> (FilePath, [FilePath])
splitExts FilePath
path = case (Char -> Bool) -> FilePath -> [FilePath]
forall s e. Split s e => (e -> Bool) -> s -> [s]
splitsBy (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
file' of
    (FilePath
name : [FilePath]
exts) -> (FilePath
dir FilePath -> FilePath -> FilePath
forall l e. Linear l e => l -> l -> l
++ FilePath
pt FilePath -> FilePath -> FilePath
forall l e. Linear l e => l -> l -> l
++ FilePath
name, [FilePath]
exts)
    [FilePath]
_             -> (FilePath
path, [])
  where
    (FilePath
pt, FilePath
file') = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall s e. Split s e => (e -> Bool) -> s -> (s, s)
spanl (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
file
    (FilePath
dir, FilePath
file) = FilePath -> (FilePath, FilePath)
dirName FilePath
path

--------------------------------------------------------------------------------

{- Directory/file split and join. -}

{-# COMPLETE (:/) #-}

{- |
  Split a filename into directory and file. The first component will often end
  with a trailing slash.
  
  > "/directory/" :/ "file.ext" <- "/directory/file.ext"
  > "file/" :/ "bob.txt" <- "file/bob.txt"
  > "./" :/ "bob" <- "bob"
  
  Posix:
  > "/" :/ "" <- "/"
  
  Windows:
  > "c:" :/ "" <- "c:"
  
  Combine two paths with a path separator.
  
  If the second path looks like an absolute path or a drive, then it returns the
  second.
  
  > "directory" :/ "/file.ext" == "/file.ext"
  
  Posix:
  > "/directory" :/ "file.ext" == "/directory/file.ext"
  > "/" :/ "tmp" == "/tmp"
  > "x:" :/ "foo" == "x:/foo"
  > "home" :/ "/user" == "/user"
  > "home" :/ "user" == "home/user"
  
  Windows:
  > "/directory" :/ "file.ext" == "/directory\\file.ext"
  > "C:\\foo" :/ "bar" == "C:\\foo\\bar"
  > "home" :/ "C:\\bob" == "C:\\bob"
  > "home" :/ "bob" == "home\\bob"
  
  > "C:\\home" :/ "\\bob" == "\\bob"
  > "home" :/ "\\bob" == "\\bob"
  > "home" :/ "/bob" == "/bob"
  
  > "D:\\foo" :/ "C:bar" == "C:bar"
  > "C:\\foo" :/ "C:bar" == "C:bar"
-}
pattern (:/) :: FilePath -> FilePath -> FilePath
pattern dir $b:/ :: FilePath -> FilePath -> FilePath
$m:/ :: forall r.
FilePath -> (FilePath -> FilePath -> r) -> (Void# -> r) -> r
:/ file <- (splitName -> (dir, file))
  where
    FilePath
a :/ b :: FilePath
b@(FilePath
drive :\\ FilePath
_) = (Char -> Bool) -> FilePath -> Bool
headIs Char -> Bool
isPathSep FilePath
b Bool -> Bool -> Bool
|| FilePath
drive FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"" Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? FilePath
b (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
a FilePath -> FilePath -> FilePath
:\\ FilePath
b

splitName :: FilePath -> (FilePath, FilePath)
splitName :: FilePath -> (FilePath, FilePath)
splitName =  (FilePath -> FilePath)
-> (FilePath, FilePath) -> (FilePath, FilePath)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (\ FilePath
dir -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dir Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? FilePath
"./" (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
dir) ((FilePath, FilePath) -> (FilePath, FilePath))
-> (FilePath -> (FilePath, FilePath))
-> FilePath
-> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> (FilePath, FilePath)
dirName

dirName :: FilePath -> (FilePath, FilePath)
dirName :: FilePath -> (FilePath, FilePath)
dirName (FilePath
drive :\\ FilePath
path) = (FilePath
drive FilePath -> FilePath -> FilePath
forall l e. Linear l e => l -> l -> l
++) (FilePath -> FilePath)
-> (FilePath, FilePath) -> (FilePath, FilePath)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
`first` (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall s e. Split s e => (e -> Bool) -> s -> (s, s)
breakr Char -> Bool
isPathSep FilePath
path

--------------------------------------------------------------------------------

{-# COMPLETE Path #-}

{- |
  Separates filepath into a search path - list of ancestors with trailing
  separators and file name (if any):
  
  Posix:
  > Path ["/", "home/", "user/", ".ghci"] <- "/home/user/.ghci"
  > Path ["/", "home/", "user/"] <- "/home/user/"
  > Path ["/", "home/", "user"] <- "/home/user"
  
  Windows:
  > Path ["C:\\", "home\\", "user\\"] <- "C:\\home\\user\\"
  > Path ["C:\\", "home\\", "user"] <- "C:\\home\\user"
  
  'Path' concatenates the file path regardless of a trailing separator.
-}
pattern Path :: [FilePath] -> FilePath
pattern $bPath :: [FilePath] -> FilePath
$mPath :: forall r. FilePath -> ([FilePath] -> r) -> (Void# -> r) -> r
Path path <- (splitPath -> path) where Path = (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> FilePath -> FilePath
(:/) []

splitPath :: FilePath -> [FilePath]
splitPath :: FilePath -> [FilePath]
splitPath (FilePath
drive :\\ FilePath
path) = FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
drive Bool -> [FilePath] -> [FilePath] -> [FilePath]
forall a. Bool -> a -> a -> a
? FilePath -> [FilePath]
f FilePath
path ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
drive FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: FilePath -> [FilePath]
f FilePath
path
  where
    f :: FilePath -> [FilePath]
f FilePath
"" = []
    f FilePath
y  = (FilePath
a FilePath -> FilePath -> FilePath
forall l e. Linear l e => l -> l -> l
++ 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 s e. Split s e => (e -> Bool) -> s -> (s, s)
breakl Char -> Bool
isPathSep FilePath
y
        (FilePath
c, FilePath
d) = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall s e. Split s e => (e -> Bool) -> s -> (s, s)
spanl  Char -> Bool
isPathSep FilePath
b

{-# COMPLETE Dirs #-}

{- |
  Separates filepath into a search path - list of ancestors without trailing
  separators and file name (if any):
  
  Posix:
  > Dirs ["/", "home", "user", ".ghci"] <- "/home/user/.ghci"
  > Dirs ["/", "home", "user"] <- "/home/user/"
  > Dirs ["/", "home", "user"] <- "/home/user"
  
  Windows:
  > Dirs ["C:\\", "home", "user"] <- "C:\\home\\user\\"
  > Dirs ["C:\\","home","user"] <- "C:\\home\\user"
  
  'Dirs' concatenates the file path regardless of a trailing separator.
-}
pattern Dirs :: [FilePath] -> FilePath
pattern $bDirs :: [FilePath] -> FilePath
$mDirs :: forall r. FilePath -> ([FilePath] -> r) -> (Void# -> r) -> r
Dirs dirs <- (splitDirs -> dirs) where Dirs = (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> FilePath -> FilePath
(:/) []

splitDirs :: FilePath -> [FilePath]
splitDirs :: FilePath -> [FilePath]
splitDirs =  (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
stripSlash ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitPath
  where
    stripSlash :: FilePath -> FilePath
stripSlash (FilePath
drive :\\ FilePath
"") = FilePath
drive
    stripSlash FilePath
path = Bool -> Bool
not ((Char -> Bool) -> FilePath -> Bool
lastIs Char -> Bool
isPathSep FilePath
path) Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? FilePath
path (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$
      case (Char -> Bool) -> FilePath -> FilePath
forall s e. Split s e => (e -> Bool) -> s -> s
dropEnd Char -> Bool
isPathSep FilePath
path of {FilePath
"" -> [FilePath -> Char
forall l e. Linear l e => l -> e
last FilePath
path]; FilePath
dir -> FilePath
dir}

{-# COMPLETE (://) #-}

-- | Splits/joins directories and a file name.
pattern (://) :: [FilePath] -> FilePath -> FilePath
pattern dirs $b:// :: [FilePath] -> FilePath -> FilePath
$m:// :: forall r.
FilePath -> ([FilePath] -> FilePath -> r) -> (Void# -> r) -> r
:// file <- (splitDirs -> dirs :< file) where (://) = (FilePath -> [FilePath] -> FilePath)
-> [FilePath] -> FilePath -> FilePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip ((FilePath -> [FilePath] -> FilePath)
 -> [FilePath] -> FilePath -> FilePath)
-> (FilePath -> [FilePath] -> FilePath)
-> [FilePath]
-> FilePath
-> FilePath
forall a b. (a -> b) -> a -> b
$ (FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> FilePath
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr FilePath -> FilePath -> FilePath
(:/)

--------------------------------------------------------------------------------

{- Drive split and join. -}

{-# COMPLETE (:\\) #-}

{- |
  Windows:
  > "" :\\ "file" <- "file"
  > "c:/" :\\ "file" <- "c:/file"
  > "c:\\" :\\ "file" <- "c:\\file"
  > "\\\\shared\\" :\\ "test" <- "\\\\shared\\test"
  > "\\\\shared" :\\ "" <- "\\\\shared"
  > "\\\\?\\UNC\\shared\\" :\\ "file" <- "\\\\?\\UNC\\shared\\file"
  > "\\\\?\\" :\\ "UNCshared\\file" <- "\\\\?\\UNCshared\\file"
  > "\\\\?\\d:\\" :\\ "file" <- "\\\\?\\d:\\file"
  > "" :\\ "/d" <- "/d"
  
  Posix:
  > "/" :\\ "test" <- "/test"
  > "//" :\\ "test" <- "//test"
  > "" :\\ "test/file" <- "test/file"
  > "" :\\ "file" <- "file"
-}
pattern (:\\) :: FilePath -> FilePath -> FilePath
pattern drive $b:\\ :: FilePath -> FilePath -> FilePath
$m:\\ :: forall r.
FilePath -> (FilePath -> FilePath -> r) -> (Void# -> r) -> r
:\\ path <- (splitDrive -> (drive, path))
  where
    FilePath
a :\\ FilePath
b
      | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
a = FilePath
b
      | FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
b = FilePath
a
      | Char -> Bool
isPathSep (FilePath -> Char
forall l e. Linear l e => l -> e
last FilePath
a) = FilePath
a FilePath -> FilePath -> FilePath
forall l e. Linear l e => l -> l -> l
++ FilePath
b
#ifndef IS_POSIX
      | c : ":" <- a, isLetter' c = a ++ b
#endif
      | Bool
True = FilePath
a FilePath -> FilePath -> FilePath
forall l e. Linear l e => l -> l -> l
++ Char
PathSep Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
b

splitDrive :: FilePath -> (FilePath, FilePath)
#ifdef IS_POSIX
splitDrive :: FilePath -> (FilePath, FilePath)
splitDrive = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall s e. Split s e => (e -> Bool) -> s -> (s, s)
spanl (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/')
#else
splitDrive path =
  let drive = lift (letter <++ unc <++ share)
  in  ("", path) `fromMaybe` readMaybeBy drive path
#endif

--------------------------------------------------------------------------------

{- Validity. -}

{- |
  Is a 'FilePath' valid? This function checks for invalid names, invalid
  characters, but doesn't check if length limits are exceeded, as these are
  typically filesystem dependent.
  
  > isValid "" == False
  > isValid "\0" == False
  
  Posix:
  > isValid "/random_ path:*" == True
  > isValid x => not (null x)
  
  Windows:
  > isValid "c:\\test" == True
  > isValid "c:\\test:of_test" == False
  > isValid "test*" == False
  > isValid "c:\\test\\nul" == False
  > isValid "c:\\test\\prn.txt" == False
  > isValid "c:\\nul\\file" == False
  > isValid "\\\\" == False
  > isValid "\\\\\\foo" == False
  > isValid "\\\\?\\D:file" == False
  > isValid "foo\tbar" == False
  > isValid "nul .txt" == False
  > isValid " nul.txt" == True
-}
isValid :: FilePath -> Bool
isValid :: FilePath -> Bool
isValid  FilePath
""  = Bool
False
#ifdef IS_POSIX
isValid FilePath
path = Bool -> Bool
not (Char
'\0' Char -> FilePath -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` FilePath
path)
#else
isValid (drive :\\ path@(Dirs dirs)) = not $ or
  [
    any isBadChar path,
    any (\ (name :.. _) -> isBadElem name) dirs,
    
    drive .>= 2 && all isPathSep drive,
    isDriveUNC drive && not (lastIs isPathSep drive)
  ]
#endif

{- |
  Take a FilePath and make it vali, doesn't change already valid FilePaths:
  
  > isValid (makeValid x) == True
  > isValid x => makeValid x == x
  > makeValid "" == "_"
  > makeValid "file\0name" == "file_name"
  
  Windows:
  > makeValid "c:\\already\\/valid" == "c:\\already\\/valid"
  > makeValid "c:\\test:of_test" == "c:\\test_of_test"
  > makeValid "test*" == "test_"
  > makeValid "c:\\test\\nul" == "c:\\test\\nul_"
  > makeValid "c:\\test\\prn.txt" == "c:\\test\\prn_.txt"
  > makeValid "c:\\test/prn.txt" == "c:\\test/prn_.txt"
  > makeValid "c:\\nul\\file" == "c:\\nul_\\file"
  > makeValid "\\\\\\foo" == "\\\\drive"
  > makeValid "\\\\?\\D:file" == "\\\\?\\D:\\file"
  > makeValid "nul .txt" == "nul _.txt"
-}
makeValid :: FilePath -> FilePath
makeValid :: FilePath -> FilePath
makeValid FilePath
"" = FilePath
"_"
#ifdef IS_POSIX
makeValid FilePath
path = (Char -> Bool) -> Char -> FilePath -> FilePath
forall a. (a -> Bool) -> a -> [a] -> [a]
repl (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\0') Char
'_' FilePath
path
#else
makeValid (drive :\\ path@(Path paths))
    | drive .>= 2 && all isPathSep drive = take 2 drive ++ "drive"
    | isDriveUNC drive && lastIs isPathSep drive =
      makeValid (drive ++ "\\" ++ path)
    | True = drive :\\ Path (f <$> paths)
  where
    f = uncurry ((++) . g) . break isPathSep . repl isBadChar '_'
    g = \ x@(a :.. b) -> isBadElem a ? a ++ "_" :.. b $ x
#endif

--------------------------------------------------------------------------------

{- Absolute and relative paths. -}

{- |
  Is a path relative, or is it fixed to the root?
  
  Posix:
  > isRelative "test/path" == True
  > isRelative "/test" == False
  > isRelative "/" == False
  
  Windows:
  
  > isRelative "path\\test" == True
  > isRelative "c:\\test" == False
  > isRelative "c:test" == True
  > isRelative "c:\\" == False
  > isRelative "c:/" == False
  > isRelative "c:" == True
  > isRelative "\\\\foo" == False
  > isRelative "\\\\?\\foo" == False
  > isRelative "\\\\?\\UNC\\foo" == False
  > isRelative "/foo" == True
  > isRelative "\\foo" == True
  
  * "A UNC name of any format [is never relative]."
  * "You can't use the "\\?\" prefix with a relative path."
-}
isRelative :: FilePath -> Bool
#ifdef IS_POSIX
isRelative :: FilePath -> Bool
isRelative (FilePath
dr :\\ FilePath
_) = FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dr
#else
isRelative (dr :\\ _) = case dr of
  (c : ':' : x : _) -> isLetter' c && not (isPathSep x)
  [c, ':']          -> isLetter' c
  xs                -> null xs
#endif

-- | Same as @not . 'isRelative'@.
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

--------------------------------------------------------------------------------

{- |
  Normalise a file name:
  * \/\/ outside of the drive can be made blank
  * \/ -> 'PathSep'
  * .\/ -> \"\"
  
  > normalise "." == "."
  
  Posix:
  > normalise "/file/\\test////" == "/file/\\test/"
  > normalise "/file/./test" == "/file/test"
  > normalise "/test/file/../bob/fred/" == "/test/file/../bob/fred/"
  > normalise "../bob/fred/" == "../bob/fred/"
  > normalise "./bob/fred/" == "bob/fred/"
  
  > normalise "./" == "./"
  > normalise "./." == "./"
  > normalise "/./" == "/"
  > normalise "/" == "/"
  > normalise "bob/fred/." == "bob/fred/"
  > normalise "//home" == "/home"
  
  Windows:
  > normalise "c:\\file/bob\\" == "C:\\file\\bob\\"
  > normalise "c:\\" == "C:\\"
  > normalise "C:.\\" == "C:"
  > normalise "\\\\server\\test" == "\\\\server\\test"
  > normalise "//server/test" == "\\\\server\\test"
  > normalise "c:/file" == "C:\\file"
  > normalise "/file" == "\\file"
  > normalise "\\" == "\\"
  > normalise "/./" == "\\"
-}
normalise :: FilePath -> FilePath
normalise :: FilePath -> FilePath
normalise (FilePath
drive :\\ path :: FilePath
path@(Dirs [FilePath]
dirs)) = Bool
addPathSep Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? FilePath
res FilePath -> Char -> FilePath
forall l e. Linear l e => l -> e -> l
:< Char
PathSep (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
res
  where
    res :: FilePath
res = FilePath -> FilePath
join' (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath
normDrive FilePath
drive FilePath -> FilePath -> FilePath
:\\ [FilePath] -> FilePath
Dirs ([FilePath] -> [FilePath]
f [FilePath]
dirs)
    
    join' :: FilePath -> FilePath
join' FilePath
x = FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
x Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? FilePath
"." (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
x
    
    addPathSep :: Bool
addPathSep = FilePath -> Bool
isDirPath FilePath
path
                 Bool -> Bool -> Bool
&& Bool -> Bool
not ((Char -> Bool) -> FilePath -> Bool
lastIs Char -> Bool
isPathSep FilePath
res)
#ifndef IS_POSIX
                 && not (isRelativeDrive drive)
#endif
    
    isDirPath :: FilePath -> Bool
isDirPath FilePath
xs = (Char -> Bool) -> FilePath -> Bool
lastIs Char -> Bool
isPathSep FilePath
xs Bool -> Bool -> Bool
||
                   (Char -> Bool) -> FilePath -> Bool
lastIs (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.') FilePath
xs Bool -> Bool -> Bool
&& (Char -> Bool) -> FilePath -> Bool
lastIs Char -> Bool
isPathSep (FilePath -> FilePath
forall l e. Linear l e => l -> l
init FilePath
xs)
    
    f :: [FilePath] -> [FilePath]
f (FilePath
x : [FilePath]
xs) = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall l e. Linear l e => (e -> Bool) -> l -> l
except (FilePath
"." FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
==) ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPathSep FilePath
x Bool -> [FilePath] -> [FilePath] -> [FilePath]
forall a. Bool -> a -> a -> a
? [Char
PathSep] FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
xs
    f    []    = []

normDrive :: FilePath -> FilePath
#ifdef IS_POSIX
normDrive :: FilePath -> FilePath
normDrive FilePath
dr = FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
dr Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? FilePath
"" (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ [Char
PathSep]
#else
normDrive "" = ""
normDrive dr = isDriveLetter dosDrive ? map toUpper dosDrive $ dosDrive
  where
    dosDrive = repl (== '/') '\\' dr
#endif

{- |
  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 DOSNAMEs.
  
  > x == y ==> equalFilePath x y
  > normalise x == normalise y ==> equalFilePath x y
  
  > equalFilePath "foo" "foo/"
  > not (equalFilePath "foo" "/foo")
  
  Posix:
  > not (equalFilePath "foo" "FOO")
  
  Windows:
  > equalFilePath "foo" "FOO"
  > not (equalFilePath "C:" "C:/")
-}
equalFilePath :: FilePath -> FilePath -> Bool
equalFilePath :: FilePath -> FilePath -> Bool
equalFilePath =  (FilePath -> FilePath -> Bool)
-> (FilePath -> FilePath) -> FilePath -> FilePath -> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
on FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) ((FilePath -> FilePath) -> FilePath -> FilePath -> Bool)
-> (FilePath -> FilePath) -> FilePath -> FilePath -> Bool
forall a b. (a -> b) -> a -> b
$
  FilePath -> FilePath
dropSep (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
#ifndef IS_POSIX
  map toLower .
#endif
  FilePath -> FilePath
normalise

dropSep :: FilePath -> FilePath
dropSep :: FilePath -> FilePath
dropSep FilePath
xs = (Char -> Bool) -> FilePath -> Bool
lastIs Char -> Bool
isPathSep FilePath
xs Bool -> Bool -> Bool
&& FilePath -> Bool
notDrive FilePath
xs Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
xs' Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? [Char
x] (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
xs') (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
xs
  where
    notDrive :: FilePath -> Bool
notDrive path :: FilePath
path@(FilePath
_ :\\ FilePath
rel) = FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
path Bool -> Bool -> Bool
|| Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
rel)
    
    xs' :: FilePath
xs' = (Char -> Bool) -> FilePath -> FilePath
forall s e. Split s e => (e -> Bool) -> s -> s
dropEnd Char -> Bool
isPathSep FilePath
xs
    x :: Char
x   = FilePath -> Char
forall l e. Linear l e => l -> e
last FilePath
xs

--------------------------------------------------------------------------------

{- |
  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
  
  Posix:
  > makeRelative "/Home" "/home/bob" == "/home/bob"
  > makeRelative "/home/" "/home/bob/foo/bar" == "bob/foo/bar"
  > makeRelative "/fred" "bob" == "bob"
  > makeRelative "/file/test" "/file/test/fred" == "fred"
  > makeRelative "/file/test" "/file/test/fred/" == "fred/"
  > makeRelative "some/path" "some/path/a/b/c" == "a/b/c"
  
  Windows:
  > makeRelative "C:\\Home" "c:\\home\\bob" == "bob"
  > makeRelative "C:\\Home" "c:/home/bob" == "bob"
  > makeRelative "C:\\Home" "D:\\Home\\Bob" == "D:\\Home\\Bob"
  > makeRelative "C:\\Home" "C:Home\\Bob" == "C:Home\\Bob"
  > makeRelative "/Home" "/home/bob" == "bob"
  > makeRelative "/" "//" == "//"
-}
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
True             = FilePath -> FilePath
dropAbs FilePath
root FilePath -> FilePath -> FilePath
`f` FilePath -> FilePath
dropAbs FilePath
path
  where
    f :: FilePath -> FilePath -> FilePath
f FilePath
"" FilePath
y = (Char -> Bool) -> FilePath -> FilePath
forall s e. Split s e => (e -> Bool) -> s -> s
dropWhile Char -> Bool
isPathSep FilePath
y
    f FilePath
x  FilePath
y = FilePath -> FilePath -> Bool
equalFilePath FilePath
x1 FilePath
y1 Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? FilePath -> FilePath -> FilePath
f FilePath
x2 FilePath
y2 (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
path
      where
        (FilePath
x1, FilePath
x2) = FilePath -> (FilePath, FilePath)
g FilePath
x
        (FilePath
y1, FilePath
y2) = FilePath -> (FilePath, FilePath)
g FilePath
y
    
    g :: FilePath -> (FilePath, FilePath)
g = ((FilePath -> FilePath)
 -> (FilePath -> FilePath)
 -> (FilePath, FilePath)
 -> (FilePath, FilePath))
-> (FilePath -> FilePath)
-> (FilePath, FilePath)
-> (FilePath, FilePath)
forall a b. (a -> a -> b) -> a -> b
double (FilePath -> FilePath)
-> (FilePath -> FilePath)
-> (FilePath, FilePath)
-> (FilePath, FilePath)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap ((Char -> Bool) -> FilePath -> FilePath
forall s e. Split s e => (e -> Bool) -> s -> s
dropWhile Char -> Bool
isPathSep) ((FilePath, FilePath) -> (FilePath, FilePath))
-> (FilePath -> (FilePath, FilePath))
-> FilePath
-> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
isPathSep (FilePath -> (FilePath, FilePath))
-> (FilePath -> FilePath) -> FilePath -> (FilePath, FilePath)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> FilePath -> FilePath
forall s e. Split s e => (e -> Bool) -> s -> s
dropWhile Char -> Bool
isPathSep
    
    dropAbs :: FilePath -> FilePath
dropAbs pth :: FilePath
pth@(FilePath
drv :\\ FilePath
rel) = (Char -> Bool) -> FilePath -> Bool
headIs Char -> Bool
isPathSep FilePath
pth Bool -> Bool -> Bool
&& FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
drv Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? FilePath -> FilePath
forall l e. Linear l e => l -> l
tail FilePath
pth (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
rel
    takeAbs :: FilePath -> FilePath
takeAbs pth :: FilePath
pth@(FilePath
drv :\\   FilePath
_) = (Char -> Bool) -> FilePath -> Bool
headIs Char -> Bool
isPathSep FilePath
pth Bool -> Bool -> Bool
&& FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
drv Bool -> FilePath -> FilePath -> FilePath
forall a. Bool -> a -> a -> a
? [Char
PathSep] (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ (Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map (\ Char
y -> Char -> Bool
isPathSep Char
y Bool -> Char -> Char -> Char
forall a. Bool -> a -> a -> a
? Char
PathSep (Char -> Char) -> Char -> Char
forall a b. (a -> b) -> a -> b
$ Char -> Char
toLower Char
y) FilePath
drv

--------------------------------------------------------------------------------

{- Windefs. -}

#ifndef IS_POSIX
isDriveLetter :: String -> Bool
isDriveLetter x2 =  isJust (readMaybeBy (lift letter) x2)

isDriveUNC :: String -> Bool
isDriveUNC =  isJust . readMaybeBy (lift unc)

isRelativeDrive :: String -> Bool
isRelativeDrive =
  maybe False (not . lastIs isPathSep . fst) . readMaybeBy (lift letter)

isBadElem :: FilePath -> Bool
isBadElem =  (`elem` badElems) . fmap toUpper . dropEnd (== ' ')

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

isBadChar :: Char -> Bool
isBadChar x = x >= '\0' && x <= '\31' || x `elem` ":*?><|\""

unc :: ReadP (String, String)
unc =  do sep; sep; void (char '?'); sep; long <++ short
  where
    long  = do ci "UNC"; sep; first ("\\\\?\\UNC\\" ++) <$> shareName
    ci    = mapM_ $ \ c -> char (toLower c) <++ char (toUpper c)
    short = first ("\\\\?\\" ++) <$> letter

share :: ReadP (String, String)
share =  do sep; sep; first ("\\\\" ++) <$> shareName

shareName :: ReadP (String, String)
shareName =  (do x <- manyTill get sep; y <- end; return (x :< '\\', y)) <++
             (do x <- end; return (x, ""))

letter :: ReadP (String, String)
letter =  do c <- satisfy isLetter'; void (char ':'); slash [c, ':'] <$> end

slash :: String -> String -> (String, String)
slash a =  first (a ++) . span isPathSep

end :: ReadP String
end =  manyTill get eof

sep :: ReadP ()
sep =  void (satisfy isPathSep)

isLetter' :: Char -> Bool
isLetter' x = isAsciiLower x || isAsciiUpper x
#endif

--------------------------------------------------------------------------------

headIs :: (Char -> Bool) -> String -> Bool
headIs :: (Char -> Bool) -> FilePath -> Bool
headIs Char -> Bool
f FilePath
es = Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
es) Bool -> Bool -> Bool
&& Char -> Bool
f (FilePath -> Char
forall l e. Linear l e => l -> e
head FilePath
es)

lastIs :: (Char -> Bool) -> String -> Bool
lastIs :: (Char -> Bool) -> FilePath -> Bool
lastIs Char -> Bool
f FilePath
es = Bool -> Bool
not (FilePath -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
es) Bool -> Bool -> Bool
&& Char -> Bool
f (FilePath -> Char
forall l e. Linear l e => l -> e
last FilePath
es)

repl :: (a -> Bool) -> a -> ([a] -> [a])
repl :: (a -> Bool) -> a -> [a] -> [a]
repl =  \ a -> Bool
f a
n -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> a) -> [a] -> [a]) -> (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> a -> b
$ \ a
c -> a -> Bool
f a
c Bool -> a -> a -> a
forall a. Bool -> a -> a -> a
? a
n (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a
c

double :: (a -> a -> b) -> a -> b
double :: (a -> a -> b) -> a -> b
double =  \ a -> a -> b
f a
x -> a -> a -> b
f a
x a
x