{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE ViewPatterns #-}

{-# OPTIONS_GHC -Wall #-}

-- | The equivalent of "System.FilePath" on raw (byte string) file paths.
--
-- Not all functions of "System.FilePath" are implemented yet. Feel free to contribute!
module System.Posix.FilePath (

  pathSeparator
, isPathSeparator
, searchPathSeparator
, isSearchPathSeparator
, extSeparator
, isExtSeparator

, splitExtension
, takeExtension
, replaceExtension
, dropExtension
, addExtension
, hasExtension
, (<.>)
, splitExtensions
, dropExtensions
, takeExtensions

, splitFileName
, takeFileName
, replaceFileName
, dropFileName
, takeBaseName
, replaceBaseName
, takeDirectory
, replaceDirectory
, combine
, (</>)
, splitPath
, joinPath
, splitDirectories

, hasTrailingPathSeparator
, addTrailingPathSeparator
, dropTrailingPathSeparator

, isRelative
, isAbsolute

, module System.Posix.ByteString.FilePath
) where

import           Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import           System.Posix.ByteString.FilePath

import           Data.Char  (ord)
import           Data.Maybe (isJust)
import           Data.Word (Word8)

import           Control.Arrow (second)

-- $setup
-- >>> import Data.Char
-- >>> 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


-- | Path separator character
pathSeparator :: Word8
pathSeparator :: Word8
pathSeparator = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'/'

-- | 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 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
':'

-- | 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 = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> Int -> Word8
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
'.'

-- | 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)

------------------------
-- extension stuff

-- | 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 :: RawFilePath -> (RawFilePath, RawFilePath)
splitExtension RawFilePath
x = if RawFilePath -> Bool
BS.null RawFilePath
basename
    then (RawFilePath
x,RawFilePath
BS.empty)
    else (RawFilePath -> RawFilePath -> RawFilePath
BS.append RawFilePath
path (RawFilePath -> RawFilePath
BS.init RawFilePath
basename),Word8 -> RawFilePath -> RawFilePath
BS.cons Word8
extSeparator RawFilePath
fileExt)
  where
    (RawFilePath
path,RawFilePath
file) = RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw RawFilePath
x
    (RawFilePath
basename,RawFilePath
fileExt) = (Word8 -> Bool) -> RawFilePath -> (RawFilePath, RawFilePath)
BS.breakEnd Word8 -> Bool
isExtSeparator RawFilePath
file

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

-- | Change a file's extension
--
-- prop> \path -> let ext = takeExtension path in replaceExtension path ext == path
replaceExtension :: RawFilePath -> ByteString -> RawFilePath
replaceExtension :: RawFilePath -> RawFilePath -> RawFilePath
replaceExtension RawFilePath
path RawFilePath
ext = RawFilePath -> RawFilePath
dropExtension RawFilePath
path RawFilePath -> RawFilePath -> RawFilePath
<.> RawFilePath
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 :: RawFilePath -> RawFilePath
dropExtension = (RawFilePath, RawFilePath) -> RawFilePath
forall a b. (a, b) -> a
fst ((RawFilePath, RawFilePath) -> RawFilePath)
-> (RawFilePath -> (RawFilePath, RawFilePath))
-> RawFilePath
-> RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> (RawFilePath, RawFilePath)
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 :: RawFilePath -> RawFilePath -> RawFilePath
addExtension RawFilePath
file RawFilePath
ext
    | RawFilePath -> Bool
BS.null RawFilePath
ext = RawFilePath
file
    | Word8 -> Bool
isExtSeparator (RawFilePath -> Word8
BS.head RawFilePath
ext) = RawFilePath -> RawFilePath -> RawFilePath
BS.append RawFilePath
file RawFilePath
ext
    | Bool
otherwise = RawFilePath -> [RawFilePath] -> RawFilePath
BS.intercalate (Word8 -> RawFilePath
BS.singleton Word8
extSeparator) [RawFilePath
file, RawFilePath
ext]


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

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

-- | 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 :: RawFilePath -> (RawFilePath, RawFilePath)
splitExtensions RawFilePath
x = if RawFilePath -> Bool
BS.null RawFilePath
basename
    then (RawFilePath
path,RawFilePath
fileExt)
    else (RawFilePath -> RawFilePath -> RawFilePath
BS.append RawFilePath
path RawFilePath
basename,RawFilePath
fileExt)
  where
    (RawFilePath
path,RawFilePath
file) = RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw RawFilePath
x
    (RawFilePath
basename,RawFilePath
fileExt) = (Word8 -> Bool) -> RawFilePath -> (RawFilePath, RawFilePath)
BS.break Word8 -> Bool
isExtSeparator RawFilePath
file

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

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

------------------------
-- more stuff

-- | 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 :: RawFilePath -> (RawFilePath, RawFilePath)
splitFileName RawFilePath
x = if RawFilePath -> Bool
BS.null RawFilePath
path
    then (RawFilePath
"./", RawFilePath
file)
    else (RawFilePath
path,RawFilePath
file)
  where
    (RawFilePath
path,RawFilePath
file) = RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw RawFilePath
x

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

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

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

-- | Get the file name, without a trailing extension
--
-- >>> takeBaseName "path/file.tar.gz"
-- "file.tar"
--
-- >>> takeBaseName ""
-- ""
takeBaseName :: RawFilePath -> ByteString
takeBaseName :: RawFilePath -> RawFilePath
takeBaseName = RawFilePath -> RawFilePath
dropExtension (RawFilePath -> RawFilePath)
-> (RawFilePath -> RawFilePath) -> RawFilePath -> RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> RawFilePath
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 :: RawFilePath -> RawFilePath -> RawFilePath
replaceBaseName RawFilePath
path RawFilePath
name = RawFilePath -> RawFilePath -> RawFilePath
combineRaw RawFilePath
dir (RawFilePath
name RawFilePath -> RawFilePath -> RawFilePath
<.> RawFilePath
ext)
  where
    (RawFilePath
dir,RawFilePath
file) = RawFilePath -> (RawFilePath, RawFilePath)
splitFileNameRaw RawFilePath
path
    ext :: RawFilePath
ext = RawFilePath -> RawFilePath
takeExtension RawFilePath
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 :: RawFilePath -> RawFilePath
takeDirectory RawFilePath
x = case () of
    () | RawFilePath
x RawFilePath -> RawFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== RawFilePath
"/" -> RawFilePath
x
       | RawFilePath -> Bool
BS.null RawFilePath
res Bool -> Bool -> Bool
&& Bool -> Bool
not (RawFilePath -> Bool
BS.null RawFilePath
file) -> RawFilePath
file
       | Bool
otherwise -> RawFilePath
res
  where
    res :: RawFilePath
res = (RawFilePath, RawFilePath) -> RawFilePath
forall a b. (a, b) -> a
fst ((RawFilePath, RawFilePath) -> RawFilePath)
-> (RawFilePath, RawFilePath) -> RawFilePath
forall a b. (a -> b) -> a -> b
$ (Word8 -> Bool) -> RawFilePath -> (RawFilePath, RawFilePath)
BS.spanEnd Word8 -> Bool
isPathSeparator RawFilePath
file
    file :: RawFilePath
file = RawFilePath -> RawFilePath
dropFileName RawFilePath
x

-- | Change the directory component of a 'RawFilePath'
--
-- prop> \path -> replaceDirectory path (takeDirectory path) `_equalFilePath` path || takeDirectory path == "."
replaceDirectory :: RawFilePath -> ByteString -> RawFilePath
replaceDirectory :: RawFilePath -> RawFilePath -> RawFilePath
replaceDirectory RawFilePath
file RawFilePath
dir = RawFilePath -> RawFilePath -> RawFilePath
combineRaw RawFilePath
dir (RawFilePath -> RawFilePath
takeFileName RawFilePath
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 :: RawFilePath -> RawFilePath -> RawFilePath
combine RawFilePath
a RawFilePath
b | Bool -> Bool
not (RawFilePath -> Bool
BS.null RawFilePath
b) Bool -> Bool -> Bool
&& Word8 -> Bool
isPathSeparator (RawFilePath -> Word8
BS.head RawFilePath
b) = RawFilePath
b
            | Bool
otherwise = RawFilePath -> RawFilePath -> RawFilePath
combineRaw RawFilePath
a RawFilePath
b

-- | Operator version of combine
(</>) :: RawFilePath -> RawFilePath -> RawFilePath
</> :: RawFilePath -> RawFilePath -> RawFilePath
(</>) = RawFilePath -> RawFilePath -> RawFilePath
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 :: RawFilePath -> [RawFilePath]
splitPath = RawFilePath -> [RawFilePath]
splitter
  where
    splitter :: RawFilePath -> [RawFilePath]
splitter RawFilePath
x
      | RawFilePath -> Bool
BS.null RawFilePath
x = []
      | Bool
otherwise = case Word8 -> RawFilePath -> Maybe Int
BS.elemIndex Word8
pathSeparator RawFilePath
x of
            Maybe Int
Nothing -> [RawFilePath
x]
            Just Int
ix -> case (Word8 -> Bool) -> RawFilePath -> 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) (RawFilePath -> Maybe Int) -> RawFilePath -> Maybe Int
forall a b. (a -> b) -> a -> b
$ Int -> RawFilePath -> RawFilePath
BS.drop (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) RawFilePath
x of
                          Maybe Int
Nothing -> [RawFilePath
x]
                          Just Int
runlen -> (RawFilePath -> [RawFilePath] -> [RawFilePath])
-> (RawFilePath, [RawFilePath]) -> [RawFilePath]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:) ((RawFilePath, [RawFilePath]) -> [RawFilePath])
-> ((RawFilePath, RawFilePath) -> (RawFilePath, [RawFilePath]))
-> (RawFilePath, RawFilePath)
-> [RawFilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawFilePath -> [RawFilePath])
-> (RawFilePath, RawFilePath) -> (RawFilePath, [RawFilePath])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second RawFilePath -> [RawFilePath]
splitter ((RawFilePath, RawFilePath) -> [RawFilePath])
-> (RawFilePath, RawFilePath) -> [RawFilePath]
forall a b. (a -> b) -> a -> b
$ Int -> RawFilePath -> (RawFilePath, RawFilePath)
BS.splitAt (Int
ixInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
runlen) RawFilePath
x

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

-- | 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 :: [RawFilePath] -> RawFilePath
joinPath = (RawFilePath -> RawFilePath -> RawFilePath)
-> RawFilePath -> [RawFilePath] -> RawFilePath
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr RawFilePath -> RawFilePath -> RawFilePath
(</>) RawFilePath
BS.empty


------------------------
-- trailing path separators

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

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

-- | Remove a trailing path separator
--
-- >>> dropTrailingPathSeparator "/path/"
-- "/path"
--
-- >>> dropTrailingPathSeparator "/"
-- "/"
dropTrailingPathSeparator :: RawFilePath -> RawFilePath
dropTrailingPathSeparator :: RawFilePath -> RawFilePath
dropTrailingPathSeparator RawFilePath
x = if RawFilePath -> Bool
hasTrailingPathSeparator RawFilePath
x
    then RawFilePath -> RawFilePath
BS.init RawFilePath
x
    else RawFilePath
x

------------------------
-- Filename/system stuff

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

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

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

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

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

-- | we don't even attempt to fully normalize file paths, this is just enough
-- equality to test some operations.
--
_equalFilePath :: RawFilePath -> RawFilePath -> Bool
_equalFilePath :: RawFilePath -> RawFilePath -> Bool
_equalFilePath RawFilePath
a RawFilePath
b = RawFilePath -> RawFilePath
norm RawFilePath
a RawFilePath -> RawFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== RawFilePath -> RawFilePath
norm RawFilePath
b
  where
    -- Drop trailing slash *after* we've dropped duplicate slashes,
    -- otherwise there might be trailing slashes left.
    norm :: RawFilePath -> RawFilePath
norm = RawFilePath -> RawFilePath
dropTrailingSlash (RawFilePath -> RawFilePath)
-> (RawFilePath -> RawFilePath) -> RawFilePath -> RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> RawFilePath
dropDups (RawFilePath -> RawFilePath)
-> (RawFilePath -> RawFilePath) -> RawFilePath -> RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> RawFilePath
dropInitialDot
    dropTrailingSlash :: RawFilePath -> RawFilePath
dropTrailingSlash RawFilePath
path
        | RawFilePath -> Int
BS.length RawFilePath
path Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Word8 -> Bool
isPathSeparator (RawFilePath -> Word8
BS.last RawFilePath
path) = RawFilePath -> RawFilePath
BS.init RawFilePath
path
        | Bool
otherwise = RawFilePath
path
    dropInitialDot :: RawFilePath -> RawFilePath
dropInitialDot RawFilePath
path
        | RawFilePath -> Int
BS.length RawFilePath
path Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
2 Bool -> Bool -> Bool
&& Int -> RawFilePath -> RawFilePath
BS.take Int
2 RawFilePath
path RawFilePath -> RawFilePath -> Bool
forall a. Eq a => a -> a -> Bool
== RawFilePath
"./" = Int -> RawFilePath -> RawFilePath
BS.drop Int
2 RawFilePath
path
        | Bool
otherwise = RawFilePath
path
    dropDups :: RawFilePath -> RawFilePath
dropDups = [RawFilePath] -> RawFilePath
joinPath ([RawFilePath] -> RawFilePath)
-> (RawFilePath -> [RawFilePath]) -> RawFilePath -> RawFilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RawFilePath -> RawFilePath) -> [RawFilePath] -> [RawFilePath]
forall a b. (a -> b) -> [a] -> [b]
map RawFilePath -> RawFilePath
f ([RawFilePath] -> [RawFilePath])
-> (RawFilePath -> [RawFilePath]) -> RawFilePath -> [RawFilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RawFilePath -> [RawFilePath]
splitPath
    f :: RawFilePath -> RawFilePath
f RawFilePath
component
        | RawFilePath -> RawFilePath -> Bool
BS.isSuffixOf RawFilePath
"//" RawFilePath
component = RawFilePath -> RawFilePath
f (RawFilePath -> RawFilePath
BS.init RawFilePath
component) -- there might be more slashes
        | Bool
otherwise = RawFilePath
component