{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE NoImplicitPrelude #-}

module System.FilePath.FilePather.Directory(
  createDirectory
, createDirectoryIfMissing
, removeDirectory
, removeDirectoryRecursive
, removePathForcibly
, renameDirectory
, listDirectory
, getDirectoryContents
, withCurrentDirectory
, getXdgDirectory
, getAppUserDataDirectory
, removeFile
, renameFile
, renamePath
, copyFile
, copyFileWithMetadata
, getFileSize
, canonicalizePath
, makeAbsolute
, makeRelativeToCurrentDirectory
, doesPathExist
, doesFileExist
, doesDirectoryExist
, findExecutable
, findExecutables
, findExecutablesInDirectories
, findFile
, findFiles
, findFileWith
, findFilesWith
, createFileLink
, createDirectoryLink
, removeDirectoryLink
, pathIsSymbolicLink
, getSymbolicLinkTarget
, getPermissions
, setPermissions
, copyPermissions
, getAccessTime
, getModificationTime
, setAccessTime
, setModificationTime
, module SD
) where

import Control.Category ( Category((.)) )
import Control.Lens ( over, _Wrapped )
import Data.Maybe ( Maybe )
import Data.Bool ( Bool )
import Data.Time ( UTCTime )
import GHC.Num( Integer )
import qualified System.Directory as D
import System.Directory as SD(getCurrentDirectory, getHomeDirectory, XdgDirectory(..), XdgDirectoryList(..), getXdgDirectoryList, getUserDocumentsDirectory, getTemporaryDirectory, exeExtension, Permissions(..), emptyPermissions, readable, writable, executable, searchable, setOwnerReadable, setOwnerWritable, setOwnerExecutable, setOwnerSearchable)
import System.FilePath.FilePather.ReadFilePath
    ( ReadFilePathT(..) )
import System.FilePath ( FilePath )
import System.IO ( IO )

createDirectory ::
  ReadFilePathT IO ()
createDirectory :: ReadFilePathT IO ()
createDirectory =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO ()
D.createDirectory

createDirectoryIfMissing ::
  Bool
  -> ReadFilePathT IO ()
createDirectoryIfMissing :: Bool -> ReadFilePathT IO ()
createDirectoryIfMissing =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO ()) -> ReadFilePathT IO ())
-> (Bool -> FilePath -> IO ()) -> Bool -> ReadFilePathT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bool -> FilePath -> IO ()
D.createDirectoryIfMissing

removeDirectory ::
  ReadFilePathT IO ()
removeDirectory :: ReadFilePathT IO ()
removeDirectory =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO ()
D.removeDirectory

removeDirectoryRecursive ::
  ReadFilePathT IO ()
removeDirectoryRecursive :: ReadFilePathT IO ()
removeDirectoryRecursive =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO ()
D.removeDirectoryRecursive

removePathForcibly ::
  ReadFilePathT IO ()
removePathForcibly :: ReadFilePathT IO ()
removePathForcibly =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO ()
D.removePathForcibly

renameDirectory ::
  FilePath
  -> ReadFilePathT IO ()
renameDirectory :: FilePath -> ReadFilePathT IO ()
renameDirectory =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO ()) -> ReadFilePathT IO ())
-> (FilePath -> FilePath -> IO ())
-> FilePath
-> ReadFilePathT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> FilePath -> IO ()
D.renameDirectory

listDirectory ::
  ReadFilePathT IO [FilePath]
listDirectory :: ReadFilePathT IO [FilePath]
listDirectory =
  (FilePath -> IO [FilePath]) -> ReadFilePathT IO [FilePath]
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO [FilePath]
D.listDirectory

getDirectoryContents ::
  ReadFilePathT IO [FilePath]
getDirectoryContents :: ReadFilePathT IO [FilePath]
getDirectoryContents =
  (FilePath -> IO [FilePath]) -> ReadFilePathT IO [FilePath]
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO [FilePath]
D.listDirectory

withCurrentDirectory ::
  IO a
  -> ReadFilePathT IO a
withCurrentDirectory :: IO a -> ReadFilePathT IO a
withCurrentDirectory IO a
io =
  (FilePath -> IO a) -> ReadFilePathT IO a
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT (FilePath -> IO a -> IO a
forall a. FilePath -> IO a -> IO a
`D.withCurrentDirectory` IO a
io)

getXdgDirectory ::
  XdgDirectory
  -> ReadFilePathT IO FilePath
getXdgDirectory :: XdgDirectory -> ReadFilePathT IO FilePath
getXdgDirectory XdgDirectory
xdg =
  (FilePath -> IO FilePath) -> ReadFilePathT IO FilePath
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT (XdgDirectory -> FilePath -> IO FilePath
D.getXdgDirectory XdgDirectory
xdg)

getAppUserDataDirectory ::
  ReadFilePathT IO FilePath
getAppUserDataDirectory :: ReadFilePathT IO FilePath
getAppUserDataDirectory =
  (FilePath -> IO FilePath) -> ReadFilePathT IO FilePath
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO FilePath
D.getAppUserDataDirectory

removeFile ::
  ReadFilePathT IO ()
removeFile :: ReadFilePathT IO ()
removeFile =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO ()
D.removeFile

renameFile ::
  FilePath
  -> ReadFilePathT IO ()
renameFile :: FilePath -> ReadFilePathT IO ()
renameFile =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO ()) -> ReadFilePathT IO ())
-> (FilePath -> FilePath -> IO ())
-> FilePath
-> ReadFilePathT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> FilePath -> IO ()
D.renameFile

renamePath ::
  FilePath
  -> ReadFilePathT IO ()
renamePath :: FilePath -> ReadFilePathT IO ()
renamePath =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO ()) -> ReadFilePathT IO ())
-> (FilePath -> FilePath -> IO ())
-> FilePath
-> ReadFilePathT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> FilePath -> IO ()
D.renamePath

copyFile ::
  FilePath
  -> ReadFilePathT IO ()
copyFile :: FilePath -> ReadFilePathT IO ()
copyFile =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO ()) -> ReadFilePathT IO ())
-> (FilePath -> FilePath -> IO ())
-> FilePath
-> ReadFilePathT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> FilePath -> IO ()
D.copyFile

copyFileWithMetadata ::
  FilePath
  -> ReadFilePathT IO ()
copyFileWithMetadata :: FilePath -> ReadFilePathT IO ()
copyFileWithMetadata =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO ()) -> ReadFilePathT IO ())
-> (FilePath -> FilePath -> IO ())
-> FilePath
-> ReadFilePathT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> FilePath -> IO ()
D.copyFileWithMetadata

getFileSize ::
  ReadFilePathT IO Integer
getFileSize :: ReadFilePathT IO Integer
getFileSize =
  (FilePath -> IO Integer) -> ReadFilePathT IO Integer
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO Integer
D.getFileSize

canonicalizePath ::
  ReadFilePathT IO FilePath
canonicalizePath :: ReadFilePathT IO FilePath
canonicalizePath =
  (FilePath -> IO FilePath) -> ReadFilePathT IO FilePath
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO FilePath
D.canonicalizePath

makeAbsolute ::
  ReadFilePathT IO FilePath
makeAbsolute :: ReadFilePathT IO FilePath
makeAbsolute =
  (FilePath -> IO FilePath) -> ReadFilePathT IO FilePath
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO FilePath
D.makeAbsolute

makeRelativeToCurrentDirectory ::
  ReadFilePathT IO FilePath
makeRelativeToCurrentDirectory :: ReadFilePathT IO FilePath
makeRelativeToCurrentDirectory =
  (FilePath -> IO FilePath) -> ReadFilePathT IO FilePath
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO FilePath
D.makeRelativeToCurrentDirectory

doesPathExist ::
  ReadFilePathT IO Bool
doesPathExist :: ReadFilePathT IO Bool
doesPathExist =
  (FilePath -> IO Bool) -> ReadFilePathT IO Bool
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO Bool
D.doesPathExist

doesFileExist ::
  ReadFilePathT IO Bool
doesFileExist :: ReadFilePathT IO Bool
doesFileExist =
  (FilePath -> IO Bool) -> ReadFilePathT IO Bool
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO Bool
D.doesFileExist

doesDirectoryExist ::
  ReadFilePathT IO Bool
doesDirectoryExist :: ReadFilePathT IO Bool
doesDirectoryExist =
  (FilePath -> IO Bool) -> ReadFilePathT IO Bool
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO Bool
D.doesDirectoryExist

findExecutable ::
  ReadFilePathT IO (Maybe FilePath)
findExecutable :: ReadFilePathT IO (Maybe FilePath)
findExecutable =
  (FilePath -> IO (Maybe FilePath))
-> ReadFilePathT IO (Maybe FilePath)
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO (Maybe FilePath)
D.findExecutable

findExecutables ::
  ReadFilePathT IO [FilePath]
findExecutables :: ReadFilePathT IO [FilePath]
findExecutables =
  (FilePath -> IO [FilePath]) -> ReadFilePathT IO [FilePath]
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO [FilePath]
D.findExecutables

findExecutablesInDirectories ::
  [FilePath]
  -> ReadFilePathT IO [FilePath]
findExecutablesInDirectories :: [FilePath] -> ReadFilePathT IO [FilePath]
findExecutablesInDirectories =
  (FilePath -> IO [FilePath]) -> ReadFilePathT IO [FilePath]
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO [FilePath]) -> ReadFilePathT IO [FilePath])
-> ([FilePath] -> FilePath -> IO [FilePath])
-> [FilePath]
-> ReadFilePathT IO [FilePath]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [FilePath] -> FilePath -> IO [FilePath]
D.findExecutablesInDirectories

findFile ::
  [FilePath]
  -> ReadFilePathT IO (Maybe FilePath)
findFile :: [FilePath] -> ReadFilePathT IO (Maybe FilePath)
findFile =
  (FilePath -> IO (Maybe FilePath))
-> ReadFilePathT IO (Maybe FilePath)
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO (Maybe FilePath))
 -> ReadFilePathT IO (Maybe FilePath))
-> ([FilePath] -> FilePath -> IO (Maybe FilePath))
-> [FilePath]
-> ReadFilePathT IO (Maybe FilePath)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [FilePath] -> FilePath -> IO (Maybe FilePath)
D.findFile

findFiles ::
  [FilePath]
  -> ReadFilePathT IO [FilePath]
findFiles :: [FilePath] -> ReadFilePathT IO [FilePath]
findFiles =
  (FilePath -> IO [FilePath]) -> ReadFilePathT IO [FilePath]
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO [FilePath]) -> ReadFilePathT IO [FilePath])
-> ([FilePath] -> FilePath -> IO [FilePath])
-> [FilePath]
-> ReadFilePathT IO [FilePath]
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [FilePath] -> FilePath -> IO [FilePath]
D.findFiles

findFileWith ::
  ReadFilePathT IO Bool
  -> [FilePath]
  -> ReadFilePathT IO (Maybe FilePath)
findFileWith :: ReadFilePathT IO Bool
-> [FilePath] -> ReadFilePathT IO (Maybe FilePath)
findFileWith ReadFilePathT IO Bool
x [FilePath]
ps =
  ASetter
  (ReadFilePathT IO Bool)
  (ReadFilePathT IO (Maybe FilePath))
  (FilePath -> IO Bool)
  (FilePath -> IO (Maybe FilePath))
-> ((FilePath -> IO Bool) -> FilePath -> IO (Maybe FilePath))
-> ReadFilePathT IO Bool
-> ReadFilePathT IO (Maybe FilePath)
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ReadFilePathT IO Bool)
  (ReadFilePathT IO (Maybe FilePath))
  (FilePath -> IO Bool)
  (FilePath -> IO (Maybe FilePath))
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((FilePath -> IO Bool)
-> [FilePath] -> FilePath -> IO (Maybe FilePath)
`D.findFileWith` [FilePath]
ps) ReadFilePathT IO Bool
x

findFilesWith ::
  ReadFilePathT IO Bool
  -> [FilePath]
  -> ReadFilePathT IO [FilePath]
findFilesWith :: ReadFilePathT IO Bool -> [FilePath] -> ReadFilePathT IO [FilePath]
findFilesWith ReadFilePathT IO Bool
x [FilePath]
ps =
  ASetter
  (ReadFilePathT IO Bool)
  (ReadFilePathT IO [FilePath])
  (FilePath -> IO Bool)
  (FilePath -> IO [FilePath])
-> ((FilePath -> IO Bool) -> FilePath -> IO [FilePath])
-> ReadFilePathT IO Bool
-> ReadFilePathT IO [FilePath]
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (ReadFilePathT IO Bool)
  (ReadFilePathT IO [FilePath])
  (FilePath -> IO Bool)
  (FilePath -> IO [FilePath])
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((FilePath -> IO Bool) -> [FilePath] -> FilePath -> IO [FilePath]
`D.findFilesWith` [FilePath]
ps) ReadFilePathT IO Bool
x

createFileLink ::
  FilePath
  -> ReadFilePathT IO ()
createFileLink :: FilePath -> ReadFilePathT IO ()
createFileLink =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO ()) -> ReadFilePathT IO ())
-> (FilePath -> FilePath -> IO ())
-> FilePath
-> ReadFilePathT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> FilePath -> IO ()
D.createFileLink

createDirectoryLink ::
  FilePath
  -> ReadFilePathT IO ()
createDirectoryLink :: FilePath -> ReadFilePathT IO ()
createDirectoryLink =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO ()) -> ReadFilePathT IO ())
-> (FilePath -> FilePath -> IO ())
-> FilePath
-> ReadFilePathT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> FilePath -> IO ()
D.createDirectoryLink

removeDirectoryLink ::
  ReadFilePathT IO ()
removeDirectoryLink :: ReadFilePathT IO ()
removeDirectoryLink =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO ()
D.removeDirectoryLink

pathIsSymbolicLink ::
  ReadFilePathT IO Bool
pathIsSymbolicLink :: ReadFilePathT IO Bool
pathIsSymbolicLink =
  (FilePath -> IO Bool) -> ReadFilePathT IO Bool
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO Bool
D.pathIsSymbolicLink

getSymbolicLinkTarget ::
  ReadFilePathT IO FilePath
getSymbolicLinkTarget :: ReadFilePathT IO FilePath
getSymbolicLinkTarget =
  (FilePath -> IO FilePath) -> ReadFilePathT IO FilePath
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO FilePath
D.getSymbolicLinkTarget

getPermissions ::
  ReadFilePathT IO Permissions
getPermissions :: ReadFilePathT IO Permissions
getPermissions =
  (FilePath -> IO Permissions) -> ReadFilePathT IO Permissions
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO Permissions
D.getPermissions

setPermissions ::
  Permissions
  -> ReadFilePathT IO ()
setPermissions :: Permissions -> ReadFilePathT IO ()
setPermissions Permissions
p =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT (FilePath -> Permissions -> IO ()
`D.setPermissions` Permissions
p)

copyPermissions ::
  FilePath
  -> ReadFilePathT IO ()
copyPermissions :: FilePath -> ReadFilePathT IO ()
copyPermissions =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT ((FilePath -> IO ()) -> ReadFilePathT IO ())
-> (FilePath -> FilePath -> IO ())
-> FilePath
-> ReadFilePathT IO ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> FilePath -> IO ()
D.copyPermissions

getAccessTime ::
  ReadFilePathT IO UTCTime
getAccessTime :: ReadFilePathT IO UTCTime
getAccessTime =
  (FilePath -> IO UTCTime) -> ReadFilePathT IO UTCTime
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO UTCTime
D.getAccessTime

getModificationTime ::
  ReadFilePathT IO UTCTime
getModificationTime :: ReadFilePathT IO UTCTime
getModificationTime =
  (FilePath -> IO UTCTime) -> ReadFilePathT IO UTCTime
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT FilePath -> IO UTCTime
D.getModificationTime

setAccessTime ::
  UTCTime
  -> ReadFilePathT IO ()
setAccessTime :: UTCTime -> ReadFilePathT IO ()
setAccessTime UTCTime
u =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT (FilePath -> UTCTime -> IO ()
`D.setAccessTime` UTCTime
u)

setModificationTime ::
  UTCTime
  -> ReadFilePathT IO ()
setModificationTime :: UTCTime -> ReadFilePathT IO ()
setModificationTime UTCTime
u =
  (FilePath -> IO ()) -> ReadFilePathT IO ()
forall (f :: * -> *) a. (FilePath -> f a) -> ReadFilePathT f a
ReadFilePathT (FilePath -> UTCTime -> IO ()
`D.setModificationTime` UTCTime
u)