module System.Directory.Internal.Common where
import Prelude ()
import System.Directory.Internal.Prelude
import System.FilePath
( addTrailingPathSeparator
, hasTrailingPathSeparator
, isPathSeparator
, isRelative
, joinDrive
, joinPath
, normalise
, pathSeparator
, pathSeparators
, splitDirectories
, splitDrive
)
newtype ListT m a = ListT { forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
unListT :: m (Maybe (a, ListT m a)) }
emptyListT :: Applicative m => ListT m a
emptyListT :: forall (m :: * -> *) a. Applicative m => ListT m a
emptyListT = m (Maybe (a, ListT m a)) -> ListT m a
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (Maybe (a, ListT m a) -> m (Maybe (a, ListT m a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (a, ListT m a)
forall a. Maybe a
Nothing)
maybeToListT :: Applicative m => m (Maybe a) -> ListT m a
maybeToListT :: forall (m :: * -> *) a. Applicative m => m (Maybe a) -> ListT m a
maybeToListT m (Maybe a)
m = m (Maybe (a, ListT m a)) -> ListT m a
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (((\ a
x -> (a
x, ListT m a
forall (m :: * -> *) a. Applicative m => ListT m a
emptyListT)) (a -> (a, ListT m a)) -> Maybe a -> Maybe (a, ListT m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe a -> Maybe (a, ListT m a))
-> m (Maybe a) -> m (Maybe (a, ListT m a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe a)
m)
listToListT :: Applicative m => [a] -> ListT m a
listToListT :: forall (m :: * -> *) a. Applicative m => [a] -> ListT m a
listToListT [] = ListT m a
forall (m :: * -> *) a. Applicative m => ListT m a
emptyListT
listToListT (a
x : [a]
xs) = m (Maybe (a, ListT m a)) -> ListT m a
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (Maybe (a, ListT m a) -> m (Maybe (a, ListT m a))
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((a, ListT m a) -> Maybe (a, ListT m a)
forall a. a -> Maybe a
Just (a
x, [a] -> ListT m a
forall (m :: * -> *) a. Applicative m => [a] -> ListT m a
listToListT [a]
xs)))
liftJoinListT :: Monad m => m (ListT m a) -> ListT m a
liftJoinListT :: forall (m :: * -> *) a. Monad m => m (ListT m a) -> ListT m a
liftJoinListT m (ListT m a)
m = m (Maybe (a, ListT m a)) -> ListT m a
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT (m (ListT m a)
m m (ListT m a)
-> (ListT m a -> m (Maybe (a, ListT m a)))
-> m (Maybe (a, ListT m a))
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListT m a -> m (Maybe (a, ListT m a))
forall (m :: * -> *) a. ListT m a -> m (Maybe (a, ListT m a))
unListT)
listTHead :: Functor m => ListT m a -> m (Maybe a)
listTHead :: forall (m :: * -> *) a. Functor m => ListT m a -> m (Maybe a)
listTHead (ListT m (Maybe (a, ListT m a))
m) = ((a, ListT m a) -> a
forall a b. (a, b) -> a
fst ((a, ListT m a) -> a) -> Maybe (a, ListT m a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe (a, ListT m a) -> Maybe a)
-> m (Maybe (a, ListT m a)) -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Maybe (a, ListT m a))
m
listTToList :: Monad m => ListT m a -> m [a]
listTToList :: forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
listTToList (ListT m (Maybe (a, ListT m a))
m) = do
Maybe (a, ListT m a)
mx <- m (Maybe (a, ListT m a))
m
case Maybe (a, ListT m a)
mx of
Maybe (a, ListT m a)
Nothing -> [a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just (a
x, ListT m a
m') -> do
[a]
xs <- ListT m a -> m [a]
forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
listTToList ListT m a
m'
[a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
xs)
andM :: Monad m => m Bool -> m Bool -> m Bool
andM :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
andM m Bool
mx m Bool
my = do
Bool
x <- m Bool
mx
if Bool
x
then m Bool
my
else Bool -> m Bool
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
x
sequenceWithIOErrors_ :: [IO ()] -> IO ()
sequenceWithIOErrors_ :: [IO ()] -> IO ()
sequenceWithIOErrors_ [IO ()]
actions = Either IOError () -> [IO ()] -> IO ()
go (() -> Either IOError ()
forall a b. b -> Either a b
Right ()) [IO ()]
actions
where
go :: Either IOError () -> [IO ()] -> IO ()
go :: Either IOError () -> [IO ()] -> IO ()
go (Left IOError
e) [] = IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e
go (Right ()) [] = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
go Either IOError ()
s (IO ()
m : [IO ()]
ms) = Either IOError ()
s Either IOError () -> IO () -> IO ()
forall a b. a -> b -> b
`seq` do
Either IOError ()
r <- IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
tryIOError IO ()
m
Either IOError () -> [IO ()] -> IO ()
go (Either IOError () -> Either IOError () -> Either IOError ()
forall b a. Either b a -> Either b a -> Either b a
thenEither Either IOError ()
s Either IOError ()
r) [IO ()]
ms
thenEither :: Either b a -> Either b a -> Either b a
thenEither :: forall b a. Either b a -> Either b a -> Either b a
thenEither x :: Either b a
x@(Left b
_) Either b a
_ = Either b a
x
thenEither Either b a
_ Either b a
y = Either b a
y
tryIOErrorType :: (IOError -> Bool) -> IO a -> IO (Either IOError a)
tryIOErrorType :: forall a. (IOError -> Bool) -> IO a -> IO (Either IOError a)
tryIOErrorType IOError -> Bool
check IO a
action = do
Either IOError a
result <- IO a -> IO (Either IOError a)
forall a. IO a -> IO (Either IOError a)
tryIOError IO a
action
case Either IOError a
result of
Left IOError
err -> if IOError -> Bool
check IOError
err then Either IOError a -> IO (Either IOError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IOError -> Either IOError a
forall a b. a -> Either a b
Left IOError
err) else IOError -> IO (Either IOError a)
forall e a. Exception e => e -> IO a
throwIO IOError
err
Right a
val -> Either IOError a -> IO (Either IOError a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either IOError a
forall a b. b -> Either a b
Right a
val)
ignoreIOExceptions :: IO () -> IO ()
ignoreIOExceptions :: IO () -> IO ()
ignoreIOExceptions IO ()
io = IO ()
io IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` (\IOError
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
specializeErrorString :: String -> (IOError -> Bool) -> IO a -> IO a
specializeErrorString :: forall a. FilePath -> (IOError -> Bool) -> IO a -> IO a
specializeErrorString FilePath
str IOError -> Bool
errType IO a
action = do
Either IOError a
mx <- (IOError -> Bool) -> IO a -> IO (Either IOError a)
forall a. (IOError -> Bool) -> IO a -> IO (Either IOError a)
tryIOErrorType IOError -> Bool
errType IO a
action
case Either IOError a
mx of
Left IOError
e -> IOError -> IO a
forall e a. Exception e => e -> IO a
throwIO (IOError -> FilePath -> IOError
ioeSetErrorString IOError
e FilePath
str)
Right a
x -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
ioeAddLocation :: IOError -> String -> IOError
ioeAddLocation :: IOError -> FilePath -> IOError
ioeAddLocation IOError
e FilePath
loc = do
IOError -> FilePath -> IOError
ioeSetLocation IOError
e FilePath
newLoc
where
newLoc :: FilePath
newLoc = FilePath
loc FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
oldLoc then FilePath
"" else FilePath
":" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
oldLoc
oldLoc :: FilePath
oldLoc = IOError -> FilePath
ioeGetLocation IOError
e
expandDots :: [FilePath] -> [FilePath]
expandDots :: [FilePath] -> [FilePath]
expandDots = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath] -> [FilePath]
go []
where
go :: [FilePath] -> [FilePath] -> [FilePath]
go [FilePath]
ys' [FilePath]
xs' =
case [FilePath]
xs' of
[] -> [FilePath]
ys'
FilePath
x : [FilePath]
xs ->
case FilePath
x of
FilePath
"." -> [FilePath] -> [FilePath] -> [FilePath]
go [FilePath]
ys' [FilePath]
xs
FilePath
".." ->
case [FilePath]
ys' of
[] -> [FilePath] -> [FilePath] -> [FilePath]
go (FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
ys') [FilePath]
xs
FilePath
".." : [FilePath]
_ -> [FilePath] -> [FilePath] -> [FilePath]
go (FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
ys') [FilePath]
xs
FilePath
_ : [FilePath]
ys -> [FilePath] -> [FilePath] -> [FilePath]
go [FilePath]
ys [FilePath]
xs
FilePath
_ -> [FilePath] -> [FilePath] -> [FilePath]
go (FilePath
x FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
: [FilePath]
ys') [FilePath]
xs
normalisePathSeps :: FilePath -> FilePath
normalisePathSeps :: FilePath -> FilePath
normalisePathSeps FilePath
p = (\ Char
c -> if Char -> Bool
isPathSeparator Char
c then Char
pathSeparator else Char
c) (Char -> Char) -> FilePath -> FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
p
normaliseTrailingSep :: FilePath -> FilePath
normaliseTrailingSep :: FilePath -> FilePath
normaliseTrailingSep FilePath
path = do
let path' :: FilePath
path' = FilePath -> FilePath
forall a. [a] -> [a]
reverse FilePath
path
let (FilePath
sep, FilePath
path'') = (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Char -> Bool
isPathSeparator FilePath
path'
let addSep :: FilePath -> FilePath
addSep = if FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
sep then FilePath -> FilePath
forall a. a -> a
id else (Char
pathSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:)
FilePath -> FilePath
forall a. [a] -> [a]
reverse (FilePath -> FilePath
addSep FilePath
path'')
emptyToCurDir :: FilePath -> FilePath
emptyToCurDir :: FilePath -> FilePath
emptyToCurDir FilePath
"" = FilePath
"."
emptyToCurDir FilePath
path = FilePath
path
simplifyPosix :: FilePath -> FilePath
simplifyPosix :: FilePath -> FilePath
simplifyPosix FilePath
"" = FilePath
""
simplifyPosix FilePath
path = FilePath -> FilePath
normalise FilePath
path
simplifyWindows :: FilePath -> FilePath
simplifyWindows :: FilePath -> FilePath
simplifyWindows FilePath
"" = FilePath
""
simplifyWindows FilePath
path =
case FilePath
drive' of
FilePath
"\\\\?\\" -> FilePath
drive' FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
subpath
FilePath
_ -> FilePath
simplifiedPath
where
simplifiedPath :: FilePath
simplifiedPath = FilePath -> FilePath -> FilePath
joinDrive FilePath
drive' FilePath
subpath'
(FilePath
drive, FilePath
subpath) = FilePath -> (FilePath, FilePath)
splitDrive FilePath
path
drive' :: FilePath
drive' = FilePath -> FilePath
upperDrive (FilePath -> FilePath
normaliseTrailingSep (FilePath -> FilePath
normalisePathSeps FilePath
drive))
subpath' :: FilePath
subpath' = FilePath -> FilePath
appendSep (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
avoidEmpty (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
prependSep (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath
joinPath ([FilePath] -> FilePath)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[FilePath] -> [FilePath]
stripPardirs ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
expandDots ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
skipSeps ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
FilePath -> [FilePath]
splitDirectories (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
subpath
upperDrive :: FilePath -> FilePath
upperDrive FilePath
d = case FilePath
d of
Char
c : Char
':' : FilePath
s | Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
&& (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isPathSeparator FilePath
s -> Char -> Char
toUpper Char
c Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: Char
':' Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
: FilePath
s
FilePath
_ -> FilePath
d
skipSeps :: [FilePath] -> [FilePath]
skipSeps = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Char -> FilePath
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> FilePath) -> FilePath -> [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath
pathSeparators)))
stripPardirs :: [FilePath] -> [FilePath]
stripPardirs | Bool
pathIsAbsolute Bool -> Bool -> Bool
|| Bool
subpathIsAbsolute = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
"..")
| Bool
otherwise = [FilePath] -> [FilePath]
forall a. a -> a
id
prependSep :: FilePath -> FilePath
prependSep | Bool
subpathIsAbsolute = (Char
pathSeparator Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:)
| Bool
otherwise = FilePath -> FilePath
forall a. a -> a
id
avoidEmpty :: FilePath -> FilePath
avoidEmpty | Bool -> Bool
not Bool
pathIsAbsolute
Bool -> Bool -> Bool
&& (FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
drive Bool -> Bool -> Bool
|| Bool
hasTrailingPathSep)
= FilePath -> FilePath
emptyToCurDir
| Bool
otherwise = FilePath -> FilePath
forall a. a -> a
id
appendSep :: FilePath -> FilePath
appendSep FilePath
p | Bool
hasTrailingPathSep
Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
pathIsAbsolute Bool -> Bool -> Bool
&& FilePath -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null FilePath
p)
= FilePath -> FilePath
addTrailingPathSeparator FilePath
p
| Bool
otherwise = FilePath
p
pathIsAbsolute :: Bool
pathIsAbsolute = Bool -> Bool
not (FilePath -> Bool
isRelative FilePath
path)
subpathIsAbsolute :: Bool
subpathIsAbsolute = (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Char -> Bool
isPathSeparator (Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
take Int
1 FilePath
subpath)
hasTrailingPathSep :: Bool
hasTrailingPathSep = FilePath -> Bool
hasTrailingPathSeparator FilePath
subpath
data FileType = File
| SymbolicLink
| Directory
| DirectoryLink
deriving (FileType
FileType -> FileType -> Bounded FileType
forall a. a -> a -> Bounded a
$cminBound :: FileType
minBound :: FileType
$cmaxBound :: FileType
maxBound :: 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
$csucc :: FileType -> FileType
succ :: FileType -> FileType
$cpred :: FileType -> FileType
pred :: FileType -> FileType
$ctoEnum :: Int -> FileType
toEnum :: Int -> FileType
$cfromEnum :: FileType -> Int
fromEnum :: FileType -> Int
$cenumFrom :: FileType -> [FileType]
enumFrom :: FileType -> [FileType]
$cenumFromThen :: FileType -> FileType -> [FileType]
enumFromThen :: FileType -> FileType -> [FileType]
$cenumFromTo :: FileType -> FileType -> [FileType]
enumFromTo :: FileType -> FileType -> [FileType]
$cenumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
enumFromThenTo :: FileType -> FileType -> FileType -> [FileType]
Enum, FileType -> FileType -> Bool
(FileType -> FileType -> Bool)
-> (FileType -> FileType -> Bool) -> Eq FileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FileType -> FileType -> Bool
== :: FileType -> FileType -> Bool
$c/= :: FileType -> FileType -> Bool
/= :: 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
$ccompare :: FileType -> FileType -> Ordering
compare :: FileType -> FileType -> Ordering
$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
>= :: FileType -> FileType -> Bool
$cmax :: FileType -> FileType -> FileType
max :: FileType -> FileType -> FileType
$cmin :: FileType -> FileType -> FileType
min :: FileType -> FileType -> 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
$creadsPrec :: Int -> ReadS FileType
readsPrec :: Int -> ReadS FileType
$creadList :: ReadS [FileType]
readList :: ReadS [FileType]
$creadPrec :: ReadPrec FileType
readPrec :: ReadPrec FileType
$creadListPrec :: ReadPrec [FileType]
readListPrec :: ReadPrec [FileType]
Read, Int -> FileType -> FilePath -> FilePath
[FileType] -> FilePath -> FilePath
FileType -> FilePath
(Int -> FileType -> FilePath -> FilePath)
-> (FileType -> FilePath)
-> ([FileType] -> FilePath -> FilePath)
-> Show FileType
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> FileType -> FilePath -> FilePath
showsPrec :: Int -> FileType -> FilePath -> FilePath
$cshow :: FileType -> FilePath
show :: FileType -> FilePath
$cshowList :: [FileType] -> FilePath -> FilePath
showList :: [FileType] -> FilePath -> FilePath
Show)
fileTypeIsDirectory :: FileType -> Bool
fileTypeIsDirectory :: FileType -> Bool
fileTypeIsDirectory FileType
Directory = Bool
True
fileTypeIsDirectory FileType
DirectoryLink = Bool
True
fileTypeIsDirectory FileType
_ = Bool
False
fileTypeIsLink :: FileType -> Bool
fileTypeIsLink :: FileType -> Bool
fileTypeIsLink FileType
SymbolicLink = Bool
True
fileTypeIsLink FileType
DirectoryLink = Bool
True
fileTypeIsLink FileType
_ = Bool
False
data Permissions
= Permissions
{ Permissions -> Bool
readable :: Bool
, Permissions -> Bool
writable :: Bool
, Permissions -> Bool
executable :: Bool
, Permissions -> Bool
searchable :: Bool
} deriving (Permissions -> Permissions -> Bool
(Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool) -> Eq Permissions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Permissions -> Permissions -> Bool
== :: Permissions -> Permissions -> Bool
$c/= :: Permissions -> Permissions -> Bool
/= :: Permissions -> Permissions -> Bool
Eq, Eq Permissions
Eq Permissions
-> (Permissions -> Permissions -> Ordering)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Bool)
-> (Permissions -> Permissions -> Permissions)
-> (Permissions -> Permissions -> Permissions)
-> Ord Permissions
Permissions -> Permissions -> Bool
Permissions -> Permissions -> Ordering
Permissions -> Permissions -> Permissions
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
$ccompare :: Permissions -> Permissions -> Ordering
compare :: Permissions -> Permissions -> Ordering
$c< :: Permissions -> Permissions -> Bool
< :: Permissions -> Permissions -> Bool
$c<= :: Permissions -> Permissions -> Bool
<= :: Permissions -> Permissions -> Bool
$c> :: Permissions -> Permissions -> Bool
> :: Permissions -> Permissions -> Bool
$c>= :: Permissions -> Permissions -> Bool
>= :: Permissions -> Permissions -> Bool
$cmax :: Permissions -> Permissions -> Permissions
max :: Permissions -> Permissions -> Permissions
$cmin :: Permissions -> Permissions -> Permissions
min :: Permissions -> Permissions -> Permissions
Ord, ReadPrec [Permissions]
ReadPrec Permissions
Int -> ReadS Permissions
ReadS [Permissions]
(Int -> ReadS Permissions)
-> ReadS [Permissions]
-> ReadPrec Permissions
-> ReadPrec [Permissions]
-> Read Permissions
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Permissions
readsPrec :: Int -> ReadS Permissions
$creadList :: ReadS [Permissions]
readList :: ReadS [Permissions]
$creadPrec :: ReadPrec Permissions
readPrec :: ReadPrec Permissions
$creadListPrec :: ReadPrec [Permissions]
readListPrec :: ReadPrec [Permissions]
Read, Int -> Permissions -> FilePath -> FilePath
[Permissions] -> FilePath -> FilePath
Permissions -> FilePath
(Int -> Permissions -> FilePath -> FilePath)
-> (Permissions -> FilePath)
-> ([Permissions] -> FilePath -> FilePath)
-> Show Permissions
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> Permissions -> FilePath -> FilePath
showsPrec :: Int -> Permissions -> FilePath -> FilePath
$cshow :: Permissions -> FilePath
show :: Permissions -> FilePath
$cshowList :: [Permissions] -> FilePath -> FilePath
showList :: [Permissions] -> FilePath -> FilePath
Show)
copyFileContents :: FilePath
-> FilePath
-> IO ()
copyFileContents :: FilePath -> FilePath -> IO ()
copyFileContents FilePath
fromFPath FilePath
toFPath =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"copyFileContents") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
toFPath IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Handle
hTo ->
FilePath -> Handle -> IO ()
copyFileToHandle FilePath
fromFPath Handle
hTo
copyFileToHandle :: FilePath
-> Handle
-> IO ()
copyFileToHandle :: FilePath -> Handle -> IO ()
copyFileToHandle FilePath
fromFPath Handle
hTo =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"copyFileToHandle") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. FilePath -> IOMode -> (Handle -> IO r) -> IO r
withBinaryFile FilePath
fromFPath IOMode
ReadMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Handle
hFrom ->
Handle -> Handle -> IO ()
copyHandleData Handle
hFrom Handle
hTo
copyHandleData :: Handle
-> Handle
-> IO ()
copyHandleData :: Handle -> Handle -> IO ()
copyHandleData Handle
hFrom Handle
hTo =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"copyData") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Int -> (Ptr Any -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
bufferSize Ptr Any -> IO ()
forall {a}. Ptr a -> IO ()
go
where
bufferSize :: Int
bufferSize = Int
131072
go :: Ptr a -> IO ()
go Ptr a
buffer = do
Int
count <- Handle -> Ptr a -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
hFrom Ptr a
buffer Int
bufferSize
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Handle -> Ptr a -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
hTo Ptr a
buffer Int
count
Ptr a -> IO ()
go Ptr a
buffer
data XdgDirectory
= XdgData
| XdgConfig
| XdgCache
| XdgState
deriving (XdgDirectory
XdgDirectory -> XdgDirectory -> Bounded XdgDirectory
forall a. a -> a -> Bounded a
$cminBound :: XdgDirectory
minBound :: XdgDirectory
$cmaxBound :: XdgDirectory
maxBound :: XdgDirectory
Bounded, Int -> XdgDirectory
XdgDirectory -> Int
XdgDirectory -> [XdgDirectory]
XdgDirectory -> XdgDirectory
XdgDirectory -> XdgDirectory -> [XdgDirectory]
XdgDirectory -> XdgDirectory -> XdgDirectory -> [XdgDirectory]
(XdgDirectory -> XdgDirectory)
-> (XdgDirectory -> XdgDirectory)
-> (Int -> XdgDirectory)
-> (XdgDirectory -> Int)
-> (XdgDirectory -> [XdgDirectory])
-> (XdgDirectory -> XdgDirectory -> [XdgDirectory])
-> (XdgDirectory -> XdgDirectory -> [XdgDirectory])
-> (XdgDirectory -> XdgDirectory -> XdgDirectory -> [XdgDirectory])
-> Enum XdgDirectory
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: XdgDirectory -> XdgDirectory
succ :: XdgDirectory -> XdgDirectory
$cpred :: XdgDirectory -> XdgDirectory
pred :: XdgDirectory -> XdgDirectory
$ctoEnum :: Int -> XdgDirectory
toEnum :: Int -> XdgDirectory
$cfromEnum :: XdgDirectory -> Int
fromEnum :: XdgDirectory -> Int
$cenumFrom :: XdgDirectory -> [XdgDirectory]
enumFrom :: XdgDirectory -> [XdgDirectory]
$cenumFromThen :: XdgDirectory -> XdgDirectory -> [XdgDirectory]
enumFromThen :: XdgDirectory -> XdgDirectory -> [XdgDirectory]
$cenumFromTo :: XdgDirectory -> XdgDirectory -> [XdgDirectory]
enumFromTo :: XdgDirectory -> XdgDirectory -> [XdgDirectory]
$cenumFromThenTo :: XdgDirectory -> XdgDirectory -> XdgDirectory -> [XdgDirectory]
enumFromThenTo :: XdgDirectory -> XdgDirectory -> XdgDirectory -> [XdgDirectory]
Enum, XdgDirectory -> XdgDirectory -> Bool
(XdgDirectory -> XdgDirectory -> Bool)
-> (XdgDirectory -> XdgDirectory -> Bool) -> Eq XdgDirectory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XdgDirectory -> XdgDirectory -> Bool
== :: XdgDirectory -> XdgDirectory -> Bool
$c/= :: XdgDirectory -> XdgDirectory -> Bool
/= :: XdgDirectory -> XdgDirectory -> Bool
Eq, Eq XdgDirectory
Eq XdgDirectory
-> (XdgDirectory -> XdgDirectory -> Ordering)
-> (XdgDirectory -> XdgDirectory -> Bool)
-> (XdgDirectory -> XdgDirectory -> Bool)
-> (XdgDirectory -> XdgDirectory -> Bool)
-> (XdgDirectory -> XdgDirectory -> Bool)
-> (XdgDirectory -> XdgDirectory -> XdgDirectory)
-> (XdgDirectory -> XdgDirectory -> XdgDirectory)
-> Ord XdgDirectory
XdgDirectory -> XdgDirectory -> Bool
XdgDirectory -> XdgDirectory -> Ordering
XdgDirectory -> XdgDirectory -> XdgDirectory
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
$ccompare :: XdgDirectory -> XdgDirectory -> Ordering
compare :: XdgDirectory -> XdgDirectory -> Ordering
$c< :: XdgDirectory -> XdgDirectory -> Bool
< :: XdgDirectory -> XdgDirectory -> Bool
$c<= :: XdgDirectory -> XdgDirectory -> Bool
<= :: XdgDirectory -> XdgDirectory -> Bool
$c> :: XdgDirectory -> XdgDirectory -> Bool
> :: XdgDirectory -> XdgDirectory -> Bool
$c>= :: XdgDirectory -> XdgDirectory -> Bool
>= :: XdgDirectory -> XdgDirectory -> Bool
$cmax :: XdgDirectory -> XdgDirectory -> XdgDirectory
max :: XdgDirectory -> XdgDirectory -> XdgDirectory
$cmin :: XdgDirectory -> XdgDirectory -> XdgDirectory
min :: XdgDirectory -> XdgDirectory -> XdgDirectory
Ord, ReadPrec [XdgDirectory]
ReadPrec XdgDirectory
Int -> ReadS XdgDirectory
ReadS [XdgDirectory]
(Int -> ReadS XdgDirectory)
-> ReadS [XdgDirectory]
-> ReadPrec XdgDirectory
-> ReadPrec [XdgDirectory]
-> Read XdgDirectory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS XdgDirectory
readsPrec :: Int -> ReadS XdgDirectory
$creadList :: ReadS [XdgDirectory]
readList :: ReadS [XdgDirectory]
$creadPrec :: ReadPrec XdgDirectory
readPrec :: ReadPrec XdgDirectory
$creadListPrec :: ReadPrec [XdgDirectory]
readListPrec :: ReadPrec [XdgDirectory]
Read, Int -> XdgDirectory -> FilePath -> FilePath
[XdgDirectory] -> FilePath -> FilePath
XdgDirectory -> FilePath
(Int -> XdgDirectory -> FilePath -> FilePath)
-> (XdgDirectory -> FilePath)
-> ([XdgDirectory] -> FilePath -> FilePath)
-> Show XdgDirectory
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> XdgDirectory -> FilePath -> FilePath
showsPrec :: Int -> XdgDirectory -> FilePath -> FilePath
$cshow :: XdgDirectory -> FilePath
show :: XdgDirectory -> FilePath
$cshowList :: [XdgDirectory] -> FilePath -> FilePath
showList :: [XdgDirectory] -> FilePath -> FilePath
Show)
data XdgDirectoryList
= XdgDataDirs
| XdgConfigDirs
deriving (XdgDirectoryList
XdgDirectoryList -> XdgDirectoryList -> Bounded XdgDirectoryList
forall a. a -> a -> Bounded a
$cminBound :: XdgDirectoryList
minBound :: XdgDirectoryList
$cmaxBound :: XdgDirectoryList
maxBound :: XdgDirectoryList
Bounded, Int -> XdgDirectoryList
XdgDirectoryList -> Int
XdgDirectoryList -> [XdgDirectoryList]
XdgDirectoryList -> XdgDirectoryList
XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList]
XdgDirectoryList
-> XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList]
(XdgDirectoryList -> XdgDirectoryList)
-> (XdgDirectoryList -> XdgDirectoryList)
-> (Int -> XdgDirectoryList)
-> (XdgDirectoryList -> Int)
-> (XdgDirectoryList -> [XdgDirectoryList])
-> (XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList])
-> (XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList])
-> (XdgDirectoryList
-> XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList])
-> Enum XdgDirectoryList
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: XdgDirectoryList -> XdgDirectoryList
succ :: XdgDirectoryList -> XdgDirectoryList
$cpred :: XdgDirectoryList -> XdgDirectoryList
pred :: XdgDirectoryList -> XdgDirectoryList
$ctoEnum :: Int -> XdgDirectoryList
toEnum :: Int -> XdgDirectoryList
$cfromEnum :: XdgDirectoryList -> Int
fromEnum :: XdgDirectoryList -> Int
$cenumFrom :: XdgDirectoryList -> [XdgDirectoryList]
enumFrom :: XdgDirectoryList -> [XdgDirectoryList]
$cenumFromThen :: XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList]
enumFromThen :: XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList]
$cenumFromTo :: XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList]
enumFromTo :: XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList]
$cenumFromThenTo :: XdgDirectoryList
-> XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList]
enumFromThenTo :: XdgDirectoryList
-> XdgDirectoryList -> XdgDirectoryList -> [XdgDirectoryList]
Enum, XdgDirectoryList -> XdgDirectoryList -> Bool
(XdgDirectoryList -> XdgDirectoryList -> Bool)
-> (XdgDirectoryList -> XdgDirectoryList -> Bool)
-> Eq XdgDirectoryList
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: XdgDirectoryList -> XdgDirectoryList -> Bool
== :: XdgDirectoryList -> XdgDirectoryList -> Bool
$c/= :: XdgDirectoryList -> XdgDirectoryList -> Bool
/= :: XdgDirectoryList -> XdgDirectoryList -> Bool
Eq, Eq XdgDirectoryList
Eq XdgDirectoryList
-> (XdgDirectoryList -> XdgDirectoryList -> Ordering)
-> (XdgDirectoryList -> XdgDirectoryList -> Bool)
-> (XdgDirectoryList -> XdgDirectoryList -> Bool)
-> (XdgDirectoryList -> XdgDirectoryList -> Bool)
-> (XdgDirectoryList -> XdgDirectoryList -> Bool)
-> (XdgDirectoryList -> XdgDirectoryList -> XdgDirectoryList)
-> (XdgDirectoryList -> XdgDirectoryList -> XdgDirectoryList)
-> Ord XdgDirectoryList
XdgDirectoryList -> XdgDirectoryList -> Bool
XdgDirectoryList -> XdgDirectoryList -> Ordering
XdgDirectoryList -> XdgDirectoryList -> XdgDirectoryList
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
$ccompare :: XdgDirectoryList -> XdgDirectoryList -> Ordering
compare :: XdgDirectoryList -> XdgDirectoryList -> Ordering
$c< :: XdgDirectoryList -> XdgDirectoryList -> Bool
< :: XdgDirectoryList -> XdgDirectoryList -> Bool
$c<= :: XdgDirectoryList -> XdgDirectoryList -> Bool
<= :: XdgDirectoryList -> XdgDirectoryList -> Bool
$c> :: XdgDirectoryList -> XdgDirectoryList -> Bool
> :: XdgDirectoryList -> XdgDirectoryList -> Bool
$c>= :: XdgDirectoryList -> XdgDirectoryList -> Bool
>= :: XdgDirectoryList -> XdgDirectoryList -> Bool
$cmax :: XdgDirectoryList -> XdgDirectoryList -> XdgDirectoryList
max :: XdgDirectoryList -> XdgDirectoryList -> XdgDirectoryList
$cmin :: XdgDirectoryList -> XdgDirectoryList -> XdgDirectoryList
min :: XdgDirectoryList -> XdgDirectoryList -> XdgDirectoryList
Ord, ReadPrec [XdgDirectoryList]
ReadPrec XdgDirectoryList
Int -> ReadS XdgDirectoryList
ReadS [XdgDirectoryList]
(Int -> ReadS XdgDirectoryList)
-> ReadS [XdgDirectoryList]
-> ReadPrec XdgDirectoryList
-> ReadPrec [XdgDirectoryList]
-> Read XdgDirectoryList
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS XdgDirectoryList
readsPrec :: Int -> ReadS XdgDirectoryList
$creadList :: ReadS [XdgDirectoryList]
readList :: ReadS [XdgDirectoryList]
$creadPrec :: ReadPrec XdgDirectoryList
readPrec :: ReadPrec XdgDirectoryList
$creadListPrec :: ReadPrec [XdgDirectoryList]
readListPrec :: ReadPrec [XdgDirectoryList]
Read, Int -> XdgDirectoryList -> FilePath -> FilePath
[XdgDirectoryList] -> FilePath -> FilePath
XdgDirectoryList -> FilePath
(Int -> XdgDirectoryList -> FilePath -> FilePath)
-> (XdgDirectoryList -> FilePath)
-> ([XdgDirectoryList] -> FilePath -> FilePath)
-> Show XdgDirectoryList
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> XdgDirectoryList -> FilePath -> FilePath
showsPrec :: Int -> XdgDirectoryList -> FilePath -> FilePath
$cshow :: XdgDirectoryList -> FilePath
show :: XdgDirectoryList -> FilePath
$cshowList :: [XdgDirectoryList] -> FilePath -> FilePath
showList :: [XdgDirectoryList] -> FilePath -> FilePath
Show)