{-# LANGUAGE CPP #-}
module Foundation.VFS.FilePath
( FilePath
, Relativity(..)
, FileName
, filePathToString
, filePathToLString
, unsafeFilePath
, unsafeFileName
, extension
) where
import Basement.Compat.Base
import Basement.Compat.Semigroup
import Foundation.Collection
import Foundation.Array
import Foundation.String (Encoding(..), ValidationFailure, toBytes, fromBytes, String)
import Foundation.VFS.Path(Path(..))
import qualified Data.List
#ifdef mingw32_HOST_OS
pathSeparatorWINC :: Char
pathSeparatorWINC = '\\'
pathSeparatorWIN :: String
pathSeparatorWIN = fromString [pathSeparatorWINC]
#else
pathSeparatorPOSIXC :: Char
pathSeparatorPOSIXC :: Char
pathSeparatorPOSIXC = Char
'/'
pathSeparatorPOSIX :: String
pathSeparatorPOSIX :: String
pathSeparatorPOSIX = String -> String
forall a. IsString a => String -> a
fromString [Char
pathSeparatorPOSIXC]
#endif
pathSeparatorC :: Char
pathSeparator :: String
#ifdef mingw32_HOST_OS
pathSeparatorC = pathSeparatorWINC
pathSeparator = pathSeparatorWIN
#else
pathSeparatorC :: Char
pathSeparatorC = Char
pathSeparatorPOSIXC
pathSeparator :: String
pathSeparator = String
pathSeparatorPOSIX
#endif
data Relativity = Absolute | Relative
deriving (Relativity -> Relativity -> Bool
(Relativity -> Relativity -> Bool)
-> (Relativity -> Relativity -> Bool) -> Eq Relativity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Relativity -> Relativity -> Bool
$c/= :: Relativity -> Relativity -> Bool
== :: Relativity -> Relativity -> Bool
$c== :: Relativity -> Relativity -> Bool
Eq, Int -> Relativity -> ShowS
[Relativity] -> ShowS
Relativity -> String
(Int -> Relativity -> ShowS)
-> (Relativity -> String)
-> ([Relativity] -> ShowS)
-> Show Relativity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Relativity] -> ShowS
$cshowList :: [Relativity] -> ShowS
show :: Relativity -> String
$cshow :: Relativity -> String
showsPrec :: Int -> Relativity -> ShowS
$cshowsPrec :: Int -> Relativity -> ShowS
Show)
data FilePath = FilePath Relativity [FileName]
instance Show FilePath where
show :: FilePath -> String
show = FilePath -> String
filePathToLString
instance Eq FilePath where
== :: FilePath -> FilePath -> Bool
(==) FilePath
a FilePath
b = String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (FilePath -> String
forall a. Show a => a -> String
show FilePath
a) (FilePath -> String
forall a. Show a => a -> String
show FilePath
b)
instance Ord FilePath where
compare :: FilePath -> FilePath -> Ordering
compare FilePath
a FilePath
b = String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (FilePath -> String
forall a. Show a => a -> String
show FilePath
a) (FilePath -> String
forall a. Show a => a -> String
show FilePath
b)
data FilePath_Invalid
= ContiguousPathSeparator
deriving (Typeable, Int -> FilePath_Invalid -> ShowS
[FilePath_Invalid] -> ShowS
FilePath_Invalid -> String
(Int -> FilePath_Invalid -> ShowS)
-> (FilePath_Invalid -> String)
-> ([FilePath_Invalid] -> ShowS)
-> Show FilePath_Invalid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FilePath_Invalid] -> ShowS
$cshowList :: [FilePath_Invalid] -> ShowS
show :: FilePath_Invalid -> String
$cshow :: FilePath_Invalid -> String
showsPrec :: Int -> FilePath_Invalid -> ShowS
$cshowsPrec :: Int -> FilePath_Invalid -> ShowS
Show)
instance Exception FilePath_Invalid
instance IsString FilePath where
fromString :: String -> FilePath
fromString [] = Relativity -> [FileName] -> FilePath
FilePath Relativity
Absolute [FileName]
forall a. Monoid a => a
mempty
fromString s :: String
s@(Char
x:String
xs)
| String -> Bool
hasContigueSeparators String
s = FilePath_Invalid -> FilePath
forall a e. Exception e => e -> a
throw FilePath_Invalid
ContiguousPathSeparator
| Bool
otherwise = Relativity -> [FileName] -> FilePath
FilePath Relativity
relativity ([FileName] -> FilePath) -> [FileName] -> FilePath
forall a b. (a -> b) -> a -> b
$ case Relativity
relativity of
Relativity
Absolute -> String -> FileName
forall a. IsString a => String -> a
fromString (String -> FileName) -> [String] -> [FileName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element String -> Bool) -> String -> [String]
forall c. Sequential c => (Element c -> Bool) -> c -> [c]
splitOn Char -> Bool
Element String -> Bool
isSeparator String
xs
Relativity
Relative -> String -> FileName
forall a. IsString a => String -> a
fromString (String -> FileName) -> [String] -> [FileName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Element String -> Bool) -> String -> [String]
forall c. Sequential c => (Element c -> Bool) -> c -> [c]
splitOn Char -> Bool
Element String -> Bool
isSeparator String
s
where
relativity :: Relativity
relativity :: Relativity
relativity = if Char -> Bool
isSeparator Char
x then Relativity
Absolute else Relativity
Relative
data FileName = FileName (UArray Word8)
deriving (FileName -> FileName -> Bool
(FileName -> FileName -> Bool)
-> (FileName -> FileName -> Bool) -> Eq FileName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileName -> FileName -> Bool
$c/= :: FileName -> FileName -> Bool
== :: FileName -> FileName -> Bool
$c== :: FileName -> FileName -> Bool
Eq)
data FileName_Invalid
= ContainsNullByte
| ContainsSeparator
| EncodingError ValidationFailure
| UnknownTrailingBytes (UArray Word8)
deriving (Typeable, Int -> FileName_Invalid -> ShowS
[FileName_Invalid] -> ShowS
FileName_Invalid -> String
(Int -> FileName_Invalid -> ShowS)
-> (FileName_Invalid -> String)
-> ([FileName_Invalid] -> ShowS)
-> Show FileName_Invalid
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FileName_Invalid] -> ShowS
$cshowList :: [FileName_Invalid] -> ShowS
show :: FileName_Invalid -> String
$cshow :: FileName_Invalid -> String
showsPrec :: Int -> FileName_Invalid -> ShowS
$cshowsPrec :: Int -> FileName_Invalid -> ShowS
Show)
instance Exception FileName_Invalid
instance Show FileName where
show :: FileName -> String
show = FileName -> String
fileNameToLString
instance IsString FileName where
fromString :: String -> FileName
fromString [] = UArray Word8 -> FileName
FileName UArray Word8
forall a. Monoid a => a
mempty
fromString String
xs | String -> Bool
hasNullByte String
xs = FileName_Invalid -> FileName
forall a e. Exception e => e -> a
throw FileName_Invalid
ContainsNullByte
| String -> Bool
hasSeparator String
xs = FileName_Invalid -> FileName
forall a e. Exception e => e -> a
throw FileName_Invalid
ContainsSeparator
| Bool
otherwise = UArray Word8 -> FileName
FileName (UArray Word8 -> FileName) -> UArray Word8 -> FileName
forall a b. (a -> b) -> a -> b
$ Encoding -> String -> UArray Word8
toBytes Encoding
UTF8 (String -> UArray Word8) -> String -> UArray Word8
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. IsString a => String -> a
fromString String
xs
hasNullByte :: [Char] -> Bool
hasNullByte :: String -> Bool
hasNullByte = Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem Char
'\0'
hasSeparator :: [Char] -> Bool
hasSeparator :: String -> Bool
hasSeparator = Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem Char
pathSeparatorC
isSeparator :: Char -> Bool
isSeparator :: Char -> Bool
isSeparator = Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
(==) Char
pathSeparatorC
hasContigueSeparators :: [Char] -> Bool
hasContigueSeparators :: String -> Bool
hasContigueSeparators [] = Bool
False
hasContigueSeparators [Char
_] = Bool
False
hasContigueSeparators (Char
x1:Char
x2:String
xs) =
(Char -> Bool
isSeparator Char
x1 Bool -> Bool -> Bool
&& Char
x1 Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
x2) Bool -> Bool -> Bool
|| String -> Bool
hasContigueSeparators String
xs
instance Semigroup FileName where
<> :: FileName -> FileName -> FileName
(<>) (FileName UArray Word8
a) (FileName UArray Word8
b) = UArray Word8 -> FileName
FileName (UArray Word8 -> FileName) -> UArray Word8 -> FileName
forall a b. (a -> b) -> a -> b
$ UArray Word8
a UArray Word8 -> UArray Word8 -> UArray Word8
forall a. Monoid a => a -> a -> a
`mappend` UArray Word8
b
instance Monoid FileName where
mempty :: FileName
mempty = UArray Word8 -> FileName
FileName UArray Word8
forall a. Monoid a => a
mempty
instance Path FilePath where
type PathEnt FilePath = FileName
type PathPrefix FilePath = Relativity
type PathSuffix FilePath = ()
</> :: FilePath -> PathEnt FilePath -> FilePath
(</>) = FilePath -> PathEnt FilePath -> FilePath
FilePath -> FileName -> FilePath
join
splitPath :: FilePath
-> (PathPrefix FilePath, [PathEnt FilePath], PathSuffix FilePath)
splitPath (FilePath Relativity
r [FileName]
xs) = (PathPrefix FilePath
Relativity
r, [PathEnt FilePath]
[FileName]
xs, ())
buildPath :: (PathPrefix FilePath, [PathEnt FilePath], PathSuffix FilePath)
-> FilePath
buildPath (PathPrefix FilePath
r, [PathEnt FilePath]
xs , PathSuffix FilePath
_) = Relativity -> [FileName] -> FilePath
FilePath PathPrefix FilePath
Relativity
r [PathEnt FilePath]
[FileName]
xs
join :: FilePath -> FileName -> FilePath
join :: FilePath -> FileName -> FilePath
join FilePath
p (FileName UArray Word8
x) | UArray Word8 -> Bool
forall c. Collection c => c -> Bool
null UArray Word8
x = FilePath
p
join (FilePath Relativity
r [FileName]
xs) FileName
x = Relativity -> [FileName] -> FilePath
FilePath Relativity
r ([FileName] -> FilePath) -> [FileName] -> FilePath
forall a b. (a -> b) -> a -> b
$ [FileName] -> Element [FileName] -> [FileName]
forall c. Sequential c => c -> Element c -> c
snoc [FileName]
xs Element [FileName]
FileName
x
filePathToString :: FilePath -> String
filePathToString :: FilePath -> String
filePathToString (FilePath Relativity
Absolute []) = String -> String
forall a. IsString a => String -> a
fromString [Char
pathSeparatorC]
filePathToString (FilePath Relativity
Relative []) = String -> String
forall a. IsString a => String -> a
fromString String
"."
filePathToString (FilePath Relativity
Absolute [FileName]
fns) = Element String -> String -> String
forall c. Sequential c => Element c -> c -> c
cons Char
Element String
pathSeparatorC (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ [FileName] -> String
filenameIntercalate [FileName]
fns
filePathToString (FilePath Relativity
Relative [FileName]
fns) = [FileName] -> String
filenameIntercalate [FileName]
fns
filenameIntercalate :: [FileName] -> String
filenameIntercalate :: [FileName] -> String
filenameIntercalate = [String] -> String
forall a. Monoid a => [a] -> a
mconcat ([String] -> String)
-> ([FileName] -> [String]) -> [FileName] -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
Data.List.intersperse String
pathSeparator ([String] -> [String])
-> ([FileName] -> [String]) -> [FileName] -> [String]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FileName -> String) -> [FileName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FileName -> String
fileNameToString
fileNameToString :: FileName -> String
fileNameToString :: FileName -> String
fileNameToString (FileName UArray Word8
fp) =
case Encoding
-> UArray Word8 -> (String, Maybe ValidationFailure, UArray Word8)
fromBytes Encoding
UTF8 UArray Word8
fp of
(String
s, Maybe ValidationFailure
Nothing, UArray Word8
bs)
| UArray Word8 -> Bool
forall c. Collection c => c -> Bool
null UArray Word8
bs -> String
s
| Bool
otherwise -> FileName_Invalid -> String
forall a e. Exception e => e -> a
throw (FileName_Invalid -> String) -> FileName_Invalid -> String
forall a b. (a -> b) -> a -> b
$ UArray Word8 -> FileName_Invalid
UnknownTrailingBytes UArray Word8
bs
(String
_, Just ValidationFailure
err, UArray Word8
_) -> FileName_Invalid -> String
forall a e. Exception e => e -> a
throw (FileName_Invalid -> String) -> FileName_Invalid -> String
forall a b. (a -> b) -> a -> b
$ ValidationFailure -> FileName_Invalid
EncodingError ValidationFailure
err
fileNameToLString :: FileName -> [Char]
fileNameToLString :: FileName -> String
fileNameToLString = String -> String
forall l. IsList l => l -> [Item l]
toList (String -> String) -> (FileName -> String) -> FileName -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FileName -> String
fileNameToString
filePathToLString :: FilePath -> [Char]
filePathToLString :: FilePath -> String
filePathToLString = String -> String
forall l. IsList l => l -> [Item l]
toList (String -> String) -> (FilePath -> String) -> FilePath -> String
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> String
filePathToString
unsafeFilePath :: Relativity -> [FileName] -> FilePath
unsafeFilePath :: Relativity -> [FileName] -> FilePath
unsafeFilePath = Relativity -> [FileName] -> FilePath
FilePath
unsafeFileName :: UArray Word8 -> FileName
unsafeFileName :: UArray Word8 -> FileName
unsafeFileName = UArray Word8 -> FileName
FileName
extension :: FileName -> Maybe FileName
extension :: FileName -> Maybe FileName
extension (FileName UArray Word8
fn) = case (Element (UArray Word8) -> Bool) -> UArray Word8 -> [UArray Word8]
forall c. Sequential c => (Element c -> Bool) -> c -> [c]
splitOn (\Element (UArray Word8)
c -> Word8
Element (UArray Word8)
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0x2E) UArray Word8
fn of
[] -> Maybe FileName
forall a. Maybe a
Nothing
[UArray Word8
_] -> Maybe FileName
forall a. Maybe a
Nothing
[UArray Word8]
xs -> FileName -> Maybe FileName
forall a. a -> Maybe a
Just (FileName -> Maybe FileName) -> FileName -> Maybe FileName
forall a b. (a -> b) -> a -> b
$ UArray Word8 -> FileName
FileName (UArray Word8 -> FileName) -> UArray Word8 -> FileName
forall a b. (a -> b) -> a -> b
$ NonEmpty [UArray Word8] -> Element [UArray Word8]
forall c. Sequential c => NonEmpty c -> Element c
last (NonEmpty [UArray Word8] -> Element [UArray Word8])
-> NonEmpty [UArray Word8] -> Element [UArray Word8]
forall a b. (a -> b) -> a -> b
$ [UArray Word8] -> NonEmpty [UArray Word8]
forall c. Collection c => c -> NonEmpty c
nonEmpty_ [UArray Word8]
xs