-- | 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString DirPath ar1
p1) (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 =
    forall a b. (a -> b) -> [a] -> [b]
map forall ar fd. (AbsRel ar, FileDir fd) => FilePath -> Path ar fd
Path.path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO FilePath
SD.getCurrentDirectory
  let dir :: AbsDir
dir = forall ar os fd a.
AbsRel ar =>
(AbsPath os fd -> a) -> (RelPath os fd -> a) -> Path os ar fd -> a
Path.withAbsRel forall a. a -> a
id (AbsDir
cd forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</>) DirPath ar
p
  forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a b. (a -> b) -> [a] -> [b]
map (AbsDir
dir forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</>), forall a b. (a -> b) -> [a] -> [b]
map (AbsDir
dir forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</>)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 <- forall ar. AbsRel ar => DirPath ar -> IO [FilePath]
plainDirectoryContents DirPath ar
dir
  forall a c b d. (a -> c, b -> d) -> (a, b) -> (c, d)
mapPair (forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> RelPath System Dir
Path.relDir forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst), forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> RelPath System File
Path.relFile forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)) forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    forall a. (a -> Bool) -> [a] -> ([a], [a])
partition forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
filenames
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (forall ar. AbsRel ar => DirPath ar -> IO Bool
doesDirectoryExist forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DirPath ar
dir forall os ar fd. DirPath os ar -> RelPath os fd -> Path os ar fd
</>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 =
    forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem [FilePath
".",FilePath
".."]) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    FilePath -> IO [FilePath]
SD.getDirectoryContents (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 = forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 = forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 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 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 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 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString FilePath ar1
p1) (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 (forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString FilePath ar1
p1) (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 = forall ar fd. (AbsRel ar, FileDir fd) => FilePath -> Path ar fd
path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
SD.canonicalizePath (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 =
    forall ar fd. (AbsRel ar, FileDir fd) => FilePath -> Path ar fd
path forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO FilePath
SD.makeRelativeToCurrentDirectory (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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall ar fd. (AbsRel ar, FileDir fd) => FilePath -> Path ar fd
path 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 (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 (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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO UTCTime
SD.getModificationTime (forall ar fd. (AbsRel ar, FileDir fd) => Path ar fd -> FilePath
Path.toString Path ar fd
p)