-- |
-- Module      :  System.Posix.FilePath
-- Copyright   :  © 2016 Julian Ospald
-- License     :  BSD3
--
-- Maintainer  :  Julian Ospald <hasufell@posteo.de>
-- Stability   :  experimental
-- Portability :  portable
--
-- The equivalent of "System.FilePath" on raw (byte string) file paths.
--
-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!


{-# LANGUAGE CPP #-}
{-# LANGUAGE TupleSections #-}

{-# OPTIONS_GHC -Wall #-}


module System.Posix.FilePath (

  -- * Separator predicates
  pathSeparator
, isPathSeparator
, searchPathSeparator
, isSearchPathSeparator
, extSeparator
, isExtSeparator

  -- * $PATH methods
, splitSearchPath
, getSearchPath

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

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

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

  -- * File name manipulations
, normalise
, makeRelative
, equalFilePath
, isRelative
, isAbsolute
, isValid
, makeValid
, isFileName
, hasParentDir
, hiddenFile

, module System.Posix.ByteString.FilePath
) where

import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.String (fromString)
import           System.Posix.ByteString.FilePath
import qualified System.Posix.Env.ByteString as PE

import           Data.Maybe (isJust)
import           Data.Word8
#if !MIN_VERSION_bytestring(0,10,8)
import qualified Data.List as L
#endif
import           Control.Arrow (second)

-- $setup
-- >>> import Data.Char
-- >>> import Data.Maybe
-- >>> import Data.Word8
-- >>> import Test.QuickCheck
-- >>> import Control.Applicative
-- >>> import qualified Data.ByteString as BS
-- >>> instance Arbitrary ByteString where arbitrary = BS.pack <$> arbitrary
-- >>> instance CoArbitrary ByteString where coarbitrary = coarbitrary . BS.unpack
--
-- >>> let _chr :: Word8 -> Char; _chr = chr . fromIntegral



------------------------
-- Separator predicates


-- | Path separator character
pathSeparator :: Word8
pathSeparator :: Word8
pathSeparator = Word8
_slash


-- | Check if a character is the path separator
--
-- prop> \n ->  (_chr n == '/') == isPathSeparator n
isPathSeparator :: Word8 -> Bool
isPathSeparator :: Word8 -> Bool
isPathSeparator = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
pathSeparator)


-- | Search path separator
searchPathSeparator :: Word8
searchPathSeparator :: Word8
searchPathSeparator = Word8
_colon


-- | Check if a character is the search path separator
--
-- prop> \n -> (_chr n == ':') == isSearchPathSeparator n
isSearchPathSeparator :: Word8 -> Bool
isSearchPathSeparator :: Word8 -> Bool
isSearchPathSeparator = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
searchPathSeparator)


-- | File extension separator
extSeparator :: Word8
extSeparator :: Word8
extSeparator = Word8
_period


-- | Check if a character is the file extension separator
--
-- prop> \n -> (_chr n == '.') == isExtSeparator n
isExtSeparator :: Word8 -> Bool
isExtSeparator :: Word8 -> Bool
isExtSeparator = (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
extSeparator)



------------------------
-- $PATH methods


-- | Take a ByteString, split it on the 'searchPathSeparator'.
-- Blank items are converted to @.@.
--
-- Follows the recommendations in
-- <http://www.opengroup.org/onlinepubs/009695399/basedefs/xbd_chap08.html>
--
-- >>> splitSearchPath "File1:File2:File3"
-- ["File1","File2","File3"]
-- >>> splitSearchPath "File1::File2:File3"
-- ["File1",".","File2","File3"]
-- >>> splitSearchPath ""
-- ["."]
splitSearchPath :: ByteString -> [RawFilePath]
splitSearchPath :: ByteString -> [ByteString]
splitSearchPath = ByteString -> [ByteString]
f
  where
    f :: ByteString -> [ByteString]
f bs :: ByteString
bs = let (pre :: ByteString
pre, post :: ByteString
post) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break Word8 -> Bool
isSearchPathSeparator ByteString
bs
           in if ByteString -> Bool
BS.null ByteString
post
                 then ByteString -> [ByteString]
g ByteString
pre
                 else ByteString -> [ByteString]
g ByteString
pre [ByteString] -> [ByteString] -> [ByteString]
forall a. [a] -> [a] -> [a]
++ ByteString -> [ByteString]
f (ByteString -> ByteString
BS.tail ByteString
post)
    g :: ByteString -> [ByteString]
g x :: ByteString
x
      | ByteString -> Bool
BS.null ByteString
x = [Word8 -> ByteString
BS.singleton Word8
_period]
      | Bool
otherwise = [ByteString
x]


-- | Get a list of 'RawFilePath's in the $PATH variable.
getSearchPath :: IO [RawFilePath]
getSearchPath :: IO [ByteString]
getSearchPath = (Maybe ByteString -> [ByteString])
-> IO (Maybe ByteString) -> IO [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([ByteString]
-> (ByteString -> [ByteString]) -> Maybe ByteString -> [ByteString]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ByteString -> [ByteString]
splitSearchPath) (ByteString -> IO (Maybe ByteString)
PE.getEnv (ByteString -> IO (Maybe ByteString))
-> ByteString -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a. IsString a => String -> a
fromString "PATH")



------------------------
-- Extension functions

-- | Split a 'RawFilePath' into a path+filename and extension
--
-- >>> splitExtension "file.exe"
-- ("file",".exe")
-- >>> splitExtension "file"
-- ("file","")
-- >>> splitExtension "/path/file.tar.gz"
-- ("/path/file.tar",".gz")
--
-- prop> \path -> uncurry (BS.append) (splitExtension path) == path
splitExtension :: RawFilePath -> (RawFilePath, ByteString)
splitExtension :: ByteString -> (ByteString, ByteString)
splitExtension x :: ByteString
x = if ByteString -> Bool
BS.null ByteString
basename
    then (ByteString
x,ByteString
BS.empty)
    else (ByteString -> ByteString -> ByteString
BS.append ByteString
path (ByteString -> ByteString
BS.init ByteString
basename),Word8 -> ByteString -> ByteString
BS.cons Word8
extSeparator ByteString
fileExt)
  where
    (path :: ByteString
path,file :: ByteString
file) = ByteString -> (ByteString, ByteString)
splitFileNameRaw ByteString
x
    (basename :: ByteString
basename,fileExt :: ByteString
fileExt) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.breakEnd Word8 -> Bool
isExtSeparator ByteString
file


-- | Get the final extension from a 'RawFilePath'
--
-- >>> takeExtension "file.exe"
-- ".exe"
-- >>> takeExtension "file"
-- ""
-- >>> takeExtension "/path/file.tar.gz"
-- ".gz"
takeExtension :: RawFilePath -> ByteString
takeExtension :: ByteString -> ByteString
takeExtension = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
splitExtension


-- | Change a file's extension
--
-- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path
replaceExtension :: RawFilePath -> ByteString -> RawFilePath
replaceExtension :: ByteString -> ByteString -> ByteString
replaceExtension path :: ByteString
path ext :: ByteString
ext = ByteString -> ByteString
dropExtension ByteString
path ByteString -> ByteString -> ByteString
<.> ByteString
ext


-- | Drop the final extension from a 'RawFilePath'
--
-- >>> dropExtension "file.exe"
-- "file"
-- >>> dropExtension "file"
-- "file"
-- >>> dropExtension "/path/file.tar.gz"
-- "/path/file.tar"
dropExtension :: RawFilePath -> RawFilePath
dropExtension :: ByteString -> ByteString
dropExtension = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
splitExtension


-- | Add an extension to a 'RawFilePath'
--
-- >>> addExtension "file" ".exe"
-- "file.exe"
-- >>> addExtension "file.tar" ".gz"
-- "file.tar.gz"
-- >>> addExtension "/path/" ".ext"
-- "/path/.ext"
addExtension :: RawFilePath -> ByteString -> RawFilePath
addExtension :: ByteString -> ByteString -> ByteString
addExtension file :: ByteString
file ext :: ByteString
ext
    | ByteString -> Bool
BS.null ByteString
ext = ByteString
file
    | Word8 -> Bool
isExtSeparator (ByteString -> Word8
BS.head ByteString
ext) = ByteString -> ByteString -> ByteString
BS.append ByteString
file ByteString
ext
    | Bool
otherwise = ByteString -> [ByteString] -> ByteString
BS.intercalate (Word8 -> ByteString
BS.singleton Word8
extSeparator) [ByteString
file, ByteString
ext]


-- | Check if a 'RawFilePath' has an extension
--
-- >>> hasExtension "file"
-- False
-- >>> hasExtension "file.tar"
-- True
-- >>> hasExtension "/path.part1/"
-- False
hasExtension :: RawFilePath -> Bool
hasExtension :: ByteString -> Bool
hasExtension = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool)
-> (ByteString -> Maybe Int) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> Maybe Int
BS.elemIndex Word8
extSeparator (ByteString -> Maybe Int)
-> (ByteString -> ByteString) -> ByteString -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
takeFileName


-- | Operator version of 'addExtension'
(<.>) :: RawFilePath -> ByteString -> RawFilePath
<.> :: ByteString -> ByteString -> ByteString
(<.>) = ByteString -> ByteString -> ByteString
addExtension


-- | Split a 'RawFilePath' on the first extension.
--
-- >>> splitExtensions "/path/file.tar.gz"
-- ("/path/file",".tar.gz")
--
-- prop> \path -> uncurry addExtension (splitExtensions path) == path
splitExtensions :: RawFilePath -> (RawFilePath, ByteString)
splitExtensions :: ByteString -> (ByteString, ByteString)
splitExtensions x :: ByteString
x = if ByteString -> Bool
BS.null ByteString
basename
    then (ByteString
path,ByteString
fileExt)
    else (ByteString -> ByteString -> ByteString
BS.append ByteString
path ByteString
basename,ByteString
fileExt)
  where
    (path :: ByteString
path,file :: ByteString
file) = ByteString -> (ByteString, ByteString)
splitFileNameRaw ByteString
x
    (basename :: ByteString
basename,fileExt :: ByteString
fileExt) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break Word8 -> Bool
isExtSeparator ByteString
file


-- | Remove all extensions from a 'RawFilePath'
--
-- >>> dropExtensions "/path/file.tar.gz"
-- "/path/file"
dropExtensions :: RawFilePath -> RawFilePath
dropExtensions :: ByteString -> ByteString
dropExtensions = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
splitExtensions


-- | Take all extensions from a 'RawFilePath'
--
-- >>> takeExtensions "/path/file.tar.gz"
-- ".tar.gz"
takeExtensions :: RawFilePath -> ByteString
takeExtensions :: ByteString -> ByteString
takeExtensions = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
splitExtensions


-- | 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
-- >>> 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
--
-- prop> \path -> stripExtension "" path == Just path
-- prop> \path -> dropExtension path  == fromJust (stripExtension (takeExtension path) path)
-- prop> \path -> dropExtensions path == fromJust (stripExtension (takeExtensions path) path)
stripExtension :: ByteString -> RawFilePath -> Maybe RawFilePath
stripExtension :: ByteString -> ByteString -> Maybe ByteString
stripExtension bs :: ByteString
bs path :: ByteString
path
  | ByteString -> Bool
BS.null ByteString
bs = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
path
  | Bool
otherwise  = ByteString -> ByteString -> Maybe ByteString
stripSuffix' ByteString
dotExt ByteString
path
  where
    dotExt :: ByteString
dotExt = if Word8 -> Bool
isExtSeparator (Word8 -> Bool) -> Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Word8
BS.head ByteString
bs
                then ByteString
bs
                else Word8
extSeparator Word8 -> ByteString -> ByteString
`BS.cons` ByteString
bs
#if MIN_VERSION_bytestring(0,10,8)
    stripSuffix' :: ByteString -> ByteString -> Maybe ByteString
stripSuffix' = ByteString -> ByteString -> Maybe ByteString
BS.stripSuffix
#else
    stripSuffix' xs ys = fmap (BS.pack . reverse) $ L.stripPrefix (reverse $ BS.unpack xs) (reverse $ BS.unpack ys)
#endif


------------------------
-- Filename/directory functions


-- | Split a 'RawFilePath' into (path,file).  'combine' is the inverse
--
-- >>> splitFileName "path/file.txt"
-- ("path/","file.txt")
-- >>> splitFileName "path/"
-- ("path/","")
-- >>> splitFileName "file.txt"
-- ("./","file.txt")
--
-- prop> \path -> uncurry combine (splitFileName path) == path || fst (splitFileName path) == "./"
splitFileName :: RawFilePath -> (RawFilePath, RawFilePath)
splitFileName :: ByteString -> (ByteString, ByteString)
splitFileName x :: ByteString
x = if ByteString -> Bool
BS.null ByteString
path
    then (ByteString
dotSlash, ByteString
file)
    else (ByteString
path,ByteString
file)
  where
    (path :: ByteString
path,file :: ByteString
file) = ByteString -> (ByteString, ByteString)
splitFileNameRaw ByteString
x
    dotSlash :: ByteString
dotSlash = Word8
_period Word8 -> ByteString -> ByteString
`BS.cons` (Word8 -> ByteString
BS.singleton Word8
pathSeparator)


-- | Get the file name
--
-- >>> takeFileName "path/file.txt"
-- "file.txt"
-- >>> takeFileName "path/"
-- ""
takeFileName :: RawFilePath -> RawFilePath
takeFileName :: ByteString -> ByteString
takeFileName = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
splitFileName


-- | Change the file name
--
-- prop> \path -> replaceFileName path (takeFileName path) == path
replaceFileName :: RawFilePath -> ByteString -> RawFilePath
replaceFileName :: ByteString -> ByteString -> ByteString
replaceFileName x :: ByteString
x y :: ByteString
y = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst (ByteString -> (ByteString, ByteString)
splitFileNameRaw ByteString
x) ByteString -> ByteString -> ByteString
</> ByteString
y


-- | Drop the file name
--
-- >>> dropFileName "path/file.txt"
-- "path/"
-- >>> dropFileName "file.txt"
-- "./"
dropFileName :: RawFilePath -> RawFilePath
dropFileName :: ByteString -> ByteString
dropFileName = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString -> (ByteString, ByteString))
-> ByteString
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> (ByteString, ByteString)
splitFileName


-- | Get the file name, without a trailing extension
--
-- >>> takeBaseName "path/file.tar.gz"
-- "file.tar"
-- >>> takeBaseName ""
-- ""
takeBaseName :: RawFilePath -> ByteString
takeBaseName :: ByteString -> ByteString
takeBaseName = ByteString -> ByteString
dropExtension (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
takeFileName


-- | Change the base name
--
-- >>> replaceBaseName "path/file.tar.gz" "bob"
-- "path/bob.gz"
--
-- prop> \path -> replaceBaseName path (takeBaseName path) == path
replaceBaseName :: RawFilePath -> ByteString -> RawFilePath
replaceBaseName :: ByteString -> ByteString -> ByteString
replaceBaseName path :: ByteString
path name :: ByteString
name = ByteString -> ByteString -> ByteString
combineRaw ByteString
dir (ByteString
name ByteString -> ByteString -> ByteString
<.> ByteString
ext)
  where
    (dir :: ByteString
dir,file :: ByteString
file) = ByteString -> (ByteString, ByteString)
splitFileNameRaw ByteString
path
    ext :: ByteString
ext = ByteString -> ByteString
takeExtension ByteString
file


-- | Get the directory, moving up one level if it's already a directory
--
-- >>> takeDirectory "path/file.txt"
-- "path"
-- >>> takeDirectory "file"
-- "."
-- >>> takeDirectory "/path/to/"
-- "/path/to"
-- >>> takeDirectory "/path/to"
-- "/path"
takeDirectory :: RawFilePath -> RawFilePath
takeDirectory :: ByteString -> ByteString
takeDirectory x :: ByteString
x = case () of
    () | ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> ByteString
BS.singleton Word8
pathSeparator -> ByteString
x
       | ByteString -> Bool
BS.null ByteString
res Bool -> Bool -> Bool
&& Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
file) -> ByteString
file
       | Bool
otherwise -> ByteString
res
  where
    res :: ByteString
res = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.spanEnd Word8 -> Bool
isPathSeparator ByteString
file
    file :: ByteString
file = ByteString -> ByteString
dropFileName ByteString
x


-- | Change the directory component of a 'RawFilePath'
--
-- prop> \path -> replaceDirectory path (takeDirectory path) `equalFilePath` path || takeDirectory path == "."
replaceDirectory :: RawFilePath -> ByteString -> RawFilePath
replaceDirectory :: ByteString -> ByteString -> ByteString
replaceDirectory file :: ByteString
file dir :: ByteString
dir = ByteString -> ByteString -> ByteString
combineRaw ByteString
dir (ByteString -> ByteString
takeFileName ByteString
file)


-- | Join two paths together
--
-- >>> combine "/" "file"
-- "/file"
-- >>> combine "/path/to" "file"
-- "/path/to/file"
-- >>> combine "file" "/absolute/path"
-- "/absolute/path"
combine :: RawFilePath -> RawFilePath -> RawFilePath
combine :: ByteString -> ByteString -> ByteString
combine a :: ByteString
a b :: ByteString
b | Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
b) Bool -> Bool -> Bool
&& Word8 -> Bool
isPathSeparator (ByteString -> Word8
BS.head ByteString
b) = ByteString
b
            | Bool
otherwise = ByteString -> ByteString -> ByteString
combineRaw ByteString
a ByteString
b


-- | Operator version of combine
(</>) :: RawFilePath -> RawFilePath -> RawFilePath
</> :: ByteString -> ByteString -> ByteString
(</>) = ByteString -> ByteString -> ByteString
combine

-- | Split a path into a list of components:
--
-- >>> splitPath "/path/to/file.txt"
-- ["/","path/","to/","file.txt"]
--
-- prop> \path -> BS.concat (splitPath path) == path
splitPath :: RawFilePath -> [RawFilePath]
splitPath :: ByteString -> [ByteString]
splitPath = ByteString -> [ByteString]
splitter
  where
    splitter :: ByteString -> [ByteString]
splitter x :: ByteString
x
      | ByteString -> Bool
BS.null ByteString
x = []
      | Bool
otherwise = case Word8 -> ByteString -> Maybe Int
BS.elemIndex Word8
pathSeparator ByteString
x of
            Nothing -> [ByteString
x]
            Just ix :: Int
ix -> case (Word8 -> Bool) -> ByteString -> Maybe Int
BS.findIndex (Bool -> Bool
not (Bool -> Bool) -> (Word8 -> Bool) -> Word8 -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> Bool
isPathSeparator) (ByteString -> Maybe Int) -> ByteString -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.drop (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) ByteString
x of
                          Nothing -> [ByteString
x]
                          Just runlen :: Int
runlen -> (ByteString -> [ByteString] -> [ByteString])
-> (ByteString, [ByteString]) -> [ByteString]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((ByteString, [ByteString]) -> [ByteString])
-> ((ByteString, ByteString) -> (ByteString, [ByteString]))
-> (ByteString, ByteString)
-> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> [ByteString])
-> (ByteString, ByteString) -> (ByteString, [ByteString])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second ByteString -> [ByteString]
splitter ((ByteString, ByteString) -> [ByteString])
-> (ByteString, ByteString) -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> (ByteString, ByteString)
BS.splitAt (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
runlen) ByteString
x


-- | Join a split path back together
--
-- prop> \path -> joinPath (splitPath path) == path
--
-- >>> joinPath ["path","to","file.txt"]
-- "path/to/file.txt"
joinPath :: [RawFilePath] -> RawFilePath
joinPath :: [ByteString] -> ByteString
joinPath = (ByteString -> ByteString -> ByteString)
-> ByteString -> [ByteString] -> ByteString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr ByteString -> ByteString -> ByteString
(</>) ByteString
BS.empty


-- | Like 'splitPath', but without trailing slashes
--
-- >>> splitDirectories "/path/to/file.txt"
-- ["/","path","to","file.txt"]
-- >>> splitDirectories ""
-- []
splitDirectories :: RawFilePath -> [RawFilePath]
splitDirectories :: ByteString -> [ByteString]
splitDirectories x :: ByteString
x
    | ByteString -> Bool
BS.null ByteString
x = []
    | Word8 -> Bool
isPathSeparator (ByteString -> Word8
BS.head ByteString
x) = let (root :: ByteString
root,rest :: ByteString
rest) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt 1 ByteString
x
                                    in ByteString
root ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString]
splitter ByteString
rest
    | Bool
otherwise = ByteString -> [ByteString]
splitter ByteString
x
  where
    splitter :: ByteString -> [ByteString]
splitter = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
BS.null) ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString -> [ByteString]
BS.split Word8
pathSeparator



------------------------
-- Trailing slash functions

-- | Check if the last character of a 'RawFilePath' is '/'.
--
-- >>> hasTrailingPathSeparator "/path/"
-- True
-- >>> hasTrailingPathSeparator "/"
-- True
-- >>> hasTrailingPathSeparator "/path"
-- False
hasTrailingPathSeparator :: RawFilePath -> Bool
hasTrailingPathSeparator :: ByteString -> Bool
hasTrailingPathSeparator x :: ByteString
x
  | ByteString -> Bool
BS.null ByteString
x = Bool
False
  | Bool
otherwise = Word8 -> Bool
isPathSeparator (Word8 -> Bool) -> Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ ByteString -> Word8
BS.last ByteString
x


-- | Add a trailing path separator.
--
-- >>> addTrailingPathSeparator "/path"
-- "/path/"
-- >>> addTrailingPathSeparator "/path/"
-- "/path/"
-- >>> addTrailingPathSeparator "/"
-- "/"
addTrailingPathSeparator :: RawFilePath -> RawFilePath
addTrailingPathSeparator :: ByteString -> ByteString
addTrailingPathSeparator x :: ByteString
x = if ByteString -> Bool
hasTrailingPathSeparator ByteString
x
    then ByteString
x
    else ByteString
x ByteString -> Word8 -> ByteString
`BS.snoc` Word8
pathSeparator


-- | Remove a trailing path separator
--
-- >>> dropTrailingPathSeparator "/path/"
-- "/path"
-- >>> dropTrailingPathSeparator "/path////"
-- "/path"
-- >>> dropTrailingPathSeparator "/"
-- "/"
-- >>> dropTrailingPathSeparator "//"
-- "/"
dropTrailingPathSeparator :: RawFilePath -> RawFilePath
dropTrailingPathSeparator :: ByteString -> ByteString
dropTrailingPathSeparator x :: ByteString
x
  | ByteString
x ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Word8 -> ByteString
BS.singleton Word8
pathSeparator = ByteString
x
  | Bool
otherwise = if ByteString -> Bool
hasTrailingPathSeparator ByteString
x
                  then ByteString -> ByteString
dropTrailingPathSeparator (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.init ByteString
x
                  else ByteString
x



------------------------
-- File name manipulations


-- |Normalise a file.
--
-- >>> 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 "./bob////.fred/./...///./..///#."
-- "bob/.fred/.../../#."
-- >>> normalise "."
-- "."
-- >>> normalise "./"
-- "./"
-- >>> normalise "./."
-- "./"
-- >>> normalise "/./"
-- "/"
-- >>> normalise "/"
-- "/"
-- >>> normalise "bob/fred/."
-- "bob/fred/"
-- >>> normalise "//home"
-- "/home"
normalise :: RawFilePath -> RawFilePath
normalise :: ByteString -> ByteString
normalise filepath :: ByteString
filepath =
  ByteString
result ByteString -> ByteString -> ByteString
`BS.append`
  (if Bool
addPathSeparator
       then Word8 -> ByteString
BS.singleton Word8
pathSeparator
       else ByteString
BS.empty)
  where
    result :: ByteString
result = let n :: ByteString
n = ByteString -> ByteString
f ByteString
filepath
             in if ByteString -> Bool
BS.null ByteString
n
                then Word8 -> ByteString
BS.singleton Word8
_period
                else ByteString
n
    addPathSeparator :: Bool
addPathSeparator = ByteString -> Bool
isDirPath ByteString
filepath Bool -> Bool -> Bool
&&
      Bool -> Bool
not (ByteString -> Bool
hasTrailingPathSeparator ByteString
result)
    isDirPath :: ByteString -> Bool
isDirPath xs :: ByteString
xs = ByteString -> Bool
hasTrailingPathSeparator ByteString
xs
        Bool -> Bool -> Bool
|| Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
xs) Bool -> Bool -> Bool
&& ByteString -> Word8
BS.last ByteString
xs Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_period
           Bool -> Bool -> Bool
&& ByteString -> Bool
hasTrailingPathSeparator (ByteString -> ByteString
BS.init ByteString
xs)
    f :: ByteString -> ByteString
f = [ByteString] -> ByteString
joinPath ([ByteString] -> ByteString)
-> (ByteString -> [ByteString]) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
dropDots ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [ByteString]
propSep ([ByteString] -> [ByteString])
-> (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [ByteString]
splitDirectories
    propSep :: [ByteString] -> [ByteString]
    propSep :: [ByteString] -> [ByteString]
propSep (x :: ByteString
x:xs :: [ByteString]
xs)
      | (Word8 -> Bool) -> ByteString -> Bool
BS.all (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
pathSeparator) ByteString
x = Word8 -> ByteString
BS.singleton Word8
pathSeparator ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
xs
      | Bool
otherwise                   = ByteString
x ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
xs
    propSep [] = []
    dropDots :: [ByteString] -> [ByteString]
    dropDots :: [ByteString] -> [ByteString]
dropDots = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word8 -> ByteString
BS.singleton Word8
_period ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/=)



-- | 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>.
--
-- >>> makeRelative "/directory" "/directory/file.ext"
-- "file.ext"
-- >>> 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"
--
-- prop> \p -> makeRelative p p == "."
-- prop> \p -> makeRelative (takeDirectory p) p `equalFilePath` takeFileName p
-- prop \x y -> equalFilePath x y || (isRelative x && makeRelative y x == x) || equalFilePath (y </> makeRelative y x) x
makeRelative :: RawFilePath -> RawFilePath -> RawFilePath
makeRelative :: ByteString -> ByteString -> ByteString
makeRelative root :: ByteString
root path :: ByteString
path
  | ByteString -> ByteString -> Bool
equalFilePath ByteString
root ByteString
path = Word8 -> ByteString
BS.singleton Word8
_period
  | ByteString -> ByteString
takeAbs ByteString
root ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString -> ByteString
takeAbs ByteString
path = ByteString
path
  | Bool
otherwise = ByteString -> ByteString -> ByteString
f (ByteString -> ByteString
dropAbs ByteString
root) (ByteString -> ByteString
dropAbs ByteString
path)
  where
    f :: ByteString -> ByteString -> ByteString
f x :: ByteString
x y :: ByteString
y
      | ByteString -> Bool
BS.null ByteString
x = (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isPathSeparator ByteString
y
      | Bool
otherwise = let (x1 :: ByteString
x1,x2 :: ByteString
x2) = ByteString -> (ByteString, ByteString)
g ByteString
x
                        (y1 :: ByteString
y1,y2 :: ByteString
y2) = ByteString -> (ByteString, ByteString)
g ByteString
y
                    in if ByteString -> ByteString -> Bool
equalFilePath ByteString
x1 ByteString
y1 then ByteString -> ByteString -> ByteString
f ByteString
x2 ByteString
y2 else ByteString
path
    g :: ByteString -> (ByteString, ByteString)
g x :: ByteString
x = ((Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isPathSeparator ByteString
a, (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isPathSeparator ByteString
b)
      where (a :: ByteString
a, b :: ByteString
b) = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.break Word8 -> Bool
isPathSeparator (ByteString -> (ByteString, ByteString))
-> ByteString -> (ByteString, ByteString)
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> ByteString
BS.dropWhile Word8 -> Bool
isPathSeparator ByteString
x
    dropAbs :: ByteString -> ByteString
dropAbs x :: ByteString
x = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> b
snd ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_slash) ByteString
x
    takeAbs :: ByteString -> ByteString
takeAbs x :: ByteString
x = (ByteString, ByteString) -> ByteString
forall a b. (a, b) -> a
fst ((ByteString, ByteString) -> ByteString)
-> (ByteString, ByteString) -> ByteString
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.span (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_slash) ByteString
x


-- |Equality of two filepaths. The filepaths are normalised
-- and trailing path separators are dropped.
--
-- >>> equalFilePath "foo" "foo"
-- True
-- >>> equalFilePath "foo" "foo/"
-- True
-- >>> equalFilePath "foo" "./foo"
-- True
-- >>> equalFilePath "" ""
-- True
-- >>> equalFilePath "foo" "/foo"
-- False
-- >>> equalFilePath "foo" "FOO"
-- False
-- >>> equalFilePath "foo" "../foo"
-- False
--
-- prop> \p -> equalFilePath p p
equalFilePath :: RawFilePath -> RawFilePath -> Bool
equalFilePath :: ByteString -> ByteString -> Bool
equalFilePath p1 :: ByteString
p1 p2 :: ByteString
p2 = ByteString -> ByteString
f ByteString
p1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> ByteString
f ByteString
p2
  where
    f :: ByteString -> ByteString
f x :: ByteString
x = ByteString -> ByteString
dropTrailingPathSeparator (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
normalise ByteString
x


-- | Check if a path is relative
--
-- prop> \path -> isRelative path /= isAbsolute path
isRelative :: RawFilePath -> Bool
isRelative :: ByteString -> Bool
isRelative = Bool -> Bool
not (Bool -> Bool) -> (ByteString -> Bool) -> ByteString -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Bool
isAbsolute


-- | Check if a path is absolute
--
-- >>> isAbsolute "/path"
-- True
-- >>> isAbsolute "path"
-- False
-- >>> isAbsolute ""
-- False
isAbsolute :: RawFilePath -> Bool
isAbsolute :: ByteString -> Bool
isAbsolute x :: ByteString
x
    | ByteString -> Int
BS.length ByteString
x Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 = Word8 -> Bool
isPathSeparator (ByteString -> Word8
BS.head ByteString
x)
    | Bool
otherwise = Bool
False


-- | Is a FilePath valid, i.e. could you create a file like it?
--
-- >>> isValid ""
-- False
-- >>> isValid "\0"
-- False
-- >>> isValid "/random_ path:*"
-- True
isValid :: RawFilePath -> Bool
isValid :: ByteString -> Bool
isValid filepath :: ByteString
filepath
  | ByteString -> Bool
BS.null ByteString
filepath        = Bool
False
  | Word8
_nul Word8 -> ByteString -> Bool
`BS.elem` ByteString
filepath = Bool
False
  | Bool
otherwise               = Bool
True


-- | Take a FilePath and make it valid; does not change already valid FilePaths.
--
-- >>> makeValid ""
-- "_"
-- >>> makeValid "file\0name"
-- "file_name"
--
-- prop> \p -> if isValid p then makeValid p == p else makeValid p /= p
-- prop> \p -> isValid (makeValid p)
makeValid :: RawFilePath -> RawFilePath
makeValid :: ByteString -> ByteString
makeValid path :: ByteString
path
  | ByteString -> Bool
BS.null ByteString
path = Word8 -> ByteString
BS.singleton Word8
_underscore
  | Bool
otherwise    = (Word8 -> Word8) -> ByteString -> ByteString
BS.map (\x :: Word8
x -> if Word8
x Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
_nul then Word8
_underscore else Word8
x) ByteString
path


-- | Is the given path a valid filename? This includes
-- "." and "..".
--
-- >>> isFileName "lal"
-- True
-- >>> isFileName "."
-- True
-- >>> isFileName ".."
-- True
-- >>> isFileName ""
-- False
-- >>> isFileName "\0"
-- False
-- >>> isFileName "/random_ path:*"
-- False
isFileName :: RawFilePath -> Bool
isFileName :: ByteString -> Bool
isFileName filepath :: ByteString
filepath =
  Bool -> Bool
not (Word8 -> ByteString
BS.singleton Word8
pathSeparator ByteString -> ByteString -> Bool
`BS.isInfixOf` ByteString
filepath) Bool -> Bool -> Bool
&&
  Bool -> Bool
not (ByteString -> Bool
BS.null ByteString
filepath) Bool -> Bool -> Bool
&&
  Bool -> Bool
not (Word8
_nul Word8 -> ByteString -> Bool
`BS.elem` ByteString
filepath)


-- | Check if the filepath has any parent directories in it.
--
-- >>> hasParentDir "/.."
-- True
-- >>> hasParentDir "foo/bar/.."
-- True
-- >>> hasParentDir "foo/../bar/."
-- True
-- >>> hasParentDir "foo/bar"
-- False
-- >>> hasParentDir "foo"
-- False
-- >>> hasParentDir ""
-- False
-- >>> hasParentDir ".."
-- False
hasParentDir :: RawFilePath -> Bool
hasParentDir :: ByteString -> Bool
hasParentDir filepath :: ByteString
filepath =
    (Word8
pathSeparator Word8 -> ByteString -> ByteString
`BS.cons` ByteString
pathDoubleDot)
     ByteString -> ByteString -> Bool
`BS.isSuffixOf` ByteString
filepath
   Bool -> Bool -> Bool
||
    (Word8 -> ByteString
BS.singleton Word8
pathSeparator
        ByteString -> ByteString -> ByteString
`BS.append` ByteString
pathDoubleDot
        ByteString -> ByteString -> ByteString
`BS.append` Word8 -> ByteString
BS.singleton Word8
pathSeparator)
     ByteString -> ByteString -> Bool
`BS.isInfixOf`  ByteString
filepath
   Bool -> Bool -> Bool
||
    (ByteString
pathDoubleDot ByteString -> ByteString -> ByteString
`BS.append` Word8 -> ByteString
BS.singleton Word8
pathSeparator)
      ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
filepath
  where
    pathDoubleDot :: ByteString
pathDoubleDot = [Word8] -> ByteString
BS.pack [Word8
_period, Word8
_period]


-- | Whether the file is a hidden file.
--
-- >>> hiddenFile ".foo"
-- True
-- >>> hiddenFile "..foo.bar"
-- True
-- >>> hiddenFile "some/path/.bar"
-- True
-- >>> hiddenFile "..."
-- True
-- >>> hiddenFile "dod.bar"
-- False
-- >>> hiddenFile "."
-- False
-- >>> hiddenFile ".."
-- False
-- >>> hiddenFile ""
-- False
hiddenFile :: RawFilePath -> Bool
hiddenFile :: ByteString -> Bool
hiddenFile fp :: ByteString
fp
  | ByteString
fn ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [Word8] -> ByteString
BS.pack [Word8
_period, Word8
_period] = Bool
False
  | ByteString
fn ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== [Word8] -> ByteString
BS.pack [Word8
_period]          = Bool
False
  | Bool
otherwise                        = [Word8] -> ByteString
BS.pack [Word8
extSeparator]
                                         ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
fn
  where
    fn :: ByteString
fn = ByteString -> ByteString
takeFileName ByteString
fp



------------------------
-- internal stuff

-- Just split the input FileName without adding/normalizing or changing
-- anything.
splitFileNameRaw :: RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw :: ByteString -> (ByteString, ByteString)
splitFileNameRaw = (Word8 -> Bool) -> ByteString -> (ByteString, ByteString)
BS.breakEnd Word8 -> Bool
isPathSeparator

-- | Combine two paths, assuming rhs is NOT absolute.
combineRaw :: RawFilePath -> RawFilePath -> RawFilePath
combineRaw :: ByteString -> ByteString -> ByteString
combineRaw a :: ByteString
a b :: ByteString
b | ByteString -> Bool
BS.null ByteString
a = ByteString
b
                  | ByteString -> Bool
BS.null ByteString
b = ByteString
a
                  | Word8 -> Bool
isPathSeparator (ByteString -> Word8
BS.last ByteString
a) = ByteString -> ByteString -> ByteString
BS.append ByteString
a ByteString
b
                  | Bool
otherwise = ByteString -> [ByteString] -> ByteString
BS.intercalate (Word8 -> ByteString
BS.singleton Word8
pathSeparator) [ByteString
a, ByteString
b]