{-# 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 = 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
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
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 = forall a. Eq a => a -> a -> Bool
(==) (forall a. Show a => a -> String
show FilePath
a) (forall a. Show a => a -> String
show FilePath
b)
instance Ord FilePath where
compare :: FilePath -> FilePath -> Ordering
compare FilePath
a FilePath
b = forall a. Ord a => a -> a -> Ordering
compare (forall a. Show a => a -> String
show FilePath
a) (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
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 forall a. Monoid a => a
mempty
fromString s :: String
s@(Char
x:String
xs)
| String -> Bool
hasContigueSeparators String
s = forall a e. Exception e => e -> a
throw FilePath_Invalid
ContiguousPathSeparator
| Bool
otherwise = Relativity -> [FileName] -> FilePath
FilePath Relativity
relativity forall a b. (a -> b) -> a -> b
$ case Relativity
relativity of
Relativity
Absolute -> forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. Sequential c => (Element c -> Bool) -> c -> [c]
splitOn Char -> Bool
isSeparator String
xs
Relativity
Relative -> forall a. IsString a => String -> a
fromString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c. Sequential c => (Element c -> Bool) -> c -> [c]
splitOn Char -> 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
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
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 forall a. Monoid a => a
mempty
fromString String
xs | String -> Bool
hasNullByte String
xs = forall a e. Exception e => e -> a
throw FileName_Invalid
ContainsNullByte
| String -> Bool
hasSeparator String
xs = forall a e. Exception e => e -> a
throw FileName_Invalid
ContainsSeparator
| Bool
otherwise = UArray Word8 -> FileName
FileName forall a b. (a -> b) -> a -> b
$ Encoding -> String -> UArray Word8
toBytes Encoding
UTF8 forall a b. (a -> b) -> a -> b
$ forall a. IsString a => String -> a
fromString String
xs
hasNullByte :: [Char] -> Bool
hasNullByte :: String -> Bool
hasNullByte = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem Char
'\0'
hasSeparator :: [Char] -> Bool
hasSeparator :: String -> Bool
hasSeparator = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
Data.List.elem Char
pathSeparatorC
isSeparator :: Char -> Bool
isSeparator :: Char -> Bool
isSeparator = 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 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 forall a b. (a -> b) -> a -> b
$ UArray Word8
a forall a. Monoid a => a -> a -> a
`mappend` UArray Word8
b
instance Monoid FileName where
mempty :: FileName
mempty = UArray Word8 -> FileName
FileName 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 -> FileName -> FilePath
join
splitPath :: FilePath
-> (PathPrefix FilePath, [PathEnt FilePath], PathSuffix FilePath)
splitPath (FilePath Relativity
r [FileName]
xs) = (Relativity
r, [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
r [PathEnt FilePath]
xs
join :: FilePath -> FileName -> FilePath
join :: FilePath -> FileName -> FilePath
join FilePath
p (FileName UArray Word8
x) | 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 forall a b. (a -> b) -> a -> b
$ forall c. Sequential c => c -> Element c -> c
snoc [FileName]
xs FileName
x
filePathToString :: FilePath -> String
filePathToString :: FilePath -> String
filePathToString (FilePath Relativity
Absolute []) = forall a. IsString a => String -> a
fromString [Char
pathSeparatorC]
filePathToString (FilePath Relativity
Relative []) = forall a. IsString a => String -> a
fromString String
"."
filePathToString (FilePath Relativity
Absolute [FileName]
fns) = forall c. Sequential c => Element c -> c -> c
cons Char
pathSeparatorC 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 = forall a. Monoid a => [a] -> a
mconcat forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> [a] -> [a]
Data.List.intersperse String
pathSeparator forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. 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)
| forall c. Collection c => c -> Bool
null UArray Word8
bs -> String
s
| Bool
otherwise -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ UArray Word8 -> FileName_Invalid
UnknownTrailingBytes UArray Word8
bs
(String
_, Just ValidationFailure
err, UArray Word8
_) -> forall a e. Exception e => e -> a
throw forall a b. (a -> b) -> a -> b
$ ValidationFailure -> FileName_Invalid
EncodingError ValidationFailure
err
fileNameToLString :: FileName -> [Char]
fileNameToLString :: FileName -> String
fileNameToLString = forall l. IsList l => l -> [Item l]
toList 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 = forall l. IsList l => l -> [Item l]
toList 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 forall c. Sequential c => (Element c -> Bool) -> c -> [c]
splitOn (\Element (UArray Word8)
c -> Element (UArray Word8)
c forall a. Eq a => a -> a -> Bool
== Word8
0x2E) UArray Word8
fn of
[] -> forall a. Maybe a
Nothing
[UArray Word8
_] -> forall a. Maybe a
Nothing
[UArray Word8]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ UArray Word8 -> FileName
FileName forall a b. (a -> b) -> a -> b
$ forall c. Sequential c => NonEmpty c -> Element c
last forall a b. (a -> b) -> a -> b
$ forall c. Collection c => c -> NonEmpty c
nonEmpty_ [UArray Word8]
xs