-- | This module provides type-safe access to directory manipulations.
--
--   It is designed to be imported instead of "System.Directory".
--   (It is intended to provide versions of functions from that
--   module which have equivalent functionality but are more
--   typesafe). "System.Path" is a companion module providing
--   a type-safe alternative to "System.FilePath".
--
--   You will typically want to import as follows:
--
--   > import qualified System.Path.IO as PathIO
--   > import qualified System.Path as Path
--   > import System.Path.Directory (createDirectory)
module System.Path.Directory
(
  -- * Actions on directories
  createDirectory,
  createDirectoryIfMissing,
  removeDirectory,
  removeDirectoryRecursive,
  renameDirectory,

  getDirectoryContents,
  absDirectoryContents,
  relDirectoryContents,
  filesInDir,
  dirsInDir,

  getCurrentDirectory,
  setCurrentDirectory,

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

  -- * Actions on files
  removeFile,
  renameFile,
  copyFile,
  canonicalizePath,
  makeRelativeToCurrentDirectory,
  findExecutable,

  -- * Existence tests
  doesFileExist,
  doesDirectoryExist,

  -- * Permissions
  Permissions,
  getPermissions,
  setPermissions,

  -- * Timestamps
  getModificationTime,
)

where

import qualified System.Path.Internal.PartClass as Class
import qualified System.Path as Path
import System.Path (
    Path, path,
    AbsPath, AbsDir, AbsFile, RelPath, RelDir, RelFile,
    DirPath, FilePath, absDir, (</>),
    )

import System.Path.ModificationTime (convertTime)
import Data.Time (UTCTime)

import qualified System.Directory as SD
import System.Directory (Permissions)

import Control.Applicative ((<$>))

import Data.List (partition)
import Data.Tuple.HT (mapPair)

import Prelude hiding (FilePath)


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

createDirectory :: Class.AbsRel ar => DirPath ar -> IO ()
createDirectory :: forall ar. AbsRel ar => DirPath ar -> IO ()
createDirectory = FilePath -> IO ()
SD.createDirectory (FilePath -> IO ())
-> (DirPath ar -> FilePath) -> DirPath ar -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirPath ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString

createDirectoryIfMissing :: Class.AbsRel ar => Bool -> DirPath ar -> IO ()
createDirectoryIfMissing :: forall ar. AbsRel ar => Bool -> DirPath ar -> IO ()
createDirectoryIfMissing Bool
flag = Bool -> FilePath -> IO ()
SD.createDirectoryIfMissing Bool
flag (FilePath -> IO ())
-> (DirPath ar -> FilePath) -> DirPath ar -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirPath ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString

removeDirectory :: Class.AbsRel ar => DirPath ar -> IO ()
removeDirectory :: forall ar. AbsRel ar => DirPath ar -> IO ()
removeDirectory = FilePath -> IO ()
SD.removeDirectory (FilePath -> IO ())
-> (DirPath ar -> FilePath) -> DirPath ar -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirPath ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString

removeDirectoryRecursive :: Class.AbsRel ar => DirPath ar -> IO ()
removeDirectoryRecursive :: forall ar. AbsRel ar => DirPath ar -> IO ()
removeDirectoryRecursive = FilePath -> IO ()
SD.removeDirectoryRecursive (FilePath -> IO ())
-> (DirPath ar -> FilePath) -> DirPath ar -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirPath ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString

renameDirectory ::
  (Class.AbsRel ar1, Class.AbsRel ar2) => DirPath ar1 -> DirPath ar2 -> IO ()
renameDirectory :: forall ar1 ar2.
(AbsRel ar1, AbsRel ar2) =>
DirPath ar1 -> DirPath ar2 -> IO ()
renameDirectory DirPath ar1
p1 DirPath ar2
p2 =
  FilePath -> FilePath -> IO ()
SD.renameDirectory (DirPath ar1 -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString DirPath ar1
p1) (DirPath ar2 -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString DirPath ar2
p2)

-- | Retrieve the contents of a directory without any directory prefixes.
-- In contrast to 'System.Directory.getDirectoryContents',
-- exclude special directories \".\" and \"..\".
getDirectoryContents :: Class.AbsRel ar => DirPath ar -> IO [Path.RelFileDir]
getDirectoryContents :: forall ar. AbsRel ar => DirPath ar -> IO [RelFileDir]
getDirectoryContents DirPath ar
dir =
    (FilePath -> RelFileDir) -> [FilePath] -> [RelFileDir]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> RelFileDir
forall ar fd. (AbsRel ar, FileDir fd) => FilePath -> Path ar fd
Path.path ([FilePath] -> [RelFileDir]) -> IO [FilePath] -> IO [RelFileDir]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirPath ar -> IO [FilePath]
forall ar. AbsRel ar => DirPath ar -> IO [FilePath]
plainDirectoryContents DirPath ar
dir

-- | Retrieve the contents of a directory path (which may be relative) as absolute paths
absDirectoryContents ::
  Class.AbsRel ar => DirPath ar -> IO ([AbsDir], [AbsFile])
absDirectoryContents :: forall ar. AbsRel ar => DirPath ar -> IO ([AbsDir], [AbsFile])
absDirectoryContents DirPath ar
p = do
  AbsDir
cd <- FilePath -> AbsDir
absDir (FilePath -> AbsDir) -> IO FilePath -> IO AbsDir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
SD.getCurrentDirectory
  let dir :: AbsDir
dir = (AbsDir -> AbsDir)
-> (RelPath System Dir -> AbsDir) -> DirPath ar -> AbsDir
forall ar os fd a.
AbsRel ar =>
(AbsPath os fd -> a) -> (RelPath os fd -> a) -> Path os ar fd -> a
Path.withAbsRel AbsDir -> AbsDir
forall a. a -> a
id (AbsDir
cd AbsDir -> RelPath System Dir -> AbsDir
forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</>) DirPath ar
p
  ([RelPath System Dir] -> [AbsDir],
 [RelPath System File] -> [AbsFile])
-> ([RelPath System Dir], [RelPath System File])
-> ([AbsDir], [AbsFile])
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair ((RelPath System Dir -> AbsDir) -> [RelPath System Dir] -> [AbsDir]
forall a b. (a -> b) -> [a] -> [b]
map (AbsDir
dir AbsDir -> RelPath System Dir -> AbsDir
forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</>), (RelPath System File -> AbsFile)
-> [RelPath System File] -> [AbsFile]
forall a b. (a -> b) -> [a] -> [b]
map (AbsDir
dir AbsDir -> RelPath System File -> AbsFile
forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</>)) (([RelPath System Dir], [RelPath System File])
 -> ([AbsDir], [AbsFile]))
-> IO ([RelPath System Dir], [RelPath System File])
-> IO ([AbsDir], [AbsFile])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AbsDir -> IO ([RelPath System Dir], [RelPath System File])
forall ar.
AbsRel ar =>
DirPath ar -> IO ([RelPath System Dir], [RelPath System File])
relDirectoryContents AbsDir
dir

-- | Returns paths relative /to/ the supplied (abs or relative) directory path.
--   eg (for current working directory of @\/somewhere\/cwd\/@):
--
-- > show (relDirectoryContents "d/e/f/") == (["subDir1A","subDir1B"],
-- >                                                      ["file1A","file1B"])
--
relDirectoryContents ::
  Class.AbsRel ar => DirPath ar -> IO ([RelDir], [RelFile])
relDirectoryContents :: forall ar.
AbsRel ar =>
DirPath ar -> IO ([RelPath System Dir], [RelPath System File])
relDirectoryContents DirPath ar
dir = do
  [FilePath]
filenames <- DirPath ar -> IO [FilePath]
forall ar. AbsRel ar => DirPath ar -> IO [FilePath]
plainDirectoryContents DirPath ar
dir
  ([(FilePath, Bool)] -> [RelPath System Dir],
 [(FilePath, Bool)] -> [RelPath System File])
-> ([(FilePath, Bool)], [(FilePath, Bool)])
-> ([RelPath System Dir], [RelPath System File])
forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (((FilePath, Bool) -> RelPath System Dir)
-> [(FilePath, Bool)] -> [RelPath System Dir]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> RelPath System Dir
Path.relDir (FilePath -> RelPath System Dir)
-> ((FilePath, Bool) -> FilePath)
-> (FilePath, Bool)
-> RelPath System Dir
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst), ((FilePath, Bool) -> RelPath System File)
-> [(FilePath, Bool)] -> [RelPath System File]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> RelPath System File
Path.relFile (FilePath -> RelPath System File)
-> ((FilePath, Bool) -> FilePath)
-> (FilePath, Bool)
-> RelPath System File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath, Bool) -> FilePath
forall a b. (a, b) -> a
fst)) (([(FilePath, Bool)], [(FilePath, Bool)])
 -> ([RelPath System Dir], [RelPath System File]))
-> ([Bool] -> ([(FilePath, Bool)], [(FilePath, Bool)]))
-> [Bool]
-> ([RelPath System Dir], [RelPath System File])
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    ((FilePath, Bool) -> Bool)
-> [(FilePath, Bool)] -> ([(FilePath, Bool)], [(FilePath, Bool)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (FilePath, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(FilePath, Bool)] -> ([(FilePath, Bool)], [(FilePath, Bool)]))
-> ([Bool] -> [(FilePath, Bool)])
-> [Bool]
-> ([(FilePath, Bool)], [(FilePath, Bool)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [Bool] -> [(FilePath, Bool)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
filenames
      ([Bool] -> ([RelPath System Dir], [RelPath System File]))
-> IO [Bool] -> IO ([RelPath System Dir], [RelPath System File])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (FilePath -> IO Bool) -> [FilePath] -> IO [Bool]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (DirPath ar -> IO Bool
forall ar. AbsRel ar => DirPath ar -> IO Bool
doesDirectoryExist (DirPath ar -> IO Bool)
-> (FilePath -> DirPath ar) -> FilePath -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DirPath ar
dir DirPath ar -> RelPath System Dir -> DirPath ar
forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</>) (RelPath System Dir -> DirPath ar)
-> (FilePath -> RelPath System Dir) -> FilePath -> DirPath ar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> RelPath System Dir
forall fd. FileDir fd => FilePath -> RelPath fd
Path.relPath) [FilePath]
filenames

plainDirectoryContents :: Class.AbsRel ar => DirPath ar -> IO [String]
plainDirectoryContents :: forall ar. AbsRel ar => DirPath ar -> IO [FilePath]
plainDirectoryContents DirPath ar
dir =
    (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> [FilePath] -> Bool) -> [FilePath] -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> [FilePath] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [FilePath
".",FilePath
".."]) ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    FilePath -> IO [FilePath]
SD.getDirectoryContents (DirPath ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString DirPath ar
dir)

-- | A convenient alternative to 'relDirectoryContents' if you only want files.
filesInDir :: Class.AbsRel ar => DirPath ar -> IO [RelFile]
filesInDir :: forall ar. AbsRel ar => DirPath ar -> IO [RelPath System File]
filesInDir DirPath ar
dir = ([RelPath System Dir], [RelPath System File])
-> [RelPath System File]
forall a b. (a, b) -> b
snd (([RelPath System Dir], [RelPath System File])
 -> [RelPath System File])
-> IO ([RelPath System Dir], [RelPath System File])
-> IO [RelPath System File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirPath ar -> IO ([RelPath System Dir], [RelPath System File])
forall ar.
AbsRel ar =>
DirPath ar -> IO ([RelPath System Dir], [RelPath System File])
relDirectoryContents DirPath ar
dir

-- | A convenient alternative to 'relDirectoryContents' if you only want directories.
dirsInDir :: Class.AbsRel ar => DirPath ar -> IO [RelDir]
dirsInDir :: forall ar. AbsRel ar => DirPath ar -> IO [RelPath System Dir]
dirsInDir DirPath ar
dir = ([RelPath System Dir], [RelPath System File])
-> [RelPath System Dir]
forall a b. (a, b) -> a
fst (([RelPath System Dir], [RelPath System File])
 -> [RelPath System Dir])
-> IO ([RelPath System Dir], [RelPath System File])
-> IO [RelPath System Dir]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> DirPath ar -> IO ([RelPath System Dir], [RelPath System File])
forall ar.
AbsRel ar =>
DirPath ar -> IO ([RelPath System Dir], [RelPath System File])
relDirectoryContents DirPath ar
dir


getCurrentDirectory :: IO AbsDir
getCurrentDirectory :: IO AbsDir
getCurrentDirectory = FilePath -> AbsDir
absDir (FilePath -> AbsDir) -> IO FilePath -> IO AbsDir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
SD.getCurrentDirectory

setCurrentDirectory :: Class.AbsRel ar => DirPath ar -> IO ()
setCurrentDirectory :: forall ar. AbsRel ar => DirPath ar -> IO ()
setCurrentDirectory = FilePath -> IO ()
SD.setCurrentDirectory (FilePath -> IO ())
-> (DirPath ar -> FilePath) -> DirPath ar -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirPath ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString


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

getHomeDirectory :: IO AbsDir
getHomeDirectory :: IO AbsDir
getHomeDirectory = FilePath -> AbsDir
absDir (FilePath -> AbsDir) -> IO FilePath -> IO AbsDir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
SD.getHomeDirectory

getAppUserDataDirectory :: String -> IO AbsDir
getAppUserDataDirectory :: FilePath -> IO AbsDir
getAppUserDataDirectory FilePath
user = FilePath -> AbsDir
absDir (FilePath -> AbsDir) -> IO FilePath -> IO AbsDir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
SD.getAppUserDataDirectory FilePath
user

getUserDocumentsDirectory :: IO AbsDir
getUserDocumentsDirectory :: IO AbsDir
getUserDocumentsDirectory = FilePath -> AbsDir
absDir (FilePath -> AbsDir) -> IO FilePath -> IO AbsDir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
SD.getUserDocumentsDirectory

getTemporaryDirectory :: IO AbsDir
getTemporaryDirectory :: IO AbsDir
getTemporaryDirectory = FilePath -> AbsDir
absDir (FilePath -> AbsDir) -> IO FilePath -> IO AbsDir
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
SD.getTemporaryDirectory


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

removeFile :: Class.AbsRel ar => FilePath ar -> IO ()
removeFile :: forall ar. AbsRel ar => FilePath ar -> IO ()
removeFile = FilePath -> IO ()
SD.removeFile (FilePath -> IO ())
-> (FilePath ar -> FilePath) -> FilePath ar -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString

renameFile ::
    (Class.AbsRel ar1, Class.AbsRel ar2) =>
    FilePath ar1 -> FilePath ar2 -> IO ()
renameFile :: forall ar1 ar2.
(AbsRel ar1, AbsRel ar2) =>
FilePath ar1 -> FilePath ar2 -> IO ()
renameFile FilePath ar1
p1 FilePath ar2
p2 = FilePath -> FilePath -> IO ()
SD.renameFile (FilePath ar1 -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString FilePath ar1
p1) (FilePath ar2 -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString FilePath ar2
p2)

copyFile ::
    (Class.AbsRel ar1, Class.AbsRel ar2) =>
    FilePath ar1 -> FilePath ar2 -> IO ()
copyFile :: forall ar1 ar2.
(AbsRel ar1, AbsRel ar2) =>
FilePath ar1 -> FilePath ar2 -> IO ()
copyFile FilePath ar1
p1 FilePath ar2
p2 = FilePath -> FilePath -> IO ()
SD.copyFile (FilePath ar1 -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString FilePath ar1
p1) (FilePath ar2 -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString FilePath ar2
p2)

canonicalizePath ::
    (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> IO (AbsPath fd)
canonicalizePath :: forall ar fd.
(AbsRel ar, FileDir fd) =>
Path ar fd -> IO (AbsPath fd)
canonicalizePath Path ar fd
p = FilePath -> Path Abs fd
forall ar fd. (AbsRel ar, FileDir fd) => FilePath -> Path ar fd
path (FilePath -> Path Abs fd) -> IO FilePath -> IO (Path Abs fd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
SD.canonicalizePath (Path ar fd -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString Path ar fd
p)

makeRelativeToCurrentDirectory ::
    (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> IO (RelPath fd)
makeRelativeToCurrentDirectory :: forall ar fd.
(AbsRel ar, FileDir fd) =>
Path ar fd -> IO (RelPath fd)
makeRelativeToCurrentDirectory Path ar fd
p =
    FilePath -> Path Rel fd
forall ar fd. (AbsRel ar, FileDir fd) => FilePath -> Path ar fd
path (FilePath -> Path Rel fd) -> IO FilePath -> IO (Path Rel fd)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
SD.makeRelativeToCurrentDirectory (Path ar fd -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString Path ar fd
p)

findExecutable :: String -> IO (Maybe AbsFile)
findExecutable :: FilePath -> IO (Maybe AbsFile)
findExecutable FilePath
s = (FilePath -> AbsFile) -> Maybe FilePath -> Maybe AbsFile
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap FilePath -> AbsFile
forall ar fd. (AbsRel ar, FileDir fd) => FilePath -> Path ar fd
path (Maybe FilePath -> Maybe AbsFile)
-> IO (Maybe FilePath) -> IO (Maybe AbsFile)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe FilePath)
SD.findExecutable FilePath
s


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

doesFileExist :: Class.AbsRel ar => FilePath ar -> IO Bool
doesFileExist :: forall ar. AbsRel ar => FilePath ar -> IO Bool
doesFileExist = FilePath -> IO Bool
SD.doesFileExist (FilePath -> IO Bool)
-> (FilePath ar -> FilePath) -> FilePath ar -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString

doesDirectoryExist :: Class.AbsRel ar => DirPath ar -> IO Bool
doesDirectoryExist :: forall ar. AbsRel ar => DirPath ar -> IO Bool
doesDirectoryExist = FilePath -> IO Bool
SD.doesDirectoryExist (FilePath -> IO Bool)
-> (DirPath ar -> FilePath) -> DirPath ar -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DirPath ar -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString


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

getPermissions ::
    (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> IO Permissions
getPermissions :: forall ar fd.
(AbsRel ar, FileDir fd) =>
Path ar fd -> IO Permissions
getPermissions Path ar fd
p = FilePath -> IO Permissions
SD.getPermissions (Path ar fd -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString Path ar fd
p)

setPermissions ::
    (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> Permissions -> IO ()
setPermissions :: forall ar fd.
(AbsRel ar, FileDir fd) =>
Path ar fd -> Permissions -> IO ()
setPermissions Path ar fd
p Permissions
perms = FilePath -> Permissions -> IO ()
SD.setPermissions (Path ar fd -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString Path ar fd
p) Permissions
perms


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

getModificationTime ::
    (Class.AbsRel ar, Class.FileDir fd) => Path ar fd -> IO UTCTime
getModificationTime :: forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> IO UTCTime
getModificationTime Path ar fd
p = UTCTime -> UTCTime
convertTime (UTCTime -> UTCTime) -> IO UTCTime -> IO UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO UTCTime
SD.getModificationTime (Path ar fd -> FilePath
forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString Path ar fd
p)