{-# 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.Exception ( Exception )
import Control.Lens ( over, _Wrapped )
import Data.Maybe ( Maybe, maybe )
import Data.Bool ( Bool(..) )
import Data.Either ( Either(Right, Left), either )
import Data.Functor ( Functor(fmap) )
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
    ( ReadFilePathT1,
      ReadFilePathT,
      successReadFilePath,
      tryReadFilePath )
import System.FilePath ( FilePath )
import System.IO ( IO )

createDirectory ::
  Exception e =>
  ReadFilePathT1 e IO
createDirectory :: forall e. Exception e => ReadFilePathT1 e IO
createDirectory =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO ()
D.createDirectory
{-# INLINE createDirectory #-}

createDirectoryIfMissing ::
  Exception e =>
  Bool
  -> ReadFilePathT1 e IO
createDirectoryIfMissing :: forall e. Exception e => Bool -> ReadFilePathT1 e IO
createDirectoryIfMissing =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath 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
{-# INLINE createDirectoryIfMissing #-}

removeDirectory ::
  Exception e =>
  ReadFilePathT1 e IO
removeDirectory :: forall e. Exception e => ReadFilePathT1 e IO
removeDirectory =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO ()
D.removeDirectory
{-# INLINE removeDirectory #-}

removeDirectoryRecursive ::
  Exception e =>
  ReadFilePathT1 e IO
removeDirectoryRecursive :: forall e. Exception e => ReadFilePathT1 e IO
removeDirectoryRecursive =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO ()
D.removeDirectoryRecursive
{-# INLINE removeDirectoryRecursive #-}

removePathForcibly ::
  Exception e =>
  ReadFilePathT1 e IO
removePathForcibly :: forall e. Exception e => ReadFilePathT1 e IO
removePathForcibly =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO ()
D.removePathForcibly
{-# INLINE removePathForcibly #-}

renameDirectory ::
  Exception e =>
  FilePath
  -> ReadFilePathT1 e IO
renameDirectory :: forall e. Exception e => FilePath -> ReadFilePathT1 e IO
renameDirectory =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath 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
{-# INLINE renameDirectory #-}

listDirectory ::
  Exception e =>
  ReadFilePathT e IO [FilePath]
listDirectory :: forall e. Exception e => ReadFilePathT e IO [FilePath]
listDirectory =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO [FilePath]
D.listDirectory
{-# INLINE listDirectory #-}

getDirectoryContents ::
  Exception e =>
  ReadFilePathT e IO [FilePath]
getDirectoryContents :: forall e. Exception e => ReadFilePathT e IO [FilePath]
getDirectoryContents =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO [FilePath]
D.listDirectory
{-# INLINE getDirectoryContents #-}

withCurrentDirectory ::
  Exception e =>
  IO a
  -> ReadFilePathT e IO a
withCurrentDirectory :: forall e a. Exception e => IO a -> ReadFilePathT e IO a
withCurrentDirectory IO a
io =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (forall a. FilePath -> IO a -> IO a
`D.withCurrentDirectory` IO a
io)
{-# INLINE withCurrentDirectory #-}

getXdgDirectory ::
  Exception e =>
  XdgDirectory
  -> ReadFilePathT e IO FilePath
getXdgDirectory :: forall e.
Exception e =>
XdgDirectory -> ReadFilePathT e IO FilePath
getXdgDirectory XdgDirectory
xdg =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (XdgDirectory -> FilePath -> IO FilePath
D.getXdgDirectory XdgDirectory
xdg)
{-# INLINE getXdgDirectory #-}

getAppUserDataDirectory ::
  Exception e =>
  ReadFilePathT e IO FilePath
getAppUserDataDirectory :: forall e. Exception e => ReadFilePathT e IO FilePath
getAppUserDataDirectory =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO FilePath
D.getAppUserDataDirectory
{-# INLINE getAppUserDataDirectory #-}

removeFile ::
  Exception e =>
  ReadFilePathT1 e IO
removeFile :: forall e. Exception e => ReadFilePathT1 e IO
removeFile =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO ()
D.removeFile
{-# INLINE removeFile #-}

renameFile ::
  Exception e =>
  FilePath
  -> ReadFilePathT1 e IO
renameFile :: forall e. Exception e => FilePath -> ReadFilePathT1 e IO
renameFile =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath 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
{-# INLINE renameFile #-}

renamePath ::
  Exception e =>
  FilePath
  -> ReadFilePathT1 e IO
renamePath :: forall e. Exception e => FilePath -> ReadFilePathT1 e IO
renamePath =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath 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
{-# INLINE renamePath #-}

copyFile ::
  Exception e =>
  FilePath
  -> ReadFilePathT1 e IO
copyFile :: forall e. Exception e => FilePath -> ReadFilePathT1 e IO
copyFile =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath 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
{-# INLINE copyFile #-}

copyFileWithMetadata ::
  Exception e =>
  FilePath
  -> ReadFilePathT1 e IO
copyFileWithMetadata :: forall e. Exception e => FilePath -> ReadFilePathT1 e IO
copyFileWithMetadata =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath 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
{-# INLINE copyFileWithMetadata #-}

getFileSize ::
  Exception e =>
  ReadFilePathT e IO Integer
getFileSize :: forall e. Exception e => ReadFilePathT e IO Integer
getFileSize =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO Integer
D.getFileSize
{-# INLINE getFileSize #-}

canonicalizePath ::
  Exception e =>
  ReadFilePathT e IO FilePath
canonicalizePath :: forall e. Exception e => ReadFilePathT e IO FilePath
canonicalizePath =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO FilePath
D.canonicalizePath
{-# INLINE canonicalizePath #-}

makeAbsolute ::
  Exception e =>
  ReadFilePathT e IO FilePath
makeAbsolute :: forall e. Exception e => ReadFilePathT e IO FilePath
makeAbsolute =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO FilePath
D.makeAbsolute
{-# INLINE makeAbsolute #-}

makeRelativeToCurrentDirectory ::
  Exception e =>
  ReadFilePathT e IO FilePath
makeRelativeToCurrentDirectory :: forall e. Exception e => ReadFilePathT e IO FilePath
makeRelativeToCurrentDirectory =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO FilePath
D.makeRelativeToCurrentDirectory
{-# INLINE makeRelativeToCurrentDirectory #-}

doesPathExist ::
  ReadFilePathT e IO Bool
doesPathExist :: forall e. ReadFilePathT e IO Bool
doesPathExist =
  forall (f :: * -> *) a e.
Functor f =>
(FilePath -> f a) -> ReadFilePathT e f a
successReadFilePath FilePath -> IO Bool
D.doesPathExist
{-# INLINE doesPathExist #-}

doesFileExist ::
  ReadFilePathT e IO Bool
doesFileExist :: forall e. ReadFilePathT e IO Bool
doesFileExist =
  forall (f :: * -> *) a e.
Functor f =>
(FilePath -> f a) -> ReadFilePathT e f a
successReadFilePath FilePath -> IO Bool
D.doesFileExist
{-# INLINE doesFileExist #-}

doesDirectoryExist ::
  ReadFilePathT e IO Bool
doesDirectoryExist :: forall e. ReadFilePathT e IO Bool
doesDirectoryExist =
  forall (f :: * -> *) a e.
Functor f =>
(FilePath -> f a) -> ReadFilePathT e f a
successReadFilePath FilePath -> IO Bool
D.doesDirectoryExist
{-# INLINE doesDirectoryExist #-}

findExecutable ::
  ReadFilePathT e IO (Maybe FilePath)
findExecutable :: forall e. ReadFilePathT e IO (Maybe FilePath)
findExecutable =
  forall (f :: * -> *) a e.
Functor f =>
(FilePath -> f a) -> ReadFilePathT e f a
successReadFilePath FilePath -> IO (Maybe FilePath)
D.findExecutable
{-# INLINE findExecutable #-}

findExecutables ::
  ReadFilePathT e IO [FilePath]
findExecutables :: forall e. ReadFilePathT e IO [FilePath]
findExecutables =
  forall (f :: * -> *) a e.
Functor f =>
(FilePath -> f a) -> ReadFilePathT e f a
successReadFilePath FilePath -> IO [FilePath]
D.findExecutables
{-# INLINE findExecutables #-}

findExecutablesInDirectories ::
  [FilePath]
  -> ReadFilePathT e IO [FilePath]
findExecutablesInDirectories :: forall e. [FilePath] -> ReadFilePathT e IO [FilePath]
findExecutablesInDirectories =
  forall (f :: * -> *) a e.
Functor f =>
(FilePath -> f a) -> ReadFilePathT e f a
successReadFilePath 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
{-# INLINE findExecutablesInDirectories #-}

findFile ::
  [FilePath]
  -> ReadFilePathT e IO (Maybe FilePath)
findFile :: forall e. [FilePath] -> ReadFilePathT e IO (Maybe FilePath)
findFile =
  forall (f :: * -> *) a e.
Functor f =>
(FilePath -> f a) -> ReadFilePathT e f a
successReadFilePath 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
{-# INLINE findFile #-}

findFiles ::
  [FilePath]
  -> ReadFilePathT e IO [FilePath]
findFiles :: forall e. [FilePath] -> ReadFilePathT e IO [FilePath]
findFiles =
  forall (f :: * -> *) a e.
Functor f =>
(FilePath -> f a) -> ReadFilePathT e f a
successReadFilePath 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
{-# INLINE findFiles #-}

findFileWith ::
  ReadFilePathT () IO ()
  -> [FilePath]
  -> ReadFilePathT () IO FilePath
findFileWith :: ReadFilePathT () IO ()
-> [FilePath] -> ReadFilePathT () IO FilePath
findFileWith ReadFilePathT () IO ()
x [FilePath]
ps =
  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped (\FilePath -> IO (Either () ())
k -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a b. a -> Either a b
Left ()) forall a b. b -> Either a b
Right) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FilePath -> IO Bool)
-> [FilePath] -> FilePath -> IO (Maybe FilePath)
D.findFileWith (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\() -> Bool
False) (\() -> Bool
True)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> IO (Either () ())
k) [FilePath]
ps) ReadFilePathT () IO ()
x
{-# INLINE findFileWith #-}

findFilesWith ::
  ReadFilePathT () IO ()
  -> [FilePath]
  -> ReadFilePathT e' IO [FilePath]
findFilesWith :: forall e'.
ReadFilePathT () IO ()
-> [FilePath] -> ReadFilePathT e' IO [FilePath]
findFilesWith ReadFilePathT () IO ()
x [FilePath]
ps =
  forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped (\FilePath -> IO (Either () ())
w -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (FilePath -> IO Bool) -> [FilePath] -> FilePath -> IO [FilePath]
D.findFilesWith (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\() -> Bool
False) (\() -> Bool
True)) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. FilePath -> IO (Either () ())
w) [FilePath]
ps) ReadFilePathT () IO ()
x
{-# INLINE findFilesWith #-}

createFileLink ::
  Exception e =>
  FilePath
  -> ReadFilePathT1 e IO
createFileLink :: forall e. Exception e => FilePath -> ReadFilePathT1 e IO
createFileLink =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath 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
{-# INLINE createFileLink #-}

createDirectoryLink ::
  Exception e =>
  FilePath
  -> ReadFilePathT1 e IO
createDirectoryLink :: forall e. Exception e => FilePath -> ReadFilePathT1 e IO
createDirectoryLink =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath 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
{-# INLINE createDirectoryLink #-}

removeDirectoryLink ::
  Exception e =>
  ReadFilePathT1 e IO
removeDirectoryLink :: forall e. Exception e => ReadFilePathT1 e IO
removeDirectoryLink =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO ()
D.removeDirectoryLink
{-# INLINE removeDirectoryLink #-}

pathIsSymbolicLink ::
  Exception e =>
  ReadFilePathT e IO Bool
pathIsSymbolicLink :: forall e. Exception e => ReadFilePathT e IO Bool
pathIsSymbolicLink =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO Bool
D.pathIsSymbolicLink
{-# INLINE pathIsSymbolicLink #-}

getSymbolicLinkTarget ::
  Exception e =>
  ReadFilePathT e IO FilePath
getSymbolicLinkTarget :: forall e. Exception e => ReadFilePathT e IO FilePath
getSymbolicLinkTarget =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO FilePath
D.getSymbolicLinkTarget
{-# INLINE getSymbolicLinkTarget #-}

getPermissions ::
  Exception e =>
  ReadFilePathT e IO Permissions
getPermissions :: forall e. Exception e => ReadFilePathT e IO Permissions
getPermissions =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO Permissions
D.getPermissions
{-# INLINE getPermissions #-}

setPermissions ::
  Exception e =>
  Permissions
  -> ReadFilePathT1 e IO
setPermissions :: forall e. Exception e => Permissions -> ReadFilePathT1 e IO
setPermissions Permissions
p =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (FilePath -> Permissions -> IO ()
`D.setPermissions` Permissions
p)
{-# INLINE setPermissions #-}

copyPermissions ::
  Exception e =>
  FilePath
  -> ReadFilePathT1 e IO
copyPermissions :: forall e. Exception e => FilePath -> ReadFilePathT1 e IO
copyPermissions =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath 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
{-# INLINE copyPermissions #-}

getAccessTime ::
  Exception e =>
  ReadFilePathT e IO UTCTime
getAccessTime :: forall e. Exception e => ReadFilePathT e IO UTCTime
getAccessTime =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO UTCTime
D.getAccessTime
{-# INLINE getAccessTime #-}

getModificationTime ::
  Exception e =>
  ReadFilePathT e IO UTCTime
getModificationTime :: forall e. Exception e => ReadFilePathT e IO UTCTime
getModificationTime =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath FilePath -> IO UTCTime
D.getModificationTime
{-# INLINE getModificationTime #-}

setAccessTime ::
  Exception e =>
  UTCTime
  -> ReadFilePathT1 e IO
setAccessTime :: forall e. Exception e => UTCTime -> ReadFilePathT1 e IO
setAccessTime UTCTime
u =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (FilePath -> UTCTime -> IO ()
`D.setAccessTime` UTCTime
u)
{-# INLINE setAccessTime #-}

setModificationTime ::
  Exception e =>
  UTCTime
  -> ReadFilePathT1 e IO
setModificationTime :: forall e. Exception e => UTCTime -> ReadFilePathT1 e IO
setModificationTime UTCTime
u =
  forall e a.
Exception e =>
(FilePath -> IO a) -> ReadFilePathT e IO a
tryReadFilePath (FilePath -> UTCTime -> IO ()
`D.setModificationTime` UTCTime
u)
{-# INLINE setModificationTime #-}