{-# LINE 1 "System/Directory/Internal/Posix.hsc" #-}
module System.Directory.Internal.Posix where
{-# LINE 4 "System/Directory/Internal/Posix.hsc" #-}
{-# LINE 5 "System/Directory/Internal/Posix.hsc" #-}
{-# LINE 7 "System/Directory/Internal/Posix.hsc" #-}
import Prelude ()
import System.Directory.Internal.Prelude
{-# LINE 10 "System/Directory/Internal/Posix.hsc" #-}
import System.Directory.Internal.C_utimensat
{-# LINE 12 "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.OsPath ((</>), encodeFS, isRelative, splitSearchPath)
import System.OsString.Internal.Types (OsString(OsString, getOsString))
import qualified Data.Time.Clock.POSIX as POSIXTime
import qualified System.Posix.Directory.PosixPath as Posix
import qualified System.Posix.Env.PosixString as Posix
import qualified System.Posix.Files.PosixString as Posix
import qualified System.Posix.IO.PosixString as Posix
import qualified System.Posix.PosixPath.FilePath as Posix
import qualified System.Posix.Types as Posix
import qualified System.Posix.User as Posix
createDirectoryInternal :: OsPath -> IO ()
createDirectoryInternal :: OsString -> IO ()
createDirectoryInternal (OsString PlatformString
path) = PlatformString -> FileMode -> IO ()
Posix.createDirectory PlatformString
path FileMode
0o777
removePathInternal :: Bool -> OsPath -> IO ()
removePathInternal :: Bool -> OsString -> IO ()
removePathInternal Bool
True = PlatformString -> IO ()
Posix.removeDirectory (PlatformString -> IO ())
-> (OsString -> PlatformString) -> OsString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> PlatformString
getOsString
removePathInternal Bool
False = PlatformString -> IO ()
Posix.removeLink (PlatformString -> IO ())
-> (OsString -> PlatformString) -> OsString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> PlatformString
getOsString
renamePathInternal :: OsPath -> OsPath -> IO ()
renamePathInternal :: OsString -> OsString -> IO ()
renamePathInternal (OsString PlatformString
p1) (OsString PlatformString
p2) = PlatformString -> PlatformString -> IO ()
Posix.rename PlatformString
p1 PlatformString
p2
filesAlwaysRemovable :: Bool
filesAlwaysRemovable :: Bool
filesAlwaysRemovable = Bool
True
simplify :: OsPath -> OsPath
simplify :: OsString -> OsString
simplify = OsString -> OsString
simplifyPosix
foreign import ccall unsafe "free" c_free :: Ptr a -> IO ()
c_PATH_MAX :: Maybe Int
{-# LINE 52 "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 55 "System/Directory/Internal/Posix.hsc" #-}
maxValue = maxBound `asTypeInMaybe` c_PATH_MAX
asTypeInMaybe :: a -> Maybe a -> a
asTypeInMaybe = const
{-# LINE 61 "System/Directory/Internal/Posix.hsc" #-}
{-# LINE 68 "System/Directory/Internal/Posix.hsc" #-}
foreign import ccall "realpath" c_realpath :: CString -> CString -> IO CString
{-# LINE 72 "System/Directory/Internal/Posix.hsc" #-}
withRealpath :: CString -> (CString -> IO a) -> IO a
withRealpath :: forall a. CString -> (CString -> IO a) -> IO a
withRealpath CString
path CString -> IO a
action = case Maybe Int
c_PATH_MAX of
Maybe Int
Nothing ->
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 ->
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
+ 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
>=> CString -> IO a
action)
where realpath :: CString -> IO CString
realpath = String -> IO CString -> IO CString
forall a. String -> IO (Ptr a) -> IO (Ptr a)
throwErrnoIfNull String
"" (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
realPath :: OsPath -> IO OsPath
realPath :: OsString -> IO OsString
realPath (OsString PlatformString
path') =
PlatformString -> (CString -> IO OsString) -> IO OsString
forall a. PlatformString -> (CString -> IO a) -> IO a
Posix.withFilePath PlatformString
path'
(CString -> (CString -> IO OsString) -> IO OsString
forall a. CString -> (CString -> IO a) -> IO a
`withRealpath` ((PlatformString -> OsString
OsString (PlatformString -> OsString) -> IO PlatformString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PlatformString -> IO OsString)
-> (CString -> IO PlatformString) -> CString -> IO OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CString -> IO PlatformString
Posix.peekFilePath))
canonicalizePathSimplify :: OsPath -> IO OsPath
canonicalizePathSimplify :: OsString -> IO OsString
canonicalizePathSimplify = OsString -> IO OsString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
findExecutablesLazyInternal :: ([OsPath] -> OsString -> ListT IO OsPath)
-> OsString
-> ListT IO OsPath
findExecutablesLazyInternal :: ([OsString] -> OsString -> ListT IO OsString)
-> OsString -> ListT IO OsString
findExecutablesLazyInternal [OsString] -> OsString -> ListT IO OsString
findExecutablesInDirectoriesLazy OsString
binary =
IO (ListT IO OsString) -> ListT IO OsString
forall (m :: * -> *) a. Monad m => m (ListT m a) -> ListT m a
liftJoinListT (IO (ListT IO OsString) -> ListT IO OsString)
-> IO (ListT IO OsString) -> ListT IO OsString
forall a b. (a -> b) -> a -> b
$ do
[OsString]
path <- IO [OsString]
getPath
ListT IO OsString -> IO (ListT IO OsString)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OsString] -> OsString -> ListT IO OsString
findExecutablesInDirectoriesLazy [OsString]
path OsString
binary)
exeExtensionInternal :: OsString
exeExtensionInternal :: OsString
exeExtensionInternal = OsString
exeExtension
getDirectoryContentsInternal :: OsPath -> IO [OsPath]
getDirectoryContentsInternal :: OsString -> IO [OsString]
getDirectoryContentsInternal (OsString PlatformString
path) =
IO DirStream
-> (DirStream -> IO ())
-> (DirStream -> IO [OsString])
-> IO [OsString]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket
(PlatformString -> IO DirStream
Posix.openDirStream PlatformString
path)
DirStream -> IO ()
Posix.closeDirStream
DirStream -> IO [OsString]
start
where
start :: DirStream -> IO [OsString]
start DirStream
dirp = ([OsString] -> [OsString]) -> IO [OsString]
forall {c}. ([OsString] -> c) -> IO c
loop [OsString] -> [OsString]
forall a. a -> a
id
where
loop :: ([OsString] -> c) -> IO c
loop [OsString] -> c
acc = do
PlatformString
e <- DirStream -> IO PlatformString
Posix.readDirStream DirStream
dirp
if PlatformString
e PlatformString -> PlatformString -> Bool
forall a. Eq a => a -> a -> Bool
== PlatformString
forall a. Monoid a => a
mempty
then c -> IO c
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OsString] -> c
acc [])
else ([OsString] -> c) -> IO c
loop ([OsString] -> c
acc ([OsString] -> c) -> ([OsString] -> [OsString]) -> [OsString] -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PlatformString -> OsString
OsString PlatformString
e OsString -> [OsString] -> [OsString]
forall a. a -> [a] -> [a]
:))
getCurrentDirectoryInternal :: IO OsPath
getCurrentDirectoryInternal :: IO OsString
getCurrentDirectoryInternal = PlatformString -> OsString
OsString (PlatformString -> OsString) -> IO PlatformString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO PlatformString
Posix.getWorkingDirectory
prependCurrentDirectory :: OsPath -> IO OsPath
prependCurrentDirectory :: OsString -> IO OsString
prependCurrentDirectory OsString
path
| OsString -> Bool
isRelative OsString
path =
((IOError -> String -> IOError
`ioeAddLocation` String
"prependCurrentDirectory") (IOError -> IOError) -> (IOError -> IOError) -> IOError -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(IOError -> OsString -> IOError
`ioeSetOsPath` OsString
path)) (IOError -> IOError) -> IO OsString -> IO OsString
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
(OsString -> OsString -> OsString
</> OsString
path) (OsString -> OsString) -> IO OsString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO OsString
getCurrentDirectoryInternal
| Bool
otherwise = OsString -> IO OsString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
path
setCurrentDirectoryInternal :: OsPath -> IO ()
setCurrentDirectoryInternal :: OsString -> IO ()
setCurrentDirectoryInternal = PlatformString -> IO ()
Posix.changeWorkingDirectory (PlatformString -> IO ())
-> (OsString -> PlatformString) -> OsString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> PlatformString
getOsString
linkToDirectoryIsDirectory :: Bool
linkToDirectoryIsDirectory :: Bool
linkToDirectoryIsDirectory = Bool
False
createHardLink :: OsPath -> OsPath -> IO ()
createHardLink :: OsString -> OsString -> IO ()
createHardLink (OsString PlatformString
p1) (OsString PlatformString
p2) = PlatformString -> PlatformString -> IO ()
Posix.createLink PlatformString
p1 PlatformString
p2
createSymbolicLink :: Bool -> OsPath -> OsPath -> IO ()
createSymbolicLink :: Bool -> OsString -> OsString -> IO ()
createSymbolicLink Bool
_ (OsString PlatformString
p1) (OsString PlatformString
p2) =
PlatformString -> PlatformString -> IO ()
Posix.createSymbolicLink PlatformString
p1 PlatformString
p2
readSymbolicLink :: OsPath -> IO OsPath
readSymbolicLink :: OsString -> IO OsString
readSymbolicLink = (PlatformString -> OsString
OsString (PlatformString -> OsString) -> IO PlatformString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (IO PlatformString -> IO OsString)
-> (OsString -> IO PlatformString) -> OsString -> IO OsString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PlatformString -> IO PlatformString
Posix.readSymbolicLink (PlatformString -> IO PlatformString)
-> (OsString -> PlatformString) -> OsString -> IO PlatformString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> PlatformString
getOsString
type Metadata = Posix.FileStatus
getSymbolicLinkMetadata :: OsPath -> IO Metadata
getSymbolicLinkMetadata :: OsString -> IO Metadata
getSymbolicLinkMetadata = PlatformString -> IO Metadata
Posix.getSymbolicLinkStatus (PlatformString -> IO Metadata)
-> (OsString -> PlatformString) -> OsString -> IO Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> PlatformString
getOsString
getFileMetadata :: OsPath -> IO Metadata
getFileMetadata :: OsString -> IO Metadata
getFileMetadata = PlatformString -> IO Metadata
Posix.getFileStatus (PlatformString -> IO Metadata)
-> (OsString -> PlatformString) -> OsString -> IO Metadata
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> PlatformString
getOsString
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
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
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
.|.
FileMode
Posix.groupWriteMode FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|.
FileMode
Posix.otherWriteMode
hasWriteMode :: Mode -> Bool
hasWriteMode :: FileMode -> Bool
hasWriteMode FileMode
m = FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.&. FileMode
allWriteMode FileMode -> FileMode -> Bool
forall a. Eq a => a -> a -> Bool
/= 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
.&. FileMode -> FileMode
forall a. Bits a => a -> a
complement FileMode
allWriteMode
setWriteMode Bool
True FileMode
m = FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
allWriteMode
setFileMode :: OsPath -> Mode -> IO ()
setFileMode :: OsString -> FileMode -> IO ()
setFileMode = PlatformString -> FileMode -> IO ()
Posix.setFileMode (PlatformString -> FileMode -> IO ())
-> (OsString -> PlatformString) -> OsString -> FileMode -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsString -> PlatformString
getOsString
setFilePermissions :: OsPath -> Mode -> IO ()
setFilePermissions :: OsString -> FileMode -> IO ()
setFilePermissions = OsString -> FileMode -> IO ()
setFileMode
getAccessPermissions :: OsPath -> IO Permissions
getAccessPermissions :: OsString -> IO Permissions
getAccessPermissions OsString
path = do
Metadata
m <- OsString -> IO Metadata
getFileMetadata OsString
path
let isDir :: Bool
isDir = FileType -> Bool
fileTypeIsDirectory (Metadata -> FileType
fileTypeFromMetadata Metadata
m)
let OsString PlatformString
path' = OsString
path
Bool
r <- PlatformString -> Bool -> Bool -> Bool -> IO Bool
Posix.fileAccess PlatformString
path' Bool
True Bool
False Bool
False
Bool
w <- PlatformString -> Bool -> Bool -> Bool -> IO Bool
Posix.fileAccess PlatformString
path' Bool
False Bool
True Bool
False
Bool
x <- PlatformString -> Bool -> Bool -> Bool -> IO Bool
Posix.fileAccess PlatformString
path' Bool
False Bool
False Bool
True
Permissions -> IO Permissions
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 :: OsPath -> Permissions -> IO ()
setAccessPermissions :: OsString -> Permissions -> IO ()
setAccessPermissions OsString
path (Permissions Bool
r Bool
w Bool
e Bool
s) = do
Metadata
m <- OsString -> IO Metadata
getFileMetadata OsString
path
OsString -> FileMode -> IO ()
setFileMode OsString
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
.&. FileMode -> FileMode
forall a. Bits a => a -> a
complement FileMode
b
modifyBit Bool
True FileMode
b FileMode
m = FileMode
m FileMode -> FileMode -> FileMode
forall a. Bits a => a -> a -> a
.|. FileMode
b
copyOwnerFromStatus :: Posix.FileStatus -> OsPath -> IO ()
copyOwnerFromStatus :: Metadata -> OsString -> IO ()
copyOwnerFromStatus Metadata
st (OsString PlatformString
dst) = do
PlatformString -> UserID -> GroupID -> IO ()
Posix.setOwnerAndGroup PlatformString
dst (Metadata -> UserID
Posix.fileOwner Metadata
st) (-GroupID
1)
copyGroupFromStatus :: Posix.FileStatus -> OsPath -> IO ()
copyGroupFromStatus :: Metadata -> OsString -> IO ()
copyGroupFromStatus Metadata
st (OsString PlatformString
dst) = do
PlatformString -> UserID -> GroupID -> IO ()
Posix.setOwnerAndGroup PlatformString
dst (-UserID
1) (Metadata -> GroupID
Posix.fileGroup Metadata
st)
tryCopyOwnerAndGroupFromStatus :: Posix.FileStatus -> OsPath -> IO ()
tryCopyOwnerAndGroupFromStatus :: Metadata -> OsString -> IO ()
tryCopyOwnerAndGroupFromStatus Metadata
st OsString
dst = do
IO () -> IO ()
ignoreIOExceptions (Metadata -> OsString -> IO ()
copyOwnerFromStatus Metadata
st OsString
dst)
IO () -> IO ()
ignoreIOExceptions (Metadata -> OsString -> IO ()
copyGroupFromStatus Metadata
st OsString
dst)
defaultFlags :: Posix.OpenFileFlags
defaultFlags :: OpenFileFlags
defaultFlags =
OpenFileFlags
Posix.defaultFileFlags
{ Posix.noctty = True
, Posix.nonBlock = True
, Posix.cloexec = True
}
openFileForRead :: OsPath -> IO Handle
openFileForRead :: OsString -> IO Handle
openFileForRead (OsString PlatformString
p) =
Fd -> IO Handle
Posix.fdToHandle (Fd -> IO Handle) -> IO Fd -> IO Handle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PlatformString -> OpenMode -> OpenFileFlags -> IO Fd
Posix.openFd PlatformString
p OpenMode
Posix.ReadOnly OpenFileFlags
defaultFlags
openFileForWrite :: OsPath -> IO Handle
openFileForWrite :: OsString -> IO Handle
openFileForWrite (OsString PlatformString
p) =
Fd -> IO Handle
Posix.fdToHandle (Fd -> IO Handle) -> IO Fd -> IO Handle
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
PlatformString -> OpenMode -> OpenFileFlags -> IO Fd
Posix.openFd PlatformString
p OpenMode
Posix.WriteOnly
OpenFileFlags
defaultFlags { Posix.creat = Just 0o666, Posix.trunc = True }
copyFileContents :: OsPath
-> OsPath
-> IO ()
copyFileContents :: OsString -> OsString -> IO ()
copyFileContents OsString
fromFPath OsString
toFPath =
(IOError -> String -> IOError
`ioeAddLocation` String
"copyFileContents") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
IO Handle -> (Handle -> IO ()) -> IO ()
forall r. IO Handle -> (Handle -> IO r) -> IO r
withBinaryHandle (OsString -> IO Handle
openFileForWrite OsString
toFPath) ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Handle
hTo -> do
IO Handle -> (Handle -> IO ()) -> IO ()
forall r. IO Handle -> (Handle -> IO r) -> IO r
withBinaryHandle (OsString -> IO Handle
openFileForRead OsString
fromFPath) ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Handle
hFrom -> do
Handle -> Handle -> IO ()
copyHandleData Handle
hFrom Handle
hTo
copyFileWithMetadataInternal :: (Metadata -> OsPath -> IO ())
-> (Metadata -> OsPath -> IO ())
-> OsPath
-> OsPath
-> IO ()
copyFileWithMetadataInternal :: (Metadata -> OsString -> IO ())
-> (Metadata -> OsString -> IO ()) -> OsString -> OsString -> IO ()
copyFileWithMetadataInternal Metadata -> OsString -> IO ()
copyPermissionsFromMetadata
Metadata -> OsString -> IO ()
copyTimesFromMetadata
OsString
src
OsString
dst = do
Metadata
st <- PlatformString -> IO Metadata
Posix.getFileStatus (OsString -> PlatformString
getOsString OsString
src)
OsString -> OsString -> IO ()
copyFileContents OsString
src OsString
dst
Metadata -> OsString -> IO ()
tryCopyOwnerAndGroupFromStatus Metadata
st OsString
dst
Metadata -> OsString -> IO ()
copyPermissionsFromMetadata Metadata
st OsString
dst
Metadata -> OsString -> IO ()
copyTimesFromMetadata Metadata
st OsString
dst
setTimes :: OsPath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()
setTimes :: OsString -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()
{-# LINE 294 "System/Directory/Internal/Posix.hsc" #-}
setTimes (OsString path') (atime', mtime') =
Posix.withFilePath path' $ \ path'' ->
withArray [ maybe utimeOmit toCTimeSpec atime'
, maybe utimeOmit toCTimeSpec mtime' ] $ \ times ->
Posix.throwErrnoPathIfMinus1_ "" path' $
c_utimensat c_AT_FDCWD path'' times 0
{-# LINE 311 "System/Directory/Internal/Posix.hsc" #-}
lookupEnvOs :: OsString -> IO (Maybe OsString)
lookupEnvOs :: OsString -> IO (Maybe OsString)
lookupEnvOs (OsString PlatformString
name) = (PlatformString -> OsString
OsString (PlatformString -> OsString)
-> Maybe PlatformString -> Maybe OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Maybe PlatformString -> Maybe OsString)
-> IO (Maybe PlatformString) -> IO (Maybe OsString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PlatformString -> IO (Maybe PlatformString)
Posix.getEnv PlatformString
name
getEnvOs :: OsString -> IO OsString
getEnvOs :: OsString -> IO OsString
getEnvOs OsString
name = do
Maybe OsString
env <- OsString -> IO (Maybe OsString)
lookupEnvOs OsString
name
case Maybe OsString
env of
Maybe OsString
Nothing ->
IOError -> IO OsString
forall e a. Exception e => e -> IO a
throwIO (IOError -> IO OsString) -> IOError -> IO OsString
forall a b. (a -> b) -> a -> b
$
IOErrorType -> String -> Maybe Handle -> Maybe String -> IOError
mkIOError
IOErrorType
doesNotExistErrorType
(String
"env var " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> OsString -> String
forall a. Show a => a -> String
show OsString
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" not found")
Maybe Handle
forall a. Maybe a
Nothing
Maybe String
forall a. Maybe a
Nothing
Just OsString
value -> OsString -> IO OsString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
value
getPath :: IO [OsPath]
getPath :: IO [OsString]
getPath = OsString -> [OsString]
splitSearchPath (OsString -> [OsString]) -> IO OsString -> IO [OsString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsString -> IO OsString
getEnvOs (String -> OsString
os String
"PATH")
getHomeDirectoryInternal :: IO OsPath
getHomeDirectoryInternal :: IO OsString
getHomeDirectoryInternal = do
Maybe OsString
e <- OsString -> IO (Maybe OsString)
lookupEnvOs (String -> OsString
os String
"HOME")
case Maybe OsString
e of
Just OsString
fp -> OsString -> IO OsString
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure OsString
fp
Maybe OsString
Nothing ->
String -> IO OsString
encodeFS (String -> IO OsString) -> IO String -> IO OsString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<<
UserEntry -> String
Posix.homeDirectory (UserEntry -> String) -> IO UserEntry -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(IO UserID
Posix.getEffectiveUserID IO UserID -> (UserID -> IO UserEntry) -> IO UserEntry
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UserID -> IO UserEntry
Posix.getUserEntryForID)
getXdgDirectoryFallback :: IO OsPath -> XdgDirectory -> IO OsPath
getXdgDirectoryFallback :: IO OsString -> XdgDirectory -> IO OsString
getXdgDirectoryFallback IO OsString
getHomeDirectory XdgDirectory
xdgDir = do
((OsString -> OsString) -> IO OsString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO OsString
getHomeDirectory) ((OsString -> OsString) -> IO OsString)
-> (OsString -> OsString) -> IO OsString
forall a b. (a -> b) -> a -> b
$ (OsString -> OsString -> OsString)
-> OsString -> OsString -> OsString
forall a b c. (a -> b -> c) -> b -> a -> c
flip OsString -> OsString -> OsString
(</>) (OsString -> OsString -> OsString)
-> OsString -> OsString -> OsString
forall a b. (a -> b) -> a -> b
$ case XdgDirectory
xdgDir of
XdgDirectory
XdgData -> String -> OsString
os String
".local/share"
XdgDirectory
XdgConfig -> String -> OsString
os String
".config"
XdgDirectory
XdgCache -> String -> OsString
os String
".cache"
XdgDirectory
XdgState -> String -> OsString
os String
".local/state"
getXdgDirectoryListFallback :: XdgDirectoryList -> IO [OsPath]
getXdgDirectoryListFallback :: XdgDirectoryList -> IO [OsString]
getXdgDirectoryListFallback XdgDirectoryList
xdgDirs =
[OsString] -> IO [OsString]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([OsString] -> IO [OsString]) -> [OsString] -> IO [OsString]
forall a b. (a -> b) -> a -> b
$ case XdgDirectoryList
xdgDirs of
XdgDirectoryList
XdgDataDirs -> [String -> OsString
os String
"/usr/local/share/", String -> OsString
os String
"/usr/share/"]
XdgDirectoryList
XdgConfigDirs -> [String -> OsString
os String
"/etc/xdg"]
getAppUserDataDirectoryInternal :: OsPath -> IO OsPath
getAppUserDataDirectoryInternal :: OsString -> IO OsString
getAppUserDataDirectoryInternal OsString
appName =
(\ OsString
home -> OsString
home OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> (String -> OsString
os String
"/" OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> String -> OsString
os String
"." OsString -> OsString -> OsString
forall a. Semigroup a => a -> a -> a
<> OsString
appName)) (OsString -> OsString) -> IO OsString -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO OsString
getHomeDirectoryInternal
getUserDocumentsDirectoryInternal :: IO OsPath
getUserDocumentsDirectoryInternal :: IO OsString
getUserDocumentsDirectoryInternal = IO OsString
getHomeDirectoryInternal
getTemporaryDirectoryInternal :: IO OsPath
getTemporaryDirectoryInternal :: IO OsString
getTemporaryDirectoryInternal = OsString -> Maybe OsString -> OsString
forall a. a -> Maybe a -> a
fromMaybe (String -> OsString
os String
"/tmp") (Maybe OsString -> OsString) -> IO (Maybe OsString) -> IO OsString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OsString -> IO (Maybe OsString)
lookupEnvOs (String -> OsString
os String
"TMPDIR")
{-# LINE 371 "System/Directory/Internal/Posix.hsc" #-}