module Effectful.FileSystem
  ( -- * Effect
    FileSystem

    -- ** Handlers
  , runFileSystem

    -- * Actions on directories
  , createDirectory
  , createDirectoryIfMissing
  , removeDirectory
  , removeDirectoryRecursive
  , removePathForcibly
  , renameDirectory
  , listDirectory
  , getDirectoryContents

    -- ** Current working directory
  , getCurrentDirectory
  , setCurrentDirectory
  , withCurrentDirectory

    -- * Pre-defined directories
  , getHomeDirectory
  , getXdgDirectory
  , getXdgDirectoryList
  , getAppUserDataDirectory
  , getUserDocumentsDirectory
  , getTemporaryDirectory

    -- * Actions on files
  , removeFile
  , renameFile
  , renamePath
  , copyFile
  , copyFileWithMetadata
  , getFileSize
  , canonicalizePath
  , makeAbsolute
  , makeRelativeToCurrentDirectory

    -- * Existence tests
  , doesPathExist
  , doesFileExist
  , doesDirectoryExist
  , findExecutable
  , findExecutables
  , findExecutablesInDirectories
  , findFile
  , findFiles
  , findFileWith
  , findFilesWith

    -- * Symbolic links
  , createFileLink
  , createDirectoryLink
  , removeDirectoryLink
  , pathIsSymbolicLink
  , getSymbolicLinkTarget

    -- * Permissions
  , getPermissions
  , setPermissions
  , copyPermissions

    -- * Timestamps
  , getAccessTime
  , getModificationTime
  , setAccessTime
  , setModificationTime

    -- * Re-exports

    -- ** Pre-defined directories
  , D.XdgDirectory(..)
  , D.XdgDirectoryList(..)

    -- ** Existence tests
  , D.exeExtension

    -- ** Permissions
  , D.Permissions
  , D.emptyPermissions
  , D.readable
  , D.writable
  , D.executable
  , D.searchable
  , D.setOwnerReadable
  , D.setOwnerWritable
  , D.setOwnerExecutable
  , D.setOwnerSearchable
  ) where

import Data.Time (UTCTime)
import qualified System.Directory as D

import Effectful
import Effectful.Dispatch.Static
import Effectful.FileSystem.Effect

----------------------------------------
-- Actions on directories

-- | Lifted 'D.createDirectory'.
createDirectory :: FileSystem :> es => FilePath -> Eff es ()
createDirectory :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es ()
createDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.createDirectory

-- | Lifted 'D.createDirectoryIfMissing'.
createDirectoryIfMissing :: FileSystem :> es => Bool -> FilePath -> Eff es ()
createDirectoryIfMissing :: forall (es :: [Effect]).
(FileSystem :> es) =>
Bool -> FilePath -> Eff es ()
createDirectoryIfMissing Bool
doCreateParents =
  forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> FilePath -> IO ()
D.createDirectoryIfMissing Bool
doCreateParents

-- | Lifted 'D.removeDirectory'.
removeDirectory :: FileSystem :> es => FilePath -> Eff es ()
removeDirectory :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es ()
removeDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.removeDirectory

-- | Lifted 'D.removeDirectoryRecursive'.
removeDirectoryRecursive :: FileSystem :> es => FilePath -> Eff es ()
removeDirectoryRecursive :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es ()
removeDirectoryRecursive = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.removeDirectoryRecursive

-- | Lifted 'D.removePathForcibly'.
removePathForcibly :: FileSystem :> es => FilePath -> Eff es ()
removePathForcibly :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es ()
removePathForcibly = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.removePathForcibly

-- | Lifted 'D.renameDirectory'.
renameDirectory :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
renameDirectory :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> FilePath -> Eff es ()
renameDirectory FilePath
old = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
D.renameDirectory FilePath
old

-- | Lifted 'D.listDirectory'.
listDirectory :: FileSystem :> es => FilePath -> Eff es [FilePath]
listDirectory :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es [FilePath]
listDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
D.listDirectory

-- | Lifted 'D.getDirectoryContents'.
getDirectoryContents :: FileSystem :> es => FilePath -> Eff es [FilePath]
getDirectoryContents :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es [FilePath]
getDirectoryContents = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
D.getDirectoryContents

----------------------------------------
-- Current working directory

-- | Lifted 'D.getCurrentDirectory'.
getCurrentDirectory :: FileSystem :> es => Eff es FilePath
getCurrentDirectory :: forall (es :: [Effect]). (FileSystem :> es) => Eff es FilePath
getCurrentDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO FilePath
D.getCurrentDirectory

-- | Lifted 'D.setCurrentDirectory'.
setCurrentDirectory :: FileSystem :> es => FilePath -> Eff es ()
setCurrentDirectory :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es ()
setCurrentDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.setCurrentDirectory

-- | Lifted 'D.withCurrentDirectory'.
withCurrentDirectory :: FileSystem :> es => FilePath -> Eff es a -> Eff es a
withCurrentDirectory :: forall (es :: [Effect]) a.
(FileSystem :> es) =>
FilePath -> Eff es a -> Eff es a
withCurrentDirectory FilePath
path = forall a b (es :: [Effect]).
HasCallStack =>
(IO a -> IO b) -> Eff es a -> Eff es b
unsafeLiftMapIO (forall a. FilePath -> IO a -> IO a
D.withCurrentDirectory FilePath
path)

----------------------------------------
-- Pre-defined directories

-- | Lifted 'D.getHomeDirectory'.
getHomeDirectory :: FileSystem :> es => Eff es FilePath
getHomeDirectory :: forall (es :: [Effect]). (FileSystem :> es) => Eff es FilePath
getHomeDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO FilePath
D.getHomeDirectory

-- | Lifted 'D.getXdgDirectory'.
getXdgDirectory
  :: FileSystem :> es
  => D.XdgDirectory
  -> FilePath
  -> Eff es FilePath
getXdgDirectory :: forall (es :: [Effect]).
(FileSystem :> es) =>
XdgDirectory -> FilePath -> Eff es FilePath
getXdgDirectory XdgDirectory
xdgDir = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectory -> FilePath -> IO FilePath
D.getXdgDirectory XdgDirectory
xdgDir

-- | Lifted 'D.getXdgDirectoryList'.
getXdgDirectoryList
  :: FileSystem :> es
  => D.XdgDirectoryList
  -> Eff es [FilePath]
getXdgDirectoryList :: forall (es :: [Effect]).
(FileSystem :> es) =>
XdgDirectoryList -> Eff es [FilePath]
getXdgDirectoryList = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. XdgDirectoryList -> IO [FilePath]
D.getXdgDirectoryList

-- | Lifted 'D.getAppUserDataDirectory'.
getAppUserDataDirectory :: FileSystem :> es => FilePath -> Eff es FilePath
getAppUserDataDirectory :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es FilePath
getAppUserDataDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
D.getAppUserDataDirectory

-- | Lifted 'D.getUserDocumentsDirectory'.
getUserDocumentsDirectory :: FileSystem :> es => Eff es FilePath
getUserDocumentsDirectory :: forall (es :: [Effect]). (FileSystem :> es) => Eff es FilePath
getUserDocumentsDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO FilePath
D.getUserDocumentsDirectory

-- | Lifted 'D.getTemporaryDirectory'.
getTemporaryDirectory :: FileSystem :> es => Eff es FilePath
getTemporaryDirectory :: forall (es :: [Effect]). (FileSystem :> es) => Eff es FilePath
getTemporaryDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ IO FilePath
D.getTemporaryDirectory

----------------------------------------
-- Actions on files

-- | Lifted 'D.removeFile'.
removeFile :: FileSystem :> es => FilePath -> Eff es ()
removeFile :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es ()
removeFile = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.removeFile

-- | Lifted 'D.renameFile'.
renameFile :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
renameFile :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> FilePath -> Eff es ()
renameFile FilePath
old = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
D.renameFile FilePath
old

-- | Lifted 'D.renamePath'.
renamePath :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
renamePath :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> FilePath -> Eff es ()
renamePath FilePath
old = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
D.renamePath FilePath
old

-- | Lifted 'D.copyFile'.
copyFile :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
copyFile :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> FilePath -> Eff es ()
copyFile FilePath
src = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
D.copyFile FilePath
src

-- | Lifted 'D.copyFileWithMetadata'.
copyFileWithMetadata :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
copyFileWithMetadata :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> FilePath -> Eff es ()
copyFileWithMetadata FilePath
src = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
D.copyFileWithMetadata FilePath
src

-- | Lifted 'D.getFileSize'.
getFileSize :: FileSystem :> es => FilePath -> Eff es Integer
getFileSize :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es Integer
getFileSize = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Integer
D.getFileSize

-- | Lifted 'D.canonicalizePath'.
canonicalizePath :: FileSystem :> es => FilePath -> Eff es FilePath
canonicalizePath :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es FilePath
canonicalizePath = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
D.canonicalizePath

-- | Lifted 'D.makeAbsolute'.
makeAbsolute :: FileSystem :> es => FilePath -> Eff es FilePath
makeAbsolute :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es FilePath
makeAbsolute = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
D.makeAbsolute

-- | Lifted 'D.makeRelativeToCurrentDirectory'.
makeRelativeToCurrentDirectory
  :: FileSystem :> es
  => FilePath
  -> Eff es FilePath
makeRelativeToCurrentDirectory :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es FilePath
makeRelativeToCurrentDirectory = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
D.makeRelativeToCurrentDirectory

----------------------------------------
-- Existence tests

-- | Lifted 'D.doesPathExist'.
doesPathExist :: FileSystem :> es => FilePath -> Eff es Bool
doesPathExist :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es Bool
doesPathExist = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
D.doesPathExist

-- | Lifted 'D.doesFileExist'.
doesFileExist :: FileSystem :> es => FilePath -> Eff es Bool
doesFileExist :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es Bool
doesFileExist = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
D.doesFileExist

-- | Lifted 'D.doesDirectoryExist'.
doesDirectoryExist :: FileSystem :> es => FilePath -> Eff es Bool
doesDirectoryExist :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es Bool
doesDirectoryExist = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
D.doesDirectoryExist

-- | Lifted 'D.findExecutable'.
findExecutable :: FileSystem :> es => String -> Eff es (Maybe FilePath)
findExecutable :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es (Maybe FilePath)
findExecutable = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe FilePath)
D.findExecutable

-- | Lifted 'D.findExecutables'.
findExecutables :: FileSystem :> es => String -> Eff es [FilePath]
findExecutables :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es [FilePath]
findExecutables = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO [FilePath]
D.findExecutables

-- | Lifted 'D.findExecutablesInDirectories'.
findExecutablesInDirectories
  :: FileSystem :> es
  => [FilePath]
  -> String
  -> Eff es [FilePath]
findExecutablesInDirectories :: forall (es :: [Effect]).
(FileSystem :> es) =>
[FilePath] -> FilePath -> Eff es [FilePath]
findExecutablesInDirectories [FilePath]
dirs =
  forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath -> IO [FilePath]
D.findExecutablesInDirectories [FilePath]
dirs

-- | Lifted 'D.findFile'.
findFile :: FileSystem :> es => [FilePath] -> String -> Eff es (Maybe FilePath)
findFile :: forall (es :: [Effect]).
(FileSystem :> es) =>
[FilePath] -> FilePath -> Eff es (Maybe FilePath)
findFile [FilePath]
dirs = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath -> IO (Maybe FilePath)
D.findFile [FilePath]
dirs

-- | Lifted 'D.findFiles'.
findFiles :: FileSystem :> es => [FilePath] -> String -> Eff es [FilePath]
findFiles :: forall (es :: [Effect]).
(FileSystem :> es) =>
[FilePath] -> FilePath -> Eff es [FilePath]
findFiles [FilePath]
dirs = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> FilePath -> IO [FilePath]
D.findFiles [FilePath]
dirs

-- | Lifted 'D.findFileWith'.
findFileWith
  :: FileSystem :> es
  => (FilePath -> Eff es Bool)
  -> [FilePath]
  -> String
  -> Eff es (Maybe FilePath)
findFileWith :: forall (es :: [Effect]).
(FileSystem :> es) =>
(FilePath -> Eff es Bool)
-> [FilePath] -> FilePath -> Eff es (Maybe FilePath)
findFileWith FilePath -> Eff es Bool
p [FilePath]
dirs FilePath
n = forall (es :: [Effect]) a.
HasCallStack =>
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
unsafeSeqUnliftIO forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
  (FilePath -> IO Bool)
-> [FilePath] -> FilePath -> IO (Maybe FilePath)
D.findFileWith (forall r. Eff es r -> IO r
unlift forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Eff es Bool
p) [FilePath]
dirs FilePath
n

-- | Lifted 'D.findFilesWith'.
findFilesWith
  :: FileSystem :> es
  => (FilePath -> Eff es Bool)
  -> [FilePath]
  -> String
  -> Eff es [FilePath]
findFilesWith :: forall (es :: [Effect]).
(FileSystem :> es) =>
(FilePath -> Eff es Bool)
-> [FilePath] -> FilePath -> Eff es [FilePath]
findFilesWith FilePath -> Eff es Bool
p [FilePath]
dirs FilePath
ns = forall (es :: [Effect]) a.
HasCallStack =>
((forall r. Eff es r -> IO r) -> IO a) -> Eff es a
unsafeSeqUnliftIO forall a b. (a -> b) -> a -> b
$ \forall r. Eff es r -> IO r
unlift -> do
  (FilePath -> IO Bool) -> [FilePath] -> FilePath -> IO [FilePath]
D.findFilesWith (forall r. Eff es r -> IO r
unlift forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Eff es Bool
p) [FilePath]
dirs FilePath
ns

----------------------------------------
-- Symbolic links

-- | Lifted 'D.createFileLink'.
createFileLink :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
createFileLink :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> FilePath -> Eff es ()
createFileLink FilePath
target = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
D.createFileLink FilePath
target

-- | Lifted 'D.createDirectoryLink'.
createDirectoryLink :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
createDirectoryLink :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> FilePath -> Eff es ()
createDirectoryLink FilePath
target = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
D.createDirectoryLink FilePath
target

-- | Lifted 'D.removeDirectoryLink'.
removeDirectoryLink :: FileSystem :> es => FilePath -> Eff es ()
removeDirectoryLink :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es ()
removeDirectoryLink = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
D.removeDirectoryLink

-- | Lifted 'D.pathIsSymbolicLink'.
pathIsSymbolicLink :: FileSystem :> es => FilePath -> Eff es Bool
pathIsSymbolicLink :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es Bool
pathIsSymbolicLink = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Bool
D.pathIsSymbolicLink

-- | Lifted 'D.getSymbolicLinkTarget'.
getSymbolicLinkTarget :: FileSystem :> es => FilePath -> Eff es FilePath
getSymbolicLinkTarget :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es FilePath
getSymbolicLinkTarget = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO FilePath
D.getSymbolicLinkTarget

----------------------------------------
-- Permissions

-- | Lifted 'D.getPermissions'.
getPermissions :: FileSystem :> es => FilePath -> Eff es D.Permissions
getPermissions :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es Permissions
getPermissions = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO Permissions
D.getPermissions

-- | Lifted 'D.setPermissions'.
setPermissions :: FileSystem :> es => FilePath -> D.Permissions -> Eff es ()
setPermissions :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Permissions -> Eff es ()
setPermissions FilePath
path = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Permissions -> IO ()
D.setPermissions FilePath
path

-- | Lifted 'D.copyPermissions'.
copyPermissions :: FileSystem :> es => FilePath -> FilePath -> Eff es ()
copyPermissions :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> FilePath -> Eff es ()
copyPermissions FilePath
src = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> IO ()
D.copyPermissions FilePath
src

----------------------------------------
-- Timestamps

-- | Lifted 'D.getAccessTime'.
getAccessTime :: FileSystem :> es => FilePath -> Eff es UTCTime
getAccessTime :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es UTCTime
getAccessTime = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO UTCTime
D.getAccessTime

-- | Lifted 'D.getModificationTime'.
getModificationTime :: FileSystem :> es => FilePath -> Eff es UTCTime
getModificationTime :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> Eff es UTCTime
getModificationTime = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO UTCTime
D.getModificationTime

-- | Lifted 'D.setAccessTime'.
setAccessTime :: FileSystem :> es => FilePath -> UTCTime -> Eff es ()
setAccessTime :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> UTCTime -> Eff es ()
setAccessTime FilePath
path = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> UTCTime -> IO ()
D.setAccessTime FilePath
path

-- | Lifted 'D.setModificationTime'.
setModificationTime :: FileSystem :> es => FilePath -> UTCTime -> Eff es ()
setModificationTime :: forall (es :: [Effect]).
(FileSystem :> es) =>
FilePath -> UTCTime -> Eff es ()
setModificationTime FilePath
path = forall a (es :: [Effect]). IO a -> Eff es a
unsafeEff_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> UTCTime -> IO ()
D.setModificationTime FilePath
path