module RawFilePath.Directory.Internal where

import RawFilePath.Import

import qualified System.Posix.ByteString as U

ioeAddLocation :: IOError -> String -> IOError
ioeAddLocation :: IOError -> String -> IOError
ioeAddLocation IOError
e String
loc = IOError -> String -> IOError
ioeSetLocation IOError
e String
newLoc
  where
    newLoc :: String
newLoc = String
loc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
oldLoc then String
"" else String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
oldLoc
    oldLoc :: String
oldLoc = IOError -> String
ioeGetLocation IOError
e

data FileType
    = File
    | SymbolicLink
    | Directory
    | DirectoryLink
    deriving (FileType
FileType -> FileType -> Bounded FileType
forall a. a -> a -> Bounded a
maxBound :: FileType
$cmaxBound :: FileType
minBound :: FileType
$cminBound :: FileType
Bounded, Int -> FileType
FileType -> Int
FileType -> [FileType]
FileType -> FileType
FileType -> FileType -> [FileType]
FileType -> FileType -> FileType -> [FileType]
(FileType -> FileType)
-> (FileType -> FileType)
-> (Int -> FileType)
-> (FileType -> Int)
-> (FileType -> [FileType])
-> (FileType -> FileType -> [FileType])
-> (FileType -> FileType -> [FileType])
-> (FileType -> FileType -> FileType -> [FileType])
-> Enum FileType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
$cenumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
enumFromTo :: FileType -> FileType -> [FileType]
$cenumFromTo :: FileType -> FileType -> [FileType]
enumFromThen :: FileType -> FileType -> [FileType]
$cenumFromThen :: FileType -> FileType -> [FileType]
enumFrom :: FileType -> [FileType]
$cenumFrom :: FileType -> [FileType]
fromEnum :: FileType -> Int
$cfromEnum :: FileType -> Int
toEnum :: Int -> FileType
$ctoEnum :: Int -> FileType
pred :: FileType -> FileType
$cpred :: FileType -> FileType
succ :: FileType -> FileType
$csucc :: FileType -> FileType
Enum, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c== :: FileType -> FileType -> Bool
Eq, Eq FileType
Eq FileType
-> (FileType -> FileType -> Ordering)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool)
-> (FileType -> FileType -> FileType)
-> (FileType -> FileType -> FileType)
-> Ord FileType
FileType -> FileType -> Bool
FileType -> FileType -> Ordering
FileType -> FileType -> FileType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmax :: FileType -> FileType -> FileType
>= :: FileType -> FileType -> Bool
$c>= :: FileType -> FileType -> Bool
> :: FileType -> FileType -> Bool
$c> :: FileType -> FileType -> Bool
<= :: FileType -> FileType -> Bool
$c<= :: FileType -> FileType -> Bool
< :: FileType -> FileType -> Bool
$c< :: FileType -> FileType -> Bool
compare :: FileType -> FileType -> Ordering
$ccompare :: FileType -> FileType -> Ordering
$cp1Ord :: Eq FileType
Ord, ReadPrec [FileType]
ReadPrec FileType
Int -> ReadS FileType
ReadS [FileType]
(Int -> ReadS FileType)
-> ReadS [FileType]
-> ReadPrec FileType
-> ReadPrec [FileType]
-> Read FileType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FileType]
$creadListPrec :: ReadPrec [FileType]
readPrec :: ReadPrec FileType
$creadPrec :: ReadPrec FileType
readList :: ReadS [FileType]
$creadList :: ReadS [FileType]
readsPrec :: Int -> ReadS FileType
$creadsPrec :: Int -> ReadS FileType
Read, Int -> FileType -> String -> String
[FileType] -> String -> String
FileType -> String
(Int -> FileType -> String -> String)
-> (FileType -> String)
-> ([FileType] -> String -> String)
-> Show FileType
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [FileType] -> String -> String
$cshowList :: [FileType] -> String -> String
show :: FileType -> String
$cshow :: FileType -> String
showsPrec :: Int -> FileType -> String -> String
$cshowsPrec :: Int -> FileType -> String -> String
Show)

fileTypeFromMetadata :: U.FileStatus -> FileType
fileTypeFromMetadata :: FileStatus -> FileType
fileTypeFromMetadata FileStatus
stat
  | FileStatus -> Bool
U.isSymbolicLink FileStatus
stat = FileType
SymbolicLink
  | FileStatus -> Bool
U.isDirectory FileStatus
stat = FileType
Directory
  | Bool
otherwise = FileType
File