{-# LANGUAGE CPP #-}
#if !MIN_VERSION_base(4, 8, 0)
{-# LANGUAGE Trustworthy #-}
#endif
module System.Directory
(
createDirectory
, createDirectoryIfMissing
, removeDirectory
, removeDirectoryRecursive
, removePathForcibly
, renameDirectory
, listDirectory
, getDirectoryContents
, getCurrentDirectory
, setCurrentDirectory
, withCurrentDirectory
, getHomeDirectory
, XdgDirectory(..)
, getXdgDirectory
, XdgDirectoryList(..)
, getXdgDirectoryList
, getAppUserDataDirectory
, getUserDocumentsDirectory
, getTemporaryDirectory
, removeFile
, renameFile
, renamePath
, copyFile
, copyFileWithMetadata
, getFileSize
, canonicalizePath
, makeAbsolute
, makeRelativeToCurrentDirectory
, doesPathExist
, doesFileExist
, doesDirectoryExist
, findExecutable
, findExecutables
, findExecutablesInDirectories
, findFile
, findFiles
, findFileWith
, findFilesWith
, exeExtension
, createFileLink
, createDirectoryLink
, removeDirectoryLink
, pathIsSymbolicLink
, getSymbolicLinkTarget
, Permissions
, emptyPermissions
, readable
, writable
, executable
, searchable
, setOwnerReadable
, setOwnerWritable
, setOwnerExecutable
, setOwnerSearchable
, getPermissions
, setPermissions
, copyPermissions
, getAccessTime
, getModificationTime
, setAccessTime
, setModificationTime
, isSymbolicLink
) where
import Prelude ()
import System.Directory.Internal
import System.Directory.Internal.Prelude
import System.FilePath
( (<.>)
, (</>)
, addTrailingPathSeparator
, dropTrailingPathSeparator
, hasTrailingPathSeparator
, isAbsolute
, joinPath
, makeRelative
, splitDirectories
, splitSearchPath
, takeDirectory
)
import Data.Time (UTCTime)
import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds)
emptyPermissions :: Permissions
emptyPermissions :: Permissions
emptyPermissions = Permissions {
readable :: Bool
readable = Bool
False,
writable :: Bool
writable = Bool
False,
executable :: Bool
executable = Bool
False,
searchable :: Bool
searchable = Bool
False
}
setOwnerReadable :: Bool -> Permissions -> Permissions
setOwnerReadable :: Bool -> Permissions -> Permissions
setOwnerReadable Bool
b Permissions
p = Permissions
p { readable :: Bool
readable = Bool
b }
setOwnerWritable :: Bool -> Permissions -> Permissions
setOwnerWritable :: Bool -> Permissions -> Permissions
setOwnerWritable Bool
b Permissions
p = Permissions
p { writable :: Bool
writable = Bool
b }
setOwnerExecutable :: Bool -> Permissions -> Permissions
setOwnerExecutable :: Bool -> Permissions -> Permissions
setOwnerExecutable Bool
b Permissions
p = Permissions
p { executable :: Bool
executable = Bool
b }
setOwnerSearchable :: Bool -> Permissions -> Permissions
setOwnerSearchable :: Bool -> Permissions -> Permissions
setOwnerSearchable Bool
b Permissions
p = Permissions
p { searchable :: Bool
searchable = Bool
b }
getPermissions :: FilePath -> IO Permissions
getPermissions :: FilePath -> IO Permissions
getPermissions FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getPermissions") (IOError -> IOError) -> IO Permissions -> IO Permissions
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> IO Permissions
getAccessPermissions (FilePath -> FilePath
emptyToCurDir FilePath
path)
setPermissions :: FilePath -> Permissions -> IO ()
setPermissions :: FilePath -> Permissions -> IO ()
setPermissions FilePath
path Permissions
p =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"setPermissions") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> Permissions -> IO ()
setAccessPermissions (FilePath -> FilePath
emptyToCurDir FilePath
path) Permissions
p
copyPermissions :: FilePath -> FilePath -> IO ()
copyPermissions :: FilePath -> FilePath -> IO ()
copyPermissions FilePath
src FilePath
dst =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"copyPermissions") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Metadata
m <- FilePath -> IO Metadata
getFileMetadata FilePath
src
Metadata -> FilePath -> IO ()
copyPermissionsFromMetadata Metadata
m FilePath
dst
copyPermissionsFromMetadata :: Metadata -> FilePath -> IO ()
copyPermissionsFromMetadata :: Metadata -> FilePath -> IO ()
copyPermissionsFromMetadata Metadata
m FilePath
dst = do
FilePath -> Mode -> IO ()
setFilePermissions FilePath
dst (Metadata -> Mode
modeFromMetadata Metadata
m)
createDirectory :: FilePath -> IO ()
createDirectory :: FilePath -> IO ()
createDirectory = FilePath -> IO ()
createDirectoryInternal
createDirectoryIfMissing :: Bool
-> FilePath
-> IO ()
createDirectoryIfMissing :: Bool -> FilePath -> IO ()
createDirectoryIfMissing Bool
create_parents FilePath
path0
| Bool
create_parents = [FilePath] -> IO ()
createDirs (FilePath -> [FilePath]
parents FilePath
path0)
| Bool
otherwise = [FilePath] -> IO ()
createDirs (Int -> [FilePath] -> [FilePath]
forall a. Int -> [a] -> [a]
take Int
1 (FilePath -> [FilePath]
parents FilePath
path0))
where
parents :: FilePath -> [FilePath]
parents = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 FilePath -> FilePath -> FilePath
(</>) ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories (FilePath -> [FilePath])
-> (FilePath -> FilePath) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
simplify
createDirs :: [FilePath] -> IO ()
createDirs [] = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
createDirs (FilePath
dir:[]) = FilePath -> (IOError -> IO ()) -> IO ()
createDir FilePath
dir IOError -> IO ()
forall a. IOError -> IO a
ioError
createDirs (FilePath
dir:[FilePath]
dirs) =
FilePath -> (IOError -> IO ()) -> IO ()
createDir FilePath
dir ((IOError -> IO ()) -> IO ()) -> (IOError -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IOError
_ -> do
[FilePath] -> IO ()
createDirs [FilePath]
dirs
FilePath -> (IOError -> IO ()) -> IO ()
createDir FilePath
dir IOError -> IO ()
forall a. IOError -> IO a
ioError
createDir :: FilePath -> (IOError -> IO ()) -> IO ()
createDir FilePath
dir IOError -> IO ()
notExistHandler = do
Either IOError ()
r <- IO () -> IO (Either IOError ())
forall a. IO a -> IO (Either IOError a)
tryIOError (FilePath -> IO ()
createDirectory FilePath
dir)
case Either IOError ()
r of
Right () -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Left IOError
e
| IOError -> Bool
isDoesNotExistError IOError
e -> IOError -> IO ()
notExistHandler IOError
e
| IOError -> Bool
isAlreadyExistsError IOError
e
Bool -> Bool -> Bool
|| IOError -> Bool
isPermissionError IOError
e -> do
Bool
canIgnore <- FilePath -> IO Bool
pathIsDirectory FilePath
dir
IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \ IOError
_ ->
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (IOError -> Bool
isAlreadyExistsError IOError
e)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
canIgnore (IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e)
| Bool
otherwise -> IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
e
removeDirectory :: FilePath -> IO ()
removeDirectory :: FilePath -> IO ()
removeDirectory = Bool -> FilePath -> IO ()
removePathInternal Bool
True
removeDirectoryRecursive :: FilePath -> IO ()
removeDirectoryRecursive :: FilePath -> IO ()
removeDirectoryRecursive FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"removeDirectoryRecursive") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Metadata
m <- FilePath -> IO Metadata
getSymbolicLinkMetadata FilePath
path
case Metadata -> FileType
fileTypeFromMetadata Metadata
m of
FileType
Directory ->
FilePath -> IO ()
removeContentsRecursive FilePath
path
FileType
DirectoryLink ->
IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError
err IOError -> FilePath -> IOError
`ioeSetErrorString` FilePath
"is a directory symbolic link")
FileType
_ ->
IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError
err IOError -> FilePath -> IOError
`ioeSetErrorString` FilePath
"not a directory")
where err :: IOError
err = IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError IOErrorType
InappropriateType FilePath
"" Maybe Handle
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
removePathRecursive :: FilePath -> IO ()
removePathRecursive :: FilePath -> IO ()
removePathRecursive FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"removePathRecursive") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Metadata
m <- FilePath -> IO Metadata
getSymbolicLinkMetadata FilePath
path
case Metadata -> FileType
fileTypeFromMetadata Metadata
m of
FileType
Directory -> FilePath -> IO ()
removeContentsRecursive FilePath
path
FileType
DirectoryLink -> FilePath -> IO ()
removeDirectory FilePath
path
FileType
_ -> FilePath -> IO ()
removeFile FilePath
path
removeContentsRecursive :: FilePath -> IO ()
removeContentsRecursive :: FilePath -> IO ()
removeContentsRecursive FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"removeContentsRecursive") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
[FilePath]
cont <- FilePath -> IO [FilePath]
listDirectory FilePath
path
(FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ FilePath -> IO ()
removePathRecursive [FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
x | FilePath
x <- [FilePath]
cont]
FilePath -> IO ()
removeDirectory FilePath
path
removePathForcibly :: FilePath -> IO ()
removePathForcibly :: FilePath -> IO ()
removePathForcibly FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"removePathForcibly") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> IO ()
makeRemovable FilePath
path 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 ()
IO () -> IO ()
ignoreDoesNotExistError (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
Metadata
m <- FilePath -> IO Metadata
getSymbolicLinkMetadata FilePath
path
case Metadata -> FileType
fileTypeFromMetadata Metadata
m of
FileType
DirectoryLink -> FilePath -> IO ()
removeDirectory FilePath
path
FileType
Directory -> do
[FilePath]
names <- FilePath -> IO [FilePath]
listDirectory FilePath
path
[IO ()] -> IO ()
sequenceWithIOErrors_ ([IO ()] -> IO ()) -> [IO ()] -> IO ()
forall a b. (a -> b) -> a -> b
$
[ FilePath -> IO ()
removePathForcibly (FilePath
path FilePath -> FilePath -> FilePath
</> FilePath
name) | FilePath
name <- [FilePath]
names ] [IO ()] -> [IO ()] -> [IO ()]
forall a. [a] -> [a] -> [a]
++
[ FilePath -> IO ()
removeDirectory FilePath
path ]
FileType
_ -> FilePath -> IO ()
removeFile FilePath
path
where
ignoreDoesNotExistError :: IO () -> IO ()
ignoreDoesNotExistError :: IO () -> IO ()
ignoreDoesNotExistError IO ()
action =
() () -> IO (Either IOError ()) -> IO ()
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ (IOError -> Bool) -> IO () -> IO (Either IOError ())
forall a. (IOError -> Bool) -> IO a -> IO (Either IOError a)
tryIOErrorType IOError -> Bool
isDoesNotExistError IO ()
action
makeRemovable :: FilePath -> IO ()
makeRemovable :: FilePath -> IO ()
makeRemovable FilePath
p = do
Permissions
perms <- FilePath -> IO Permissions
getPermissions FilePath
p
FilePath -> Permissions -> IO ()
setPermissions FilePath
path Permissions
perms{ readable :: Bool
readable = Bool
True
, searchable :: Bool
searchable = Bool
True
, writable :: Bool
writable = Bool
True }
removeFile :: FilePath -> IO ()
removeFile :: FilePath -> IO ()
removeFile = Bool -> FilePath -> IO ()
removePathInternal Bool
False
renameDirectory :: FilePath -> FilePath -> IO ()
renameDirectory :: FilePath -> FilePath -> IO ()
renameDirectory FilePath
opath FilePath
npath =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"renameDirectory") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Bool
isDir <- FilePath -> IO Bool
pathIsDirectory FilePath
opath
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not Bool
isDir) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> (IOError -> IOError) -> IOError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOError -> FilePath -> IOError
`ioeSetErrorString` FilePath
"not a directory") (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$
(IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError IOErrorType
InappropriateType FilePath
"renameDirectory" Maybe Handle
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
opath))
FilePath -> FilePath -> IO ()
renamePath FilePath
opath FilePath
npath
renameFile :: FilePath -> FilePath -> IO ()
renameFile :: FilePath -> FilePath -> IO ()
renameFile FilePath
opath FilePath
npath =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"renameFile") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> IO ()
checkNotDir FilePath
opath
FilePath -> FilePath -> IO ()
renamePath FilePath
opath FilePath
npath
IO () -> (IOError -> IO ()) -> IO ()
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \ IOError
err -> do
FilePath -> IO ()
checkNotDir FilePath
npath
IOError -> IO ()
forall a. IOError -> IO a
ioError IOError
err
where checkNotDir :: FilePath -> IO ()
checkNotDir FilePath
path = do
Either IOError Metadata
m <- IO Metadata -> IO (Either IOError Metadata)
forall a. IO a -> IO (Either IOError a)
tryIOError (FilePath -> IO Metadata
getSymbolicLinkMetadata FilePath
path)
case FileType -> Bool
fileTypeIsDirectory (FileType -> Bool) -> (Metadata -> FileType) -> Metadata -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> FileType
fileTypeFromMetadata (Metadata -> Bool)
-> Either IOError Metadata -> Either IOError Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either IOError Metadata
m of
Right Bool
True -> IOError -> IO ()
forall a. IOError -> IO a
ioError (IOError -> IO ()) -> (IOError -> IOError) -> IOError -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (IOError -> FilePath -> IOError
`ioeSetErrorString` FilePath
"is a directory") (IOError -> IO ()) -> IOError -> IO ()
forall a b. (a -> b) -> a -> b
$
IOErrorType
-> FilePath -> Maybe Handle -> Maybe FilePath -> IOError
mkIOError IOErrorType
InappropriateType FilePath
"" Maybe Handle
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
path)
Either IOError Bool
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
renamePath :: FilePath
-> FilePath
-> IO ()
renamePath :: FilePath -> FilePath -> IO ()
renamePath FilePath
opath FilePath
npath =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"renamePath") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> FilePath -> IO ()
renamePathInternal FilePath
opath FilePath
npath
copyFile :: FilePath
-> FilePath
-> IO ()
copyFile :: FilePath -> FilePath -> IO ()
copyFile FilePath
fromFPath FilePath
toFPath =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"copyFile") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> FilePath -> (FilePath -> IO ()) -> IO ()
atomicCopyFileContents FilePath
fromFPath FilePath
toFPath
(IO () -> IO ()
ignoreIOExceptions (IO () -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
copyPermissions FilePath
fromFPath)
atomicCopyFileContents :: FilePath
-> FilePath
-> (FilePath -> IO ())
-> IO ()
atomicCopyFileContents :: FilePath -> FilePath -> (FilePath -> IO ()) -> IO ()
atomicCopyFileContents FilePath
fromFPath FilePath
toFPath FilePath -> IO ()
postAction =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"atomicCopyFileContents") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> (FilePath -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a.
FilePath -> (FilePath -> IO ()) -> (Handle -> IO a) -> IO a
withReplacementFile FilePath
toFPath FilePath -> IO ()
postAction ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Handle
hTo -> do
FilePath -> Handle -> IO ()
copyFileToHandle FilePath
fromFPath Handle
hTo
withReplacementFile :: FilePath
-> (FilePath -> IO ())
-> (Handle -> IO a)
-> IO a
withReplacementFile :: forall a.
FilePath -> (FilePath -> IO ()) -> (Handle -> IO a) -> IO a
withReplacementFile FilePath
path FilePath -> IO ()
postAction Handle -> IO a
action =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"withReplacementFile") (IOError -> IOError) -> IO a -> IO a
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
((forall a. IO a -> IO a) -> IO a) -> IO a
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO a) -> IO a)
-> ((forall a. IO a -> IO a) -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ forall a. IO a -> IO a
restore -> do
(FilePath
tmpFPath, Handle
hTmp) <- FilePath -> FilePath -> IO (FilePath, Handle)
openBinaryTempFile (FilePath -> FilePath
takeDirectory FilePath
path)
FilePath
".copyFile.tmp"
(IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` IO () -> IO ()
ignoreIOExceptions (FilePath -> IO ()
removeFile FilePath
tmpFPath)) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
a
r <- (IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
`onException` IO () -> IO ()
ignoreIOExceptions (Handle -> IO ()
hClose Handle
hTmp)) (IO a -> IO a) -> IO a -> IO a
forall a b. (a -> b) -> a -> b
$ do
IO a -> IO a
forall a. IO a -> IO a
restore (Handle -> IO a
action Handle
hTmp)
Handle -> IO ()
hClose Handle
hTmp
IO () -> IO ()
forall a. IO a -> IO a
restore (FilePath -> IO ()
postAction FilePath
tmpFPath)
FilePath -> FilePath -> IO ()
renameFile FilePath
tmpFPath FilePath
path
a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
copyFileWithMetadata :: FilePath
-> FilePath
-> IO ()
copyFileWithMetadata :: FilePath -> FilePath -> IO ()
copyFileWithMetadata FilePath
src FilePath
dst =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"copyFileWithMetadata") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError`
(Metadata -> FilePath -> IO ())
-> (Metadata -> FilePath -> IO ()) -> FilePath -> FilePath -> IO ()
copyFileWithMetadataInternal Metadata -> FilePath -> IO ()
copyPermissionsFromMetadata
Metadata -> FilePath -> IO ()
copyTimesFromMetadata
FilePath
src
FilePath
dst
copyTimesFromMetadata :: Metadata -> FilePath -> IO ()
copyTimesFromMetadata :: Metadata -> FilePath -> IO ()
copyTimesFromMetadata Metadata
st FilePath
dst = do
let atime :: UTCTime
atime = Metadata -> UTCTime
accessTimeFromMetadata Metadata
st
let mtime :: UTCTime
mtime = Metadata -> UTCTime
modificationTimeFromMetadata Metadata
st
FilePath -> (Maybe UTCTime, Maybe UTCTime) -> IO ()
setFileTimes FilePath
dst (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
atime, UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
mtime)
canonicalizePath :: FilePath -> IO FilePath
canonicalizePath :: FilePath -> IO FilePath
canonicalizePath = \ FilePath
path ->
((IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"canonicalizePath") (IOError -> IOError) -> (IOError -> IOError) -> IOError -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(IOError -> FilePath -> IOError
`ioeSetFileName` FilePath
path)) (IOError -> IOError) -> IO FilePath -> IO FilePath
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> FilePath
dropTrailingPathSeparator (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
simplify (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(((FilePath -> IO FilePath) -> FilePath -> IO FilePath)
-> FilePath -> IO FilePath
canonicalizePathWith (FilePath -> IO FilePath) -> FilePath -> IO FilePath
attemptRealpath (FilePath -> IO FilePath) -> IO FilePath -> IO FilePath
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< FilePath -> IO FilePath
prependCurrentDirectory FilePath
path)
where
attemptRealpath :: (FilePath -> IO FilePath) -> FilePath -> IO FilePath
attemptRealpath FilePath -> IO FilePath
realpath =
Int
-> Maybe FilePath
-> (FilePath -> IO FilePath)
-> FilePath
-> IO FilePath
forall {a}.
(Ord a, Num a) =>
a
-> Maybe FilePath
-> (FilePath -> IO FilePath)
-> FilePath
-> IO FilePath
attemptRealpathWith (Int
64 :: Int) Maybe FilePath
forall a. Maybe a
Nothing FilePath -> IO FilePath
realpath
(FilePath -> IO FilePath)
-> (FilePath -> IO FilePath) -> FilePath -> IO FilePath
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< FilePath -> IO FilePath
canonicalizePathSimplify
attemptRealpathWith :: a
-> Maybe FilePath
-> (FilePath -> IO FilePath)
-> FilePath
-> IO FilePath
attemptRealpathWith a
n Maybe FilePath
mFallback FilePath -> IO FilePath
realpath FilePath
path =
case Maybe FilePath
mFallback of
Just FilePath
fallback | a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
<= a
0 -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
fallback
Maybe FilePath
_ -> [(FilePath, FilePath)] -> IO FilePath
realpathPrefix ([(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
prefixes [FilePath]
suffixes))
where
segments :: [FilePath]
segments = FilePath -> [FilePath]
splitDirectories FilePath
path
prefixes :: [FilePath]
prefixes = (FilePath -> FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a. (a -> a -> a) -> [a] -> [a]
scanl1 FilePath -> FilePath -> FilePath
(</>) [FilePath]
segments
suffixes :: [FilePath]
suffixes = [FilePath] -> [FilePath]
forall a. HasCallStack => [a] -> [a]
tail ((FilePath -> FilePath -> FilePath)
-> FilePath -> [FilePath] -> [FilePath]
forall a b. (a -> b -> b) -> b -> [a] -> [b]
scanr FilePath -> FilePath -> FilePath
(</>) FilePath
"" [FilePath]
segments)
realpathPrefix :: [(FilePath, FilePath)] -> IO FilePath
realpathPrefix [(FilePath, FilePath)]
candidates =
case [(FilePath, FilePath)]
candidates of
[] -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
path
(FilePath
prefix, FilePath
suffix) : [(FilePath, FilePath)]
rest -> do
Bool
exist <- FilePath -> IO Bool
doesPathExist FilePath
prefix
if Bool -> Bool
not Bool
exist
then [(FilePath, FilePath)] -> IO FilePath
realpathPrefix [(FilePath, FilePath)]
rest
else do
Either IOError FilePath
mp <- IO FilePath -> IO (Either IOError FilePath)
forall a. IO a -> IO (Either IOError a)
tryIOError (FilePath -> IO FilePath
realpath FilePath
prefix)
case Either IOError FilePath
mp of
Left IOError
_ -> [(FilePath, FilePath)] -> IO FilePath
realpathPrefix [(FilePath, FilePath)]
rest
Right FilePath
p -> FilePath -> FilePath -> FilePath -> IO FilePath
realpathFurther (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
suffix) FilePath
p FilePath
suffix
realpathFurther :: FilePath -> FilePath -> FilePath -> IO FilePath
realpathFurther FilePath
fallback FilePath
p FilePath
suffix =
case FilePath -> [FilePath]
splitDirectories FilePath
suffix of
[] -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
fallback
FilePath
next : [FilePath]
restSuffix -> do
Either IOError FilePath
mTarget <- IO FilePath -> IO (Either IOError FilePath)
forall a. IO a -> IO (Either IOError a)
tryIOError (FilePath -> IO FilePath
getSymbolicLinkTarget (FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
next))
case Either IOError FilePath
mTarget of
Left IOError
_ -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
fallback
Right FilePath
target -> do
let mFallback' :: Maybe FilePath
mFallback' = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath -> FilePath
forall a. a -> Maybe a -> a
fromMaybe FilePath
fallback Maybe FilePath
mFallback)
FilePath
path' <- FilePath -> IO FilePath
canonicalizePathSimplify
(FilePath
p FilePath -> FilePath -> FilePath
</> FilePath
target FilePath -> FilePath -> FilePath
</> [FilePath] -> FilePath
joinPath [FilePath]
restSuffix)
a
-> Maybe FilePath
-> (FilePath -> IO FilePath)
-> FilePath
-> IO FilePath
attemptRealpathWith (a
n a -> a -> a
forall a. Num a => a -> a -> a
- a
1) Maybe FilePath
mFallback' FilePath -> IO FilePath
realpath FilePath
path'
makeAbsolute :: FilePath -> IO FilePath
makeAbsolute :: FilePath -> IO FilePath
makeAbsolute FilePath
path =
((IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"makeAbsolute") (IOError -> IOError) -> (IOError -> IOError) -> IOError -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(IOError -> FilePath -> IOError
`ioeSetFileName` FilePath
path)) (IOError -> IOError) -> IO FilePath -> IO FilePath
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> FilePath -> FilePath
matchTrailingSeparator FilePath
path (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
simplify (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
prependCurrentDirectory FilePath
path
matchTrailingSeparator :: FilePath -> FilePath -> FilePath
matchTrailingSeparator :: FilePath -> FilePath -> FilePath
matchTrailingSeparator FilePath
path
| FilePath -> Bool
hasTrailingPathSeparator FilePath
path = FilePath -> FilePath
addTrailingPathSeparator
| Bool
otherwise = FilePath -> FilePath
dropTrailingPathSeparator
makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
makeRelativeToCurrentDirectory :: FilePath -> IO FilePath
makeRelativeToCurrentDirectory FilePath
x = do
(FilePath -> FilePath -> FilePath
`makeRelative` FilePath
x) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
getCurrentDirectory
findExecutable :: String -> IO (Maybe FilePath)
findExecutable :: FilePath -> IO (Maybe FilePath)
findExecutable FilePath
binary =
ListT IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Functor m => ListT m a -> m (Maybe a)
listTHead
(([FilePath] -> FilePath -> ListT IO FilePath)
-> FilePath -> ListT IO FilePath
findExecutablesLazyInternal [FilePath] -> FilePath -> ListT IO FilePath
findExecutablesInDirectoriesLazy FilePath
binary)
findExecutables :: String -> IO [FilePath]
findExecutables :: FilePath -> IO [FilePath]
findExecutables FilePath
binary =
ListT IO FilePath -> IO [FilePath]
forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
listTToList
(([FilePath] -> FilePath -> ListT IO FilePath)
-> FilePath -> ListT IO FilePath
findExecutablesLazyInternal [FilePath] -> FilePath -> ListT IO FilePath
findExecutablesInDirectoriesLazy FilePath
binary)
findExecutablesInDirectories :: [FilePath] -> String -> IO [FilePath]
findExecutablesInDirectories :: [FilePath] -> FilePath -> IO [FilePath]
findExecutablesInDirectories [FilePath]
path FilePath
binary =
ListT IO FilePath -> IO [FilePath]
forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
listTToList ([FilePath] -> FilePath -> ListT IO FilePath
findExecutablesInDirectoriesLazy [FilePath]
path FilePath
binary)
findExecutablesInDirectoriesLazy :: [FilePath] -> String -> ListT IO FilePath
findExecutablesInDirectoriesLazy :: [FilePath] -> FilePath -> ListT IO FilePath
findExecutablesInDirectoriesLazy [FilePath]
path FilePath
binary =
(FilePath -> IO Bool)
-> [FilePath] -> FilePath -> ListT IO FilePath
findFilesWithLazy FilePath -> IO Bool
isExecutable [FilePath]
path (FilePath
binary FilePath -> FilePath -> FilePath
<.> FilePath
exeExtension)
isExecutable :: FilePath -> IO Bool
isExecutable :: FilePath -> IO Bool
isExecutable FilePath
file = Permissions -> Bool
executable (Permissions -> Bool) -> IO Permissions -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Permissions
getPermissions FilePath
file
findFile :: [FilePath] -> String -> IO (Maybe FilePath)
findFile :: [FilePath] -> FilePath -> IO (Maybe FilePath)
findFile = (FilePath -> IO Bool)
-> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileWith (\ FilePath
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
findFiles :: [FilePath] -> String -> IO [FilePath]
findFiles :: [FilePath] -> FilePath -> IO [FilePath]
findFiles = (FilePath -> IO Bool) -> [FilePath] -> FilePath -> IO [FilePath]
findFilesWith (\ FilePath
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
findFileWith :: (FilePath -> IO Bool) -> [FilePath] -> String -> IO (Maybe FilePath)
findFileWith :: (FilePath -> IO Bool)
-> [FilePath] -> FilePath -> IO (Maybe FilePath)
findFileWith FilePath -> IO Bool
f [FilePath]
ds FilePath
name = ListT IO FilePath -> IO (Maybe FilePath)
forall (m :: * -> *) a. Functor m => ListT m a -> m (Maybe a)
listTHead ((FilePath -> IO Bool)
-> [FilePath] -> FilePath -> ListT IO FilePath
findFilesWithLazy FilePath -> IO Bool
f [FilePath]
ds FilePath
name)
findFilesWith :: (FilePath -> IO Bool) -> [FilePath] -> String -> IO [FilePath]
findFilesWith :: (FilePath -> IO Bool) -> [FilePath] -> FilePath -> IO [FilePath]
findFilesWith FilePath -> IO Bool
f [FilePath]
ds FilePath
name = ListT IO FilePath -> IO [FilePath]
forall (m :: * -> *) a. Monad m => ListT m a -> m [a]
listTToList ((FilePath -> IO Bool)
-> [FilePath] -> FilePath -> ListT IO FilePath
findFilesWithLazy FilePath -> IO Bool
f [FilePath]
ds FilePath
name)
findFilesWithLazy
:: (FilePath -> IO Bool) -> [FilePath] -> String -> ListT IO FilePath
findFilesWithLazy :: (FilePath -> IO Bool)
-> [FilePath] -> FilePath -> ListT IO FilePath
findFilesWithLazy FilePath -> IO Bool
f [FilePath]
dirs FilePath
path
| FilePath -> Bool
isAbsolute FilePath
path = IO (Maybe (FilePath, ListT IO FilePath)) -> ListT IO FilePath
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT ([FilePath] -> IO (Maybe (FilePath, ListT IO FilePath))
find [FilePath
""])
| Bool
otherwise = IO (Maybe (FilePath, ListT IO FilePath)) -> ListT IO FilePath
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT ([FilePath] -> IO (Maybe (FilePath, ListT IO FilePath))
find [FilePath]
dirs)
where
find :: [FilePath] -> IO (Maybe (FilePath, ListT IO FilePath))
find [] = Maybe (FilePath, ListT IO FilePath)
-> IO (Maybe (FilePath, ListT IO FilePath))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (FilePath, ListT IO FilePath)
forall a. Maybe a
Nothing
find (FilePath
d : [FilePath]
ds) = do
let p :: FilePath
p = FilePath
d FilePath -> FilePath -> FilePath
</> FilePath
path
Bool
found <- FilePath -> IO Bool
doesFileExist FilePath
p IO Bool -> IO Bool -> IO Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
`andM` FilePath -> IO Bool
f FilePath
p
if Bool
found
then Maybe (FilePath, ListT IO FilePath)
-> IO (Maybe (FilePath, ListT IO FilePath))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FilePath, ListT IO FilePath)
-> Maybe (FilePath, ListT IO FilePath)
forall a. a -> Maybe a
Just (FilePath
p, IO (Maybe (FilePath, ListT IO FilePath)) -> ListT IO FilePath
forall (m :: * -> *) a. m (Maybe (a, ListT m a)) -> ListT m a
ListT ([FilePath] -> IO (Maybe (FilePath, ListT IO FilePath))
find [FilePath]
ds)))
else [FilePath] -> IO (Maybe (FilePath, ListT IO FilePath))
find [FilePath]
ds
exeExtension :: String
exeExtension :: FilePath
exeExtension = FilePath
exeExtensionInternal
getDirectoryContents :: FilePath -> IO [FilePath]
getDirectoryContents :: FilePath -> IO [FilePath]
getDirectoryContents FilePath
path =
((IOError -> FilePath -> IOError
`ioeSetFileName` FilePath
path) (IOError -> IOError) -> (IOError -> IOError) -> IOError -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getDirectoryContents")) (IOError -> IOError) -> IO [FilePath] -> IO [FilePath]
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> IO [FilePath]
getDirectoryContentsInternal FilePath
path
listDirectory :: FilePath -> IO [FilePath]
listDirectory :: FilePath -> IO [FilePath]
listDirectory FilePath
path = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter FilePath -> Bool
f ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
path
where f :: FilePath -> Bool
f FilePath
filename = FilePath
filename FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
"." Bool -> Bool -> Bool
&& FilePath
filename FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
/= FilePath
".."
getCurrentDirectory :: IO FilePath
getCurrentDirectory :: IO FilePath
getCurrentDirectory =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getCurrentDirectory") (IOError -> IOError) -> IO FilePath -> IO FilePath
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> (IOError -> Bool) -> IO FilePath -> IO FilePath
forall a. FilePath -> (IOError -> Bool) -> IO a -> IO a
specializeErrorString
FilePath
"Current working directory no longer exists"
IOError -> Bool
isDoesNotExistError
IO FilePath
getCurrentDirectoryInternal
setCurrentDirectory :: FilePath -> IO ()
setCurrentDirectory :: FilePath -> IO ()
setCurrentDirectory = FilePath -> IO ()
setCurrentDirectoryInternal
withCurrentDirectory :: FilePath
-> IO a
-> IO a
withCurrentDirectory :: forall a. FilePath -> IO a -> IO a
withCurrentDirectory FilePath
dir IO a
action =
IO FilePath -> (FilePath -> IO ()) -> (FilePath -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO FilePath
getCurrentDirectory FilePath -> IO ()
setCurrentDirectory ((FilePath -> IO a) -> IO a) -> (FilePath -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \ FilePath
_ -> do
FilePath -> IO ()
setCurrentDirectory FilePath
dir
IO a
action
getFileSize :: FilePath -> IO Integer
getFileSize :: FilePath -> IO Integer
getFileSize FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getFileSize") (IOError -> IOError) -> IO Integer -> IO Integer
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Metadata -> Integer
fileSizeFromMetadata (Metadata -> Integer) -> IO Metadata -> IO Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Metadata
getFileMetadata FilePath
path
doesPathExist :: FilePath -> IO Bool
doesPathExist :: FilePath -> IO Bool
doesPathExist FilePath
path = do
(Bool
True Bool -> IO Metadata -> IO Bool
forall a b. a -> IO b -> IO a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ FilePath -> IO Metadata
getFileMetadata FilePath
path)
IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \ IOError
_ ->
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
doesDirectoryExist :: FilePath -> IO Bool
doesDirectoryExist :: FilePath -> IO Bool
doesDirectoryExist FilePath
path = do
FilePath -> IO Bool
pathIsDirectory FilePath
path
IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \ IOError
_ ->
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
doesFileExist :: FilePath -> IO Bool
doesFileExist :: FilePath -> IO Bool
doesFileExist FilePath
path = do
(Bool -> Bool
not (Bool -> Bool) -> IO Bool -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Bool
pathIsDirectory FilePath
path)
IO Bool -> (IOError -> IO Bool) -> IO Bool
forall a. IO a -> (IOError -> IO a) -> IO a
`catchIOError` \ IOError
_ ->
Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
pathIsDirectory :: FilePath -> IO Bool
pathIsDirectory :: FilePath -> IO Bool
pathIsDirectory FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"pathIsDirectory") (IOError -> IOError) -> IO Bool -> IO Bool
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FileType -> Bool
fileTypeIsDirectory (FileType -> Bool) -> (Metadata -> FileType) -> Metadata -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> FileType
fileTypeFromMetadata (Metadata -> Bool) -> IO Metadata -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Metadata
getFileMetadata FilePath
path
createFileLink
:: FilePath
-> FilePath
-> IO ()
createFileLink :: FilePath -> FilePath -> IO ()
createFileLink FilePath
target FilePath
link =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"createFileLink") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Bool -> FilePath -> FilePath -> IO ()
createSymbolicLink Bool
False FilePath
target FilePath
link
createDirectoryLink
:: FilePath
-> FilePath
-> IO ()
createDirectoryLink :: FilePath -> FilePath -> IO ()
createDirectoryLink FilePath
target FilePath
link =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"createDirectoryLink") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Bool -> FilePath -> FilePath -> IO ()
createSymbolicLink Bool
True FilePath
target FilePath
link
removeDirectoryLink :: FilePath -> IO ()
removeDirectoryLink :: FilePath -> IO ()
removeDirectoryLink FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"removeDirectoryLink") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Bool -> FilePath -> IO ()
removePathInternal Bool
linkToDirectoryIsDirectory FilePath
path
pathIsSymbolicLink :: FilePath -> IO Bool
pathIsSymbolicLink :: FilePath -> IO Bool
pathIsSymbolicLink FilePath
path =
((IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"pathIsSymbolicLink") (IOError -> IOError) -> (IOError -> IOError) -> IOError -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(IOError -> FilePath -> IOError
`ioeSetFileName` FilePath
path)) (IOError -> IOError) -> IO Bool -> IO Bool
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FileType -> Bool
fileTypeIsLink (FileType -> Bool) -> (Metadata -> FileType) -> Metadata -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Metadata -> FileType
fileTypeFromMetadata (Metadata -> Bool) -> IO Metadata -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Metadata
getSymbolicLinkMetadata FilePath
path
{-# DEPRECATED isSymbolicLink "Use 'pathIsSymbolicLink' instead" #-}
isSymbolicLink :: FilePath -> IO Bool
isSymbolicLink :: FilePath -> IO Bool
isSymbolicLink = FilePath -> IO Bool
pathIsSymbolicLink
getSymbolicLinkTarget :: FilePath -> IO FilePath
getSymbolicLinkTarget :: FilePath -> IO FilePath
getSymbolicLinkTarget FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getSymbolicLinkTarget") (IOError -> IOError) -> IO FilePath -> IO FilePath
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> IO FilePath
readSymbolicLink FilePath
path
getAccessTime :: FilePath -> IO UTCTime
getAccessTime :: FilePath -> IO UTCTime
getAccessTime FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getAccessTime") (IOError -> IOError) -> IO UTCTime -> IO UTCTime
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Metadata -> UTCTime
accessTimeFromMetadata (Metadata -> UTCTime) -> IO Metadata -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Metadata
getFileMetadata (FilePath -> FilePath
emptyToCurDir FilePath
path)
getModificationTime :: FilePath -> IO UTCTime
getModificationTime :: FilePath -> IO UTCTime
getModificationTime FilePath
path =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getModificationTime") (IOError -> IOError) -> IO UTCTime -> IO UTCTime
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Metadata -> UTCTime
modificationTimeFromMetadata (Metadata -> UTCTime) -> IO Metadata -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Metadata
getFileMetadata (FilePath -> FilePath
emptyToCurDir FilePath
path)
setAccessTime :: FilePath -> UTCTime -> IO ()
setAccessTime :: FilePath -> UTCTime -> IO ()
setAccessTime FilePath
path UTCTime
atime =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"setAccessTime") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> (Maybe UTCTime, Maybe UTCTime) -> IO ()
setFileTimes FilePath
path (UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
atime, Maybe UTCTime
forall a. Maybe a
Nothing)
setModificationTime :: FilePath -> UTCTime -> IO ()
setModificationTime :: FilePath -> UTCTime -> IO ()
setModificationTime FilePath
path UTCTime
mtime =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"setModificationTime") (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> (Maybe UTCTime, Maybe UTCTime) -> IO ()
setFileTimes FilePath
path (Maybe UTCTime
forall a. Maybe a
Nothing, UTCTime -> Maybe UTCTime
forall a. a -> Maybe a
Just UTCTime
mtime)
setFileTimes :: FilePath -> (Maybe UTCTime, Maybe UTCTime) -> IO ()
setFileTimes :: FilePath -> (Maybe UTCTime, Maybe UTCTime) -> IO ()
setFileTimes FilePath
_ (Maybe UTCTime
Nothing, Maybe UTCTime
Nothing) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
setFileTimes FilePath
path (Maybe UTCTime
atime, Maybe UTCTime
mtime) =
((IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"setFileTimes") (IOError -> IOError) -> (IOError -> IOError) -> IOError -> IOError
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(IOError -> FilePath -> IOError
`ioeSetFileName` FilePath
path)) (IOError -> IOError) -> IO () -> IO ()
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> (Maybe POSIXTime, Maybe POSIXTime) -> IO ()
setTimes (FilePath -> FilePath
emptyToCurDir FilePath
path)
(UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime) -> Maybe UTCTime -> Maybe POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
atime, UTCTime -> POSIXTime
utcTimeToPOSIXSeconds (UTCTime -> POSIXTime) -> Maybe UTCTime -> Maybe POSIXTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe UTCTime
mtime)
getHomeDirectory :: IO FilePath
getHomeDirectory :: IO FilePath
getHomeDirectory =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getHomeDirectory") (IOError -> IOError) -> IO FilePath -> IO FilePath
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
IO FilePath
getHomeDirectoryInternal
getXdgDirectory :: XdgDirectory
-> FilePath
-> IO FilePath
getXdgDirectory :: XdgDirectory -> FilePath -> IO FilePath
getXdgDirectory XdgDirectory
xdgDir FilePath
suffix =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getXdgDirectory") (IOError -> IOError) -> IO FilePath -> IO FilePath
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> FilePath
simplify (FilePath -> FilePath)
-> (FilePath -> FilePath) -> FilePath -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> FilePath
</> FilePath
suffix) (FilePath -> FilePath) -> IO FilePath -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
Maybe FilePath
env <- FilePath -> IO (Maybe FilePath)
lookupEnv (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ case XdgDirectory
xdgDir of
XdgDirectory
XdgData -> FilePath
"XDG_DATA_HOME"
XdgDirectory
XdgConfig -> FilePath
"XDG_CONFIG_HOME"
XdgDirectory
XdgCache -> FilePath
"XDG_CACHE_HOME"
XdgDirectory
XdgState -> FilePath
"XDG_STATE_HOME"
case Maybe FilePath
env of
Just FilePath
path | FilePath -> Bool
isAbsolute FilePath
path -> FilePath -> IO FilePath
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
path
Maybe FilePath
_ -> IO FilePath -> XdgDirectory -> IO FilePath
getXdgDirectoryFallback IO FilePath
getHomeDirectory XdgDirectory
xdgDir
getXdgDirectoryList :: XdgDirectoryList
-> IO [FilePath]
getXdgDirectoryList :: XdgDirectoryList -> IO [FilePath]
getXdgDirectoryList XdgDirectoryList
xdgDirs =
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getXdgDirectoryList") (IOError -> IOError) -> IO [FilePath] -> IO [FilePath]
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
Maybe FilePath
env <- FilePath -> IO (Maybe FilePath)
lookupEnv (FilePath -> IO (Maybe FilePath))
-> FilePath -> IO (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ case XdgDirectoryList
xdgDirs of
XdgDirectoryList
XdgDataDirs -> FilePath
"XDG_DATA_DIRS"
XdgDirectoryList
XdgConfigDirs -> FilePath
"XDG_CONFIG_DIRS"
case Maybe FilePath
env of
Maybe FilePath
Nothing -> XdgDirectoryList -> IO [FilePath]
getXdgDirectoryListFallback XdgDirectoryList
xdgDirs
Just FilePath
paths -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> [FilePath]
splitSearchPath FilePath
paths)
getAppUserDataDirectory :: FilePath
-> IO FilePath
getAppUserDataDirectory :: FilePath -> IO FilePath
getAppUserDataDirectory FilePath
appName = do
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getAppUserDataDirectory") (IOError -> IOError) -> IO FilePath -> IO FilePath
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
FilePath -> IO FilePath
getAppUserDataDirectoryInternal FilePath
appName
getUserDocumentsDirectory :: IO FilePath
getUserDocumentsDirectory :: IO FilePath
getUserDocumentsDirectory = do
(IOError -> FilePath -> IOError
`ioeAddLocation` FilePath
"getUserDocumentsDirectory") (IOError -> IOError) -> IO FilePath -> IO FilePath
forall a. (IOError -> IOError) -> IO a -> IO a
`modifyIOError` do
IO FilePath
getUserDocumentsDirectoryInternal
getTemporaryDirectory :: IO FilePath
getTemporaryDirectory :: IO FilePath
getTemporaryDirectory = IO FilePath
getTemporaryDirectoryInternal