module System.Directory.Internal.Common
  ( module System.Directory.Internal.Common
  , OsPath
  , OsString
  ) where
import Prelude ()
import System.Directory.Internal.Prelude
import GHC.IO.Encoding.Failure (CodingFailureMode(TransliterateCodingFailure))
import GHC.IO.Encoding.UTF16 (mkUTF16le)
import GHC.IO.Encoding.UTF8 (mkUTF8)
import System.IO (hSetBinaryMode)
import System.OsPath
  ( OsPath
  , OsString
  , addTrailingPathSeparator
  , decodeUtf
  , decodeWith
  , encodeUtf
  , hasTrailingPathSeparator
  , isPathSeparator
  , isRelative
  , joinDrive
  , joinPath
  , normalise
  , pack
  , pathSeparator
  , pathSeparators
  , splitDirectories
  , splitDrive
  , toChar
  , unpack
  , unsafeFromChar
  )

-- | A generator with side-effects.
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 ()
s Either IOError () -> Either IOError () -> Either IOError ()
forall a b.
Either IOError a -> Either IOError b -> Either IOError b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Either IOError ()
r) [IO ()]
ms

-- | Similar to 'try' but only catches a specify kind of 'IOError' as
--   specified by the predicate.
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)

-- | Attempt to perform the given action, silencing any IO exception thrown by
-- it.
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. String -> (IOError -> Bool) -> IO a -> IO a
specializeErrorString String
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 -> String -> IOError
ioeSetErrorString IOError
e String
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 -> String -> IOError
ioeAddLocation IOError
e String
loc = do
  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 a. [a] -> 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

rightOrError :: Exception e => Either e a -> a
rightOrError :: forall e a. Exception e => Either e a -> a
rightOrError (Left e
e)  = String -> a
forall a. HasCallStack => String -> a
error (e -> String
forall e. Exception e => e -> String
displayException e
e)
rightOrError (Right a
a) = a
a

-- | Fallibly converts String to OsString. Only intended to be used on literals.
os :: String -> OsString
os :: String -> OsPath
os = Either SomeException OsPath -> OsPath
forall e a. Exception e => Either e a -> a
rightOrError (Either SomeException OsPath -> OsPath)
-> (String -> Either SomeException OsPath) -> String -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either SomeException OsPath
forall (m :: * -> *). MonadThrow m => String -> m OsPath
encodeUtf

-- | Fallibly converts OsString to String. Only intended to be used on literals.
so :: OsString -> String
so :: OsPath -> String
so = Either SomeException String -> String
forall e a. Exception e => Either e a -> a
rightOrError (Either SomeException String -> String)
-> (OsPath -> Either SomeException String) -> OsPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Either SomeException String
forall (m :: * -> *). MonadThrow m => OsPath -> m String
decodeUtf

ioeSetOsPath :: IOError -> OsPath -> IOError
ioeSetOsPath :: IOError -> OsPath -> IOError
ioeSetOsPath IOError
err =
  IOError -> String -> IOError
ioeSetFileName IOError
err (String -> IOError) -> (OsPath -> String) -> OsPath -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  Either EncodingException String -> String
forall e a. Exception e => Either e a -> a
rightOrError (Either EncodingException String -> String)
-> (OsPath -> Either EncodingException String) -> OsPath -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
  TextEncoding
-> TextEncoding -> OsPath -> Either EncodingException String
decodeWith
    (CodingFailureMode -> TextEncoding
mkUTF8 CodingFailureMode
TransliterateCodingFailure)
    (CodingFailureMode -> TextEncoding
mkUTF16le CodingFailureMode
TransliterateCodingFailure)

-- | Given a list of path segments, expand @.@ and @..@.  The path segments
-- must not contain path separators.
expandDots :: [OsPath] -> [OsPath]
expandDots :: [OsPath] -> [OsPath]
expandDots = [OsPath] -> [OsPath]
forall a. [a] -> [a]
reverse ([OsPath] -> [OsPath])
-> ([OsPath] -> [OsPath]) -> [OsPath] -> [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OsPath] -> [OsPath] -> [OsPath]
go []
  where
    go :: [OsPath] -> [OsPath] -> [OsPath]
go [OsPath]
ys' [OsPath]
xs' =
      case [OsPath]
xs' of
        [] -> [OsPath]
ys'
        OsPath
x : [OsPath]
xs
          | OsPath
x OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== String -> OsPath
os String
"." -> [OsPath] -> [OsPath] -> [OsPath]
go [OsPath]
ys' [OsPath]
xs
          | OsPath
x OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== String -> OsPath
os String
".." ->
              case [OsPath]
ys' of
                [] -> [OsPath] -> [OsPath] -> [OsPath]
go (OsPath
x OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: [OsPath]
ys') [OsPath]
xs
                OsPath
y : [OsPath]
ys
                  | OsPath
y OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== String -> OsPath
os String
".." -> [OsPath] -> [OsPath] -> [OsPath]
go (OsPath
x OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: [OsPath]
ys') [OsPath]
xs
                  | Bool
otherwise -> [OsPath] -> [OsPath] -> [OsPath]
go [OsPath]
ys [OsPath]
xs
          | Bool
otherwise -> [OsPath] -> [OsPath] -> [OsPath]
go (OsPath
x OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
: [OsPath]
ys') [OsPath]
xs

-- | Convert to the right kind of slashes.
normalisePathSeps :: OsPath -> OsPath
normalisePathSeps :: OsPath -> OsPath
normalisePathSeps OsPath
p = [OsChar] -> OsPath
pack (OsChar -> OsChar
normaliseChar (OsChar -> OsChar) -> [OsChar] -> [OsChar]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsPath -> [OsChar]
unpack OsPath
p)
  where normaliseChar :: OsChar -> OsChar
normaliseChar OsChar
c = if OsChar -> Bool
isPathSeparator OsChar
c then OsChar
pathSeparator else OsChar
c

-- | Remove redundant trailing slashes and pick the right kind of slash.
normaliseTrailingSep :: OsPath -> OsPath
normaliseTrailingSep :: OsPath -> OsPath
normaliseTrailingSep OsPath
path = do
  let path' :: [OsChar]
path' = [OsChar] -> [OsChar]
forall a. [a] -> [a]
reverse (OsPath -> [OsChar]
unpack OsPath
path)
  let ([OsChar]
sep, [OsChar]
path'') = (OsChar -> Bool) -> [OsChar] -> ([OsChar], [OsChar])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span OsChar -> Bool
isPathSeparator [OsChar]
path'
  let addSep :: [OsChar] -> [OsChar]
addSep = if [OsChar] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [OsChar]
sep then [OsChar] -> [OsChar]
forall a. a -> a
id else (OsChar
pathSeparator OsChar -> [OsChar] -> [OsChar]
forall a. a -> [a] -> [a]
:)
  [OsChar] -> OsPath
pack ([OsChar] -> [OsChar]
forall a. [a] -> [a]
reverse ([OsChar] -> [OsChar]
addSep [OsChar]
path''))

-- | Convert empty paths to the current directory, otherwise leave it
-- unchanged.
emptyToCurDir :: OsPath -> OsPath
emptyToCurDir :: OsPath -> OsPath
emptyToCurDir OsPath
path
  | OsPath
path OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== OsPath
forall a. Monoid a => a
mempty = String -> OsPath
os String
"."
  | Bool
otherwise      = OsPath
path

-- | Similar to 'normalise' but empty paths stay empty.
simplifyPosix :: OsPath -> OsPath
simplifyPosix :: OsPath -> OsPath
simplifyPosix OsPath
path
  | OsPath
path OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== OsPath
forall a. Monoid a => a
mempty = OsPath
forall a. Monoid a => a
mempty
  | Bool
otherwise      = OsPath -> OsPath
normalise OsPath
path

-- | Similar to 'normalise' but:
--
-- * empty paths stay empty,
-- * parent dirs (@..@) are expanded, and
-- * paths starting with @\\\\?\\@ are preserved.
--
-- The goal is to preserve the meaning of paths better than 'normalise'.
simplifyWindows :: OsPath -> OsPath
simplifyWindows :: OsPath -> OsPath
simplifyWindows OsPath
path
  | OsPath
path OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== OsPath
forall a. Monoid a => a
mempty         = OsPath
forall a. Monoid a => a
mempty
  | OsPath
drive' OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== String -> OsPath
os String
"\\\\?\\" = OsPath
drive' OsPath -> OsPath -> OsPath
forall a. Semigroup a => a -> a -> a
<> OsPath
subpath
  | Bool
otherwise              = OsPath
simplifiedPath
  where
    simplifiedPath :: OsPath
simplifiedPath = OsPath -> OsPath -> OsPath
joinDrive OsPath
drive' OsPath
subpath'
    (OsPath
drive, OsPath
subpath) = OsPath -> (OsPath, OsPath)
splitDrive OsPath
path
    drive' :: OsPath
drive' = OsPath -> OsPath
upperDrive (OsPath -> OsPath
normaliseTrailingSep (OsPath -> OsPath
normalisePathSeps OsPath
drive))
    subpath' :: OsPath
subpath' = OsPath -> OsPath
appendSep (OsPath -> OsPath) -> (OsPath -> OsPath) -> OsPath -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath
avoidEmpty (OsPath -> OsPath) -> (OsPath -> OsPath) -> OsPath -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath
prependSep (OsPath -> OsPath) -> (OsPath -> OsPath) -> OsPath -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OsPath] -> OsPath
joinPath ([OsPath] -> OsPath) -> (OsPath -> [OsPath]) -> OsPath -> OsPath
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               [OsPath] -> [OsPath]
stripPardirs ([OsPath] -> [OsPath])
-> (OsPath -> [OsPath]) -> OsPath -> [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OsPath] -> [OsPath]
expandDots ([OsPath] -> [OsPath])
-> (OsPath -> [OsPath]) -> OsPath -> [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [OsPath] -> [OsPath]
skipSeps ([OsPath] -> [OsPath])
-> (OsPath -> [OsPath]) -> OsPath -> [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
               OsPath -> [OsPath]
splitDirectories (OsPath -> OsPath) -> OsPath -> OsPath
forall a b. (a -> b) -> a -> b
$ OsPath
subpath

    upperDrive :: OsPath -> OsPath
upperDrive OsPath
d = case OsPath -> [OsChar]
unpack OsPath
d of
      OsChar
c : OsChar
k : [OsChar]
s
        | Char -> Bool
isAlpha (OsChar -> Char
toChar OsChar
c), OsChar -> Char
toChar OsChar
k Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
':', (OsChar -> Bool) -> [OsChar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all OsChar -> Bool
isPathSeparator [OsChar]
s ->
          -- unsafeFromChar is safe here since all characters are ASCII.
          [OsChar] -> OsPath
pack (Char -> OsChar
unsafeFromChar (Char -> Char
toUpper (OsChar -> Char
toChar OsChar
c)) OsChar -> [OsChar] -> [OsChar]
forall a. a -> [a] -> [a]
: Char -> OsChar
unsafeFromChar Char
':' OsChar -> [OsChar] -> [OsChar]
forall a. a -> [a] -> [a]
: [OsChar]
s)
      [OsChar]
_ -> OsPath
d
    skipSeps :: [OsPath] -> [OsPath]
skipSeps =
      ([OsChar] -> OsPath
pack ([OsChar] -> OsPath) -> [[OsChar]] -> [OsPath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([[OsChar]] -> [OsPath])
-> ([OsPath] -> [[OsChar]]) -> [OsPath] -> [OsPath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      ([OsChar] -> Bool) -> [[OsChar]] -> [[OsChar]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([OsChar] -> Bool) -> [OsChar] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([OsChar] -> [[OsChar]] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (OsChar -> [OsChar]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (OsChar -> [OsChar]) -> [OsChar] -> [[OsChar]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [OsChar]
pathSeparators))) ([[OsChar]] -> [[OsChar]])
-> ([OsPath] -> [[OsChar]]) -> [OsPath] -> [[OsChar]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
      (OsPath -> [OsChar]
unpack (OsPath -> [OsChar]) -> [OsPath] -> [[OsChar]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
    stripPardirs :: [OsPath] -> [OsPath]
stripPardirs | Bool
pathIsAbsolute Bool -> Bool -> Bool
|| Bool
subpathIsAbsolute = (OsPath -> Bool) -> [OsPath] -> [OsPath]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== String -> OsPath
os String
"..")
                 | Bool
otherwise = [OsPath] -> [OsPath]
forall a. a -> a
id
    prependSep :: OsPath -> OsPath
prependSep | Bool
subpathIsAbsolute = ([OsChar] -> OsPath
pack [OsChar
pathSeparator] OsPath -> OsPath -> OsPath
forall a. Semigroup a => a -> a -> a
<>)
               | Bool
otherwise = OsPath -> OsPath
forall a. a -> a
id
    avoidEmpty :: OsPath -> OsPath
avoidEmpty | Bool -> Bool
not Bool
pathIsAbsolute
               , OsPath
drive OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== OsPath
forall a. Monoid a => a
mempty Bool -> Bool -> Bool
|| Bool
hasTrailingPathSep -- prefer "C:" over "C:."
                 = OsPath -> OsPath
emptyToCurDir
               | Bool
otherwise = OsPath -> OsPath
forall a. a -> a
id
    appendSep :: OsPath -> OsPath
appendSep OsPath
p | Bool
hasTrailingPathSep, Bool -> Bool
not (Bool
pathIsAbsolute Bool -> Bool -> Bool
&& OsPath
p OsPath -> OsPath -> Bool
forall a. Eq a => a -> a -> Bool
== OsPath
forall a. Monoid a => a
mempty)
                  = OsPath -> OsPath
addTrailingPathSeparator OsPath
p
                | Bool
otherwise = OsPath
p
    pathIsAbsolute :: Bool
pathIsAbsolute = Bool -> Bool
not (OsPath -> Bool
isRelative OsPath
path)
    subpathIsAbsolute :: Bool
subpathIsAbsolute = (OsChar -> Bool) -> [OsChar] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any OsChar -> Bool
isPathSeparator (Int -> [OsChar] -> [OsChar]
forall a. Int -> [a] -> [a]
take Int
1 (OsPath -> [OsChar]
unpack OsPath
subpath))
    hasTrailingPathSep :: Bool
hasTrailingPathSep = OsPath -> Bool
hasTrailingPathSeparator OsPath
subpath

data FileType = File
              | SymbolicLink -- ^ POSIX: either file or directory link; Windows: file link
              | Directory
              | DirectoryLink -- ^ Windows only: directory link
              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 -> 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
$cshowsPrec :: Int -> FileType -> String -> String
showsPrec :: Int -> FileType -> String -> String
$cshow :: FileType -> String
show :: FileType -> String
$cshowList :: [FileType] -> String -> String
showList :: [FileType] -> String -> String
Show)

-- | Check whether the given 'FileType' is considered a directory by the
-- operating system.  This affects the choice of certain functions
-- e.g. 'System.Directory.removeDirectory' vs 'System.Directory.removeFile'.
fileTypeIsDirectory :: FileType -> Bool
fileTypeIsDirectory :: FileType -> Bool
fileTypeIsDirectory FileType
Directory     = Bool
True
fileTypeIsDirectory FileType
DirectoryLink = Bool
True
fileTypeIsDirectory FileType
_             = Bool
False

-- | Return whether the given 'FileType' is a link.
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 -> String -> String
[Permissions] -> String -> String
Permissions -> String
(Int -> Permissions -> String -> String)
-> (Permissions -> String)
-> ([Permissions] -> String -> String)
-> Show Permissions
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> Permissions -> String -> String
showsPrec :: Int -> Permissions -> String -> String
$cshow :: Permissions -> String
show :: Permissions -> String
$cshowList :: [Permissions] -> String -> String
showList :: [Permissions] -> String -> String
Show)

withBinaryHandle :: IO Handle -> (Handle -> IO r) -> IO r
withBinaryHandle :: forall r. IO Handle -> (Handle -> IO r) -> IO r
withBinaryHandle IO Handle
open = IO Handle -> (Handle -> IO ()) -> (Handle -> IO r) -> IO r
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Handle
openBinary Handle -> IO ()
hClose
  where
    openBinary :: IO Handle
openBinary = do
      Handle
h <- IO Handle
open
      Handle -> Bool -> IO ()
hSetBinaryMode Handle
h Bool
True
      Handle -> IO Handle
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Handle
h

-- | Copy data from one handle to another until end of file.
copyHandleData :: Handle                -- ^ Source handle
               -> Handle                -- ^ Destination handle
               -> IO ()
copyHandleData :: Handle -> Handle -> IO ()
copyHandleData Handle
hFrom Handle
hTo =
  (IOError -> String -> IOError
`ioeAddLocation` String
"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 -- 128 KiB, as coreutils `cp` uses as of May 2014 (see ioblksize.h)
    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

-- | Special directories for storing user-specific application data,
-- configuration, and cache files, as specified by the
-- <http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html XDG Base Directory Specification>.
--
-- Note: On Windows, 'XdgData' and 'XdgConfig' usually map to the same
-- directory.
--
-- @since 1.2.3.0
data XdgDirectory
  = XdgData
    -- ^ For data files (e.g. images).
    -- It uses the @XDG_DATA_HOME@ environment variable.
    -- On non-Windows systems, the default is @~\/.local\/share@.
    -- On Windows, the default is @%APPDATA%@
    -- (e.g. @C:\/Users\//\<user\>/\/AppData\/Roaming@).
    -- Can be considered as the user-specific equivalent of @\/usr\/share@.
  | XdgConfig
    -- ^ For configuration files.
    -- It uses the @XDG_CONFIG_HOME@ environment variable.
    -- On non-Windows systems, the default is @~\/.config@.
    -- On Windows, the default is @%APPDATA%@
    -- (e.g. @C:\/Users\//\<user\>/\/AppData\/Roaming@).
    -- Can be considered as the user-specific equivalent of @\/etc@.
  | XdgCache
    -- ^ For non-essential files (e.g. cache).
    -- It uses the @XDG_CACHE_HOME@ environment variable.
    -- On non-Windows systems, the default is @~\/.cache@.
    -- On Windows, the default is @%LOCALAPPDATA%@
    -- (e.g. @C:\/Users\//\<user\>/\/AppData\/Local@).
    -- Can be considered as the user-specific equivalent of @\/var\/cache@.
  | XdgState
   -- ^ For data that should persist between (application) restarts,
   -- but that is not important or portable enough to the user that it
   -- should be stored in 'XdgData'.
   -- It uses the @XDG_STATE_HOME@ environment variable.
   -- On non-Windows sytems, the default is @~\/.local\/state@.  On
   -- Windows, the default is @%LOCALAPPDATA%@
   -- (e.g. @C:\/Users\//\<user\>/\/AppData\/Local@).
   --
   -- @since 1.3.7.0
  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 -> String -> String
[XdgDirectory] -> String -> String
XdgDirectory -> String
(Int -> XdgDirectory -> String -> String)
-> (XdgDirectory -> String)
-> ([XdgDirectory] -> String -> String)
-> Show XdgDirectory
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> XdgDirectory -> String -> String
showsPrec :: Int -> XdgDirectory -> String -> String
$cshow :: XdgDirectory -> String
show :: XdgDirectory -> String
$cshowList :: [XdgDirectory] -> String -> String
showList :: [XdgDirectory] -> String -> String
Show)

-- | Search paths for various application data, as specified by the
-- <http://standards.freedesktop.org/basedir-spec/basedir-spec-latest.html XDG Base Directory Specification>.
--
-- The list of paths is split using 'System.FilePath.searchPathSeparator',
-- which on Windows is a semicolon.
--
-- Note: On Windows, 'XdgDataDirs' and 'XdgConfigDirs' usually yield the same
-- result.
--
-- @since 1.3.2.0
data XdgDirectoryList
  = XdgDataDirs
    -- ^ For data files (e.g. images).
    -- It uses the @XDG_DATA_DIRS@ environment variable.
    -- On non-Windows systems, the default is @\/usr\/local\/share\/@ and
    -- @\/usr\/share\/@.
    -- On Windows, the default is @%PROGRAMDATA%@ or @%ALLUSERSPROFILE%@
    -- (e.g. @C:\/ProgramData@).
  | XdgConfigDirs
    -- ^ For configuration files.
    -- It uses the @XDG_CONFIG_DIRS@ environment variable.
    -- On non-Windows systems, the default is @\/etc\/xdg@.
    -- On Windows, the default is @%PROGRAMDATA%@ or @%ALLUSERSPROFILE%@
    -- (e.g. @C:\/ProgramData@).
  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 -> String -> String
[XdgDirectoryList] -> String -> String
XdgDirectoryList -> String
(Int -> XdgDirectoryList -> String -> String)
-> (XdgDirectoryList -> String)
-> ([XdgDirectoryList] -> String -> String)
-> Show XdgDirectoryList
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> XdgDirectoryList -> String -> String
showsPrec :: Int -> XdgDirectoryList -> String -> String
$cshow :: XdgDirectoryList -> String
show :: XdgDirectoryList -> String
$cshowList :: [XdgDirectoryList] -> String -> String
showList :: [XdgDirectoryList] -> String -> String
Show)