{-# LINE 1 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}
module System.Directory.Internal.Posix where


{-# LINE 4 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}

{-# LINE 5 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}


{-# LINE 7 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}
import Prelude ()
import System.Directory.Internal.Prelude

{-# LINE 10 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}
import System.Directory.Internal.C_utimensat

{-# LINE 12 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}
import System.Directory.Internal.Common
import System.Directory.Internal.Config (exeExtension)
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (POSIXTime)
import System.FilePath ((</>), isRelative, splitSearchPath)
import qualified Data.Time.Clock.POSIX as POSIXTime
import qualified GHC.Foreign as GHC
import qualified System.Posix as Posix
import qualified System.Posix.User as PU

createDirectoryInternal :: FilePath -> IO ()
createDirectoryInternal :: [Char] -> IO ()
createDirectoryInternal [Char]
path = [Char] -> FileMode -> IO ()
Posix.createDirectory [Char]
path FileMode
0o777

removePathInternal :: Bool -> FilePath -> IO ()
removePathInternal :: Bool -> [Char] -> IO ()
removePathInternal Bool
True  = [Char] -> IO ()
Posix.removeDirectory
removePathInternal Bool
False = [Char] -> IO ()
Posix.removeLink

renamePathInternal :: FilePath -> FilePath -> IO ()
renamePathInternal :: [Char] -> [Char] -> IO ()
renamePathInternal = [Char] -> [Char] -> IO ()
Posix.rename

-- | On POSIX, equivalent to 'simplifyPosix'.
simplify :: FilePath -> FilePath
simplify :: [Char] -> [Char]
simplify = [Char] -> [Char]
simplifyPosix

-- we use the 'free' from the standard library here since it's not entirely
-- clear whether Haskell's 'free' corresponds to the same one
foreign import ccall unsafe "free" c_free :: Ptr a -> IO ()

c_PATH_MAX :: Maybe Int

{-# LINE 42 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}
c_PATH_MAX | c_PATH_MAX' > toInteger maxValue = Nothing
           | otherwise                        = Just (fromInteger c_PATH_MAX')
  where c_PATH_MAX' = (4096)
{-# LINE 45 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}
        maxValue = maxBound `asTypeInMaybe` c_PATH_MAX
        asTypeInMaybe :: a -> Maybe a -> a
        asTypeInMaybe = const

{-# LINE 51 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}

foreign import ccall "realpath" c_realpath :: CString -> CString -> IO CString

withRealpath :: CString -> (CString -> IO a) -> IO a
withRealpath :: CString -> (CString -> IO a) -> IO a
withRealpath CString
path CString -> IO a
action = case Maybe Int
c_PATH_MAX of
  Maybe Int
Nothing ->
    -- newer versions of POSIX support cases where the 2nd arg is NULL;
    -- hopefully that is the case here, as there is no safer way
    IO CString -> (CString -> IO ()) -> (CString -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (CString -> IO CString
realpath CString
forall a. Ptr a
nullPtr) CString -> IO ()
forall a. Ptr a -> IO ()
c_free CString -> IO a
action
  Just Int
pathMax ->
    -- allocate one extra just to be safe
    Int -> (CString -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes (Int
pathMax Int -> Int -> Int
forall a. Num a => a -> a -> a
External instance of the constraint type Num Int
+ Int
1) (CString -> IO CString
realpath (CString -> IO CString) -> (CString -> IO a) -> CString -> IO a
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
External instance of the constraint type Monad IO
>=> CString -> IO a
action)
  where realpath :: CString -> IO CString
realpath = [Char] -> IO CString -> IO CString
forall a. [Char] -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull [Char]
"" (IO CString -> IO CString)
-> (CString -> IO CString) -> CString -> IO CString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> CString -> IO CString
c_realpath CString
path

canonicalizePathWith :: ((FilePath -> IO FilePath) -> FilePath -> IO FilePath)
                     -> FilePath
                     -> IO FilePath
canonicalizePathWith :: (([Char] -> IO [Char]) -> [Char] -> IO [Char])
-> [Char] -> IO [Char]
canonicalizePathWith ([Char] -> IO [Char]) -> [Char] -> IO [Char]
attemptRealpath [Char]
path = do
  TextEncoding
encoding <- IO TextEncoding
getFileSystemEncoding
  let realpath :: [Char] -> IO [Char]
realpath [Char]
path' =
        TextEncoding -> [Char] -> (CString -> IO [Char]) -> IO [Char]
forall a. TextEncoding -> [Char] -> (CString -> IO a) -> IO a
GHC.withCString TextEncoding
encoding [Char]
path' (CString -> (CString -> IO [Char]) -> IO [Char]
forall a. CString -> (CString -> IO a) -> IO a
`withRealpath` TextEncoding -> CString -> IO [Char]
GHC.peekCString TextEncoding
encoding)
  ([Char] -> IO [Char]) -> [Char] -> IO [Char]
attemptRealpath [Char] -> IO [Char]
realpath [Char]
path

canonicalizePathSimplify :: FilePath -> IO FilePath
canonicalizePathSimplify :: [Char] -> IO [Char]
canonicalizePathSimplify = [Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure

findExecutablesLazyInternal :: ([FilePath] -> String -> ListT IO FilePath)
                            -> String
                            -> ListT IO FilePath
findExecutablesLazyInternal :: ([[Char]] -> [Char] -> ListT IO [Char])
-> [Char] -> ListT IO [Char]
findExecutablesLazyInternal [[Char]] -> [Char] -> ListT IO [Char]
findExecutablesInDirectoriesLazy [Char]
binary =
  IO (ListT IO [Char]) -> ListT IO [Char]
forall (m :: * -> *) a. Monad m => m (ListT m a) -> ListT m a
External instance of the constraint type Monad IO
liftJoinListT (IO (ListT IO [Char]) -> ListT IO [Char])
-> IO (ListT IO [Char]) -> ListT IO [Char]
forall a b. (a -> b) -> a -> b
$ do
    [[Char]]
path <- IO [[Char]]
getPath
    ListT IO [Char] -> IO (ListT IO [Char])
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure ([[Char]] -> [Char] -> ListT IO [Char]
findExecutablesInDirectoriesLazy [[Char]]
path [Char]
binary)

exeExtensionInternal :: String
exeExtensionInternal :: [Char]
exeExtensionInternal = [Char]
exeExtension

getDirectoryContentsInternal :: FilePath -> IO [FilePath]
getDirectoryContentsInternal :: [Char] -> IO [[Char]]
getDirectoryContentsInternal [Char]
path =
  IO DirStream
-> (DirStream -> IO ())
-> (DirStream -> IO [[Char]])
-> IO [[Char]]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
    ([Char] -> IO DirStream
Posix.openDirStream [Char]
path)
    DirStream -> IO ()
Posix.closeDirStream
    DirStream -> IO [[Char]]
start
  where
    start :: DirStream -> IO [[Char]]
start DirStream
dirp = ([[Char]] -> [[Char]]) -> IO [[Char]]
forall {c}. ([[Char]] -> c) -> IO c
loop [[Char]] -> [[Char]]
forall a. a -> a
id
      where
        loop :: ([[Char]] -> c) -> IO c
loop [[Char]] -> c
acc = do
          [Char]
e <- DirStream -> IO [Char]
Posix.readDirStream DirStream
dirp
          if [Char] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
External instance of the constraint type Foldable []
null [Char]
e
            then c -> IO c
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure ([[Char]] -> c
acc [])
            else ([[Char]] -> c) -> IO c
loop ([[Char]] -> c
acc ([[Char]] -> c) -> ([[Char]] -> [[Char]]) -> [[Char]] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Char]
e[Char] -> [[Char]] -> [[Char]]
forall a. a -> [a] -> [a]
:))

getCurrentDirectoryInternal :: IO FilePath
getCurrentDirectoryInternal :: IO [Char]
getCurrentDirectoryInternal = IO [Char]
Posix.getWorkingDirectory

-- | Convert a path into an absolute path.  If the given path is relative, the
-- current directory is prepended and the path may or may not be simplified.
-- If the path is already absolute, the path is returned unchanged.  The
-- function preserves the presence or absence of the trailing path separator.
--
-- If the path is already absolute, the operation never fails.  Otherwise, the
-- operation may throw exceptions.
--
-- Empty paths are treated as the current directory.
prependCurrentDirectory :: FilePath -> IO FilePath
prependCurrentDirectory :: [Char] -> IO [Char]
prependCurrentDirectory [Char]
path
  | [Char] -> Bool
isRelative [Char]
path =
    ((IOError -> [Char] -> IOError
`ioeAddLocation` [Char]
"prependCurrentDirectory") (IOError -> IOError) -> (IOError -> IOError) -> IOError -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
     (IOError -> [Char] -> IOError
`ioeSetFileName` [Char]
path)) (IOError -> IOError) -> IO [Char] -> IO [Char]
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
      ([Char] -> [Char] -> [Char]
</> [Char]
path) ([Char] -> [Char]) -> IO [Char] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> IO [Char]
getCurrentDirectoryInternal
  | Bool
otherwise = [Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure [Char]
path

setCurrentDirectoryInternal :: FilePath -> IO ()
setCurrentDirectoryInternal :: [Char] -> IO ()
setCurrentDirectoryInternal = [Char] -> IO ()
Posix.changeWorkingDirectory

linkToDirectoryIsDirectory :: Bool
linkToDirectoryIsDirectory :: Bool
linkToDirectoryIsDirectory = Bool
False

createSymbolicLink :: Bool -> FilePath -> FilePath -> IO ()
createSymbolicLink :: Bool -> [Char] -> [Char] -> IO ()
createSymbolicLink Bool
_ = [Char] -> [Char] -> IO ()
Posix.createSymbolicLink

readSymbolicLink :: FilePath -> IO FilePath
readSymbolicLink :: [Char] -> IO [Char]
readSymbolicLink = [Char] -> IO [Char]
Posix.readSymbolicLink

type Metadata = Posix.FileStatus

getSymbolicLinkMetadata :: FilePath -> IO Metadata
getSymbolicLinkMetadata :: [Char] -> IO Metadata
getSymbolicLinkMetadata = [Char] -> IO Metadata
Posix.getSymbolicLinkStatus

getFileMetadata :: FilePath -> IO Metadata
getFileMetadata :: [Char] -> IO Metadata
getFileMetadata = [Char] -> IO Metadata
Posix.getFileStatus

fileTypeFromMetadata :: Metadata -> FileType
fileTypeFromMetadata :: Metadata -> FileType
fileTypeFromMetadata Metadata
stat
  | Bool
isLink    = FileType
SymbolicLink
  | Bool
isDir     = FileType
Directory
  | Bool
otherwise = FileType
File
  where
    isLink :: Bool
isLink = Metadata -> Bool
Posix.isSymbolicLink Metadata
stat
    isDir :: Bool
isDir  = Metadata -> Bool
Posix.isDirectory Metadata
stat

fileSizeFromMetadata :: Metadata -> Integer
fileSizeFromMetadata :: Metadata -> Integer
fileSizeFromMetadata = FileOffset -> Integer
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Integer
External instance of the constraint type Integral FileOffset
fromIntegral (FileOffset -> Integer)
-> (Metadata -> FileOffset) -> Metadata -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> FileOffset
Posix.fileSize

accessTimeFromMetadata :: Metadata -> UTCTime
accessTimeFromMetadata :: Metadata -> UTCTime
accessTimeFromMetadata =
  POSIXTime -> UTCTime
POSIXTime.posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Metadata -> POSIXTime) -> Metadata -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> POSIXTime
posix_accessTimeHiRes

modificationTimeFromMetadata :: Metadata -> UTCTime
modificationTimeFromMetadata :: Metadata -> UTCTime
modificationTimeFromMetadata =
  POSIXTime -> UTCTime
POSIXTime.posixSecondsToUTCTime (POSIXTime -> UTCTime)
-> (Metadata -> POSIXTime) -> Metadata -> UTCTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> POSIXTime
posix_modificationTimeHiRes

posix_accessTimeHiRes, posix_modificationTimeHiRes
  :: Posix.FileStatus -> POSIXTime

{-# LINE 166 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}
posix_accessTimeHiRes = Posix.accessTimeHiRes
posix_modificationTimeHiRes :: Metadata -> POSIXTime
posix_modificationTimeHiRes = Metadata -> POSIXTime
Posix.modificationTimeHiRes

{-# LINE 172 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}

type Mode = Posix.FileMode

modeFromMetadata :: Metadata -> Mode
modeFromMetadata :: Metadata -> FileMode
modeFromMetadata = Metadata -> FileMode
Posix.fileMode

allWriteMode :: Posix.FileMode
allWriteMode :: FileMode
allWriteMode =
  FileMode
Posix.ownerWriteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits FileMode
.|.
  FileMode
Posix.groupWriteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits FileMode
.|.
  FileMode
Posix.otherWriteMode

hasWriteMode :: Mode -> Bool
hasWriteMode :: FileMode -> Bool
hasWriteMode FileMode
m = FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits FileMode
.&. FileMode
allWriteMode FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq FileMode
/= FileMode
0

setWriteMode :: Bool -> Mode -> Mode
setWriteMode :: Bool -> FileMode -> FileMode
setWriteMode Bool
False FileMode
m = FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits FileMode
.&. FileMode -> FileMode
forall a. Bits a => a -> a
External instance of the constraint type Bits FileMode
complement FileMode
allWriteMode
setWriteMode Bool
True  FileMode
m = FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits FileMode
.|. FileMode
allWriteMode

setFileMode :: FilePath -> Mode -> IO ()
setFileMode :: [Char] -> FileMode -> IO ()
setFileMode = [Char] -> FileMode -> IO ()
Posix.setFileMode

setFilePermissions :: FilePath -> Mode -> IO ()
setFilePermissions :: [Char] -> FileMode -> IO ()
setFilePermissions = [Char] -> FileMode -> IO ()
setFileMode

getAccessPermissions :: FilePath -> IO Permissions
getAccessPermissions :: [Char] -> IO Permissions
getAccessPermissions [Char]
path = do
  Metadata
m <- [Char] -> IO Metadata
getFileMetadata [Char]
path
  let isDir :: Bool
isDir = FileType -> Bool
fileTypeIsDirectory (Metadata -> FileType
fileTypeFromMetadata Metadata
m)
  Bool
r <- [Char] -> Bool -> Bool -> Bool -> IO Bool
Posix.fileAccess [Char]
path Bool
True  Bool
False Bool
False
  Bool
w <- [Char] -> Bool -> Bool -> Bool -> IO Bool
Posix.fileAccess [Char]
path Bool
False Bool
True  Bool
False
  Bool
x <- [Char] -> Bool -> Bool -> Bool -> IO Bool
Posix.fileAccess [Char]
path Bool
False Bool
False Bool
True
  Permissions -> IO Permissions
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure Permissions :: Bool -> Bool -> Bool -> Bool -> Permissions
Permissions
       { readable :: Bool
readable   = Bool
r
       , writable :: Bool
writable   = Bool
w
       , executable :: Bool
executable = Bool
x Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
isDir
       , searchable :: Bool
searchable = Bool
x Bool -> Bool -> Bool
&& Bool
isDir
       }

setAccessPermissions :: FilePath -> Permissions -> IO ()
setAccessPermissions :: [Char] -> Permissions -> IO ()
setAccessPermissions [Char]
path (Permissions Bool
r Bool
w Bool
e Bool
s) = do
  Metadata
m <- [Char] -> IO Metadata
getFileMetadata [Char]
path
  [Char] -> FileMode -> IO ()
setFileMode [Char]
path (Bool -> FileMode -> FileMode -> FileMode
modifyBit (Bool
e Bool -> Bool -> Bool
|| Bool
s) FileMode
Posix.ownerExecuteMode (FileMode -> FileMode)
-> (Metadata -> FileMode) -> Metadata -> FileMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Bool -> FileMode -> FileMode -> FileMode
modifyBit Bool
w FileMode
Posix.ownerWriteMode (FileMode -> FileMode)
-> (Metadata -> FileMode) -> Metadata -> FileMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Bool -> FileMode -> FileMode -> FileMode
modifyBit Bool
r FileMode
Posix.ownerReadMode (FileMode -> FileMode)
-> (Metadata -> FileMode) -> Metadata -> FileMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                    Metadata -> FileMode
modeFromMetadata (Metadata -> FileMode) -> Metadata -> FileMode
forall a b. (a -> b) -> a -> b
$ Metadata
m)
  where
    modifyBit :: Bool -> Posix.FileMode -> Posix.FileMode -> Posix.FileMode
    modifyBit :: Bool -> FileMode -> FileMode -> FileMode
modifyBit Bool
False FileMode
b FileMode
m = FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits FileMode
.&. FileMode -> FileMode
forall a. Bits a => a -> a
External instance of the constraint type Bits FileMode
complement FileMode
b
    modifyBit Bool
True  FileMode
b FileMode
m = FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
External instance of the constraint type Bits FileMode
.|. FileMode
b

copyOwnerFromStatus :: Posix.FileStatus -> FilePath -> IO ()
copyOwnerFromStatus :: Metadata -> [Char] -> IO ()
copyOwnerFromStatus Metadata
st [Char]
dst = do
  [Char] -> UserID -> GroupID -> IO ()
Posix.setOwnerAndGroup [Char]
dst (Metadata -> UserID
Posix.fileOwner Metadata
st) (-GroupID
1)

copyGroupFromStatus :: Posix.FileStatus -> FilePath -> IO ()
copyGroupFromStatus :: Metadata -> [Char] -> IO ()
copyGroupFromStatus Metadata
st [Char]
dst = do
  [Char] -> UserID -> GroupID -> IO ()
Posix.setOwnerAndGroup [Char]
dst (-UserID
1) (Metadata -> GroupID
Posix.fileGroup Metadata
st)

tryCopyOwnerAndGroupFromStatus :: Posix.FileStatus -> FilePath -> IO ()
tryCopyOwnerAndGroupFromStatus :: Metadata -> [Char] -> IO ()
tryCopyOwnerAndGroupFromStatus Metadata
st [Char]
dst = do
  IO () -> IO ()
ignoreIOExceptions (Metadata -> [Char] -> IO ()
copyOwnerFromStatus Metadata
st [Char]
dst)
  IO () -> IO ()
ignoreIOExceptions (Metadata -> [Char] -> IO ()
copyGroupFromStatus Metadata
st [Char]
dst)

copyFileWithMetadataInternal :: (Metadata -> FilePath -> IO ())
                             -> (Metadata -> FilePath -> IO ())
                             -> FilePath
                             -> FilePath
                             -> IO ()
copyFileWithMetadataInternal :: (Metadata -> [Char] -> IO ())
-> (Metadata -> [Char] -> IO ()) -> [Char] -> [Char] -> IO ()
copyFileWithMetadataInternal Metadata -> [Char] -> IO ()
copyPermissionsFromMetadata
                             Metadata -> [Char] -> IO ()
copyTimesFromMetadata
                             [Char]
src
                             [Char]
dst = do
  Metadata
st <- [Char] -> IO Metadata
Posix.getFileStatus [Char]
src
  [Char] -> [Char] -> IO ()
copyFileContents [Char]
src [Char]
dst
  Metadata -> [Char] -> IO ()
tryCopyOwnerAndGroupFromStatus Metadata
st [Char]
dst
  Metadata -> [Char] -> IO ()
copyPermissionsFromMetadata Metadata
st [Char]
dst
  Metadata -> [Char] -> IO ()
copyTimesFromMetadata Metadata
st [Char]
dst

setTimes :: FilePath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()

setTimes :: [Char] -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()
{-# LINE 253 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}
setTimes path' (atime', mtime') =
  withFilePath path' $ \ path'' ->
  withArray [ maybe utimeOmit toCTimeSpec atime'
            , maybe utimeOmit toCTimeSpec mtime' ] $ \ times ->
  throwErrnoPathIfMinus1_ "" path' $
    c_utimensat c_AT_FDCWD path'' times 0

{-# LINE 279 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}

-- | Get the contents of the @PATH@ environment variable.
getPath :: IO [FilePath]
getPath :: IO [[Char]]
getPath = [Char] -> [[Char]]
splitSearchPath ([Char] -> [[Char]]) -> IO [Char] -> IO [[Char]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> [Char] -> IO [Char]
getEnv [Char]
"PATH"

-- | $HOME is preferred, because the user has control over it. However, POSIX
-- doesn't define it as a mandatory variable, so fall back to `getpwuid_r`.
getHomeDirectoryInternal :: IO FilePath
getHomeDirectoryInternal :: IO [Char]
getHomeDirectoryInternal = do
  Maybe [Char]
e <- [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"HOME"
  case Maybe [Char]
e of
       Just [Char]
fp -> [Char] -> IO [Char]
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure [Char]
fp
       Maybe [Char]
Nothing -> UserEntry -> [Char]
PU.homeDirectory (UserEntry -> [Char]) -> IO UserEntry -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> (IO UserID
PU.getEffectiveUserID IO UserID -> (UserID -> IO UserEntry) -> IO UserEntry
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
External instance of the constraint type Monad IO
>>= UserID -> IO UserEntry
PU.getUserEntryForID)

getXdgDirectoryFallback :: IO FilePath -> XdgDirectory -> IO FilePath
getXdgDirectoryFallback :: IO [Char] -> XdgDirectory -> IO [Char]
getXdgDirectoryFallback IO [Char]
getHomeDirectory XdgDirectory
xdgDir = do
  (([Char] -> [Char]) -> IO [Char] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> IO [Char]
getHomeDirectory) (([Char] -> [Char]) -> IO [Char])
-> ([Char] -> [Char]) -> IO [Char]
forall a b. (a -> b) -> a -> b
$ ([Char] -> [Char] -> [Char]) -> [Char] -> [Char] -> [Char]
forall a b c. (a -> b -> c) -> b -> a -> c
flip [Char] -> [Char] -> [Char]
(</>) ([Char] -> [Char] -> [Char]) -> [Char] -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ case XdgDirectory
xdgDir of
    XdgDirectory
XdgData   -> [Char]
".local/share"
    XdgDirectory
XdgConfig -> [Char]
".config"
    XdgDirectory
XdgCache  -> [Char]
".cache"

getXdgDirectoryListFallback :: XdgDirectoryList -> IO [FilePath]
getXdgDirectoryListFallback :: XdgDirectoryList -> IO [[Char]]
getXdgDirectoryListFallback XdgDirectoryList
xdgDirs =
  [[Char]] -> IO [[Char]]
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type Applicative IO
pure ([[Char]] -> IO [[Char]]) -> [[Char]] -> IO [[Char]]
forall a b. (a -> b) -> a -> b
$ case XdgDirectoryList
xdgDirs of
    XdgDirectoryList
XdgDataDirs   -> [[Char]
"/usr/local/share/", [Char]
"/usr/share/"]
    XdgDirectoryList
XdgConfigDirs -> [[Char]
"/etc/xdg"]

getAppUserDataDirectoryInternal :: FilePath -> IO FilePath
getAppUserDataDirectoryInternal :: [Char] -> IO [Char]
getAppUserDataDirectoryInternal [Char]
appName =
  (\ [Char]
home -> [Char]
home [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
External instance of the constraint type forall a. Semigroup [a]
<> (Char
'/' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: Char
'.' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
appName)) ([Char] -> [Char]) -> IO [Char] -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> IO [Char]
getHomeDirectoryInternal

getUserDocumentsDirectoryInternal :: IO FilePath
getUserDocumentsDirectoryInternal :: IO [Char]
getUserDocumentsDirectoryInternal = IO [Char]
getHomeDirectoryInternal

getTemporaryDirectoryInternal :: IO FilePath
getTemporaryDirectoryInternal :: IO [Char]
getTemporaryDirectoryInternal = [Char] -> Maybe [Char] -> [Char]
forall a. a -> Maybe a -> a
fromMaybe [Char]
"/tmp" (Maybe [Char] -> [Char]) -> IO (Maybe [Char]) -> IO [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
<$> [Char] -> IO (Maybe [Char])
lookupEnv [Char]
"TMPDIR"


{-# LINE 317 "libraries/directory/System/Directory/Internal/Posix.hsc" #-}