{-# LANGUAGE UndecidableInstances #-}

-- | Provides a dynamic effect for the writable portion of "System.Directory"'s
-- interface.
--
-- @since 0.1
module Effectful.FileSystem.PathWriter.Dynamic
  ( -- * Effect
    PathWriter (..),
    createDirectory,
    createDirectoryIfMissing,
    removeDirectory,
    removeDirectoryRecursive,
    removePathForcibly,
    renameDirectory,
    setCurrentDirectory,
    withCurrentDirectory,
    removeFile,
    renameFile,
    renamePath,
    copyFile,
    copyFileWithMetadata,
    createFileLink,
    createDirectoryLink,
    removeDirectoryLink,
    setPermissions,
    copyPermissions,
    setAccessTime,
    setModificationTime,

    -- ** Handlers
    runPathWriter,

    -- * Copying

    -- ** Config
    CopyDirConfig (..),
    Overwrite (..),
    TargetName (..),
    Utils.defaultCopyDirConfig,

    -- ** Functions
    copyDirectoryRecursive,
    copyDirectoryRecursiveConfig,
    copySymbolicLink,

    -- ** Optics
    Utils._OverwriteNone,
    Utils._OverwriteDirectories,
    Utils._OverwriteAll,
    Utils._TargetNameSrc,
    Utils._TargetNameLiteral,
    Utils._TargetNameDest,

    -- * Removing
    -- $if-exists
    removeFileIfExists,
    removeFileIfExists_,
    removeDirectoryIfExists,
    removeDirectoryIfExists_,
    removeDirectoryRecursiveIfExists,
    removeDirectoryRecursiveIfExists_,
    removePathForciblyIfExists,
    removePathForciblyIfExists_,

    -- ** Symbolic Links
    removeSymbolicLink,
    removeSymbolicLinkIfExists,
    removeSymbolicLinkIfExists_,

    -- * Re-exports
    OsPath,
    IOException,
    Permissions,
    UTCTime (..),
  )
where

import Control.Exception (IOException)
import Control.Exception.Utils (onSyncException)
import Control.Monad (unless, void, when)
import Data.Foldable (for_, traverse_)
import Data.Functor (($>))
import Data.IORef (modifyIORef', newIORef, readIORef)
import Data.Time (UTCTime (UTCTime, utctDay, utctDayTime))
import Effectful
  ( Dispatch (Dynamic),
    DispatchOf,
    Eff,
    Effect,
    IOE,
    type (:>),
  )
import Effectful.Dispatch.Dynamic (localSeqUnlift, reinterpret, send)
import Effectful.Dispatch.Static (HasCallStack, unsafeEff_)
import Effectful.Dynamic.Utils (ShowEffect (showEffectCons))
import Effectful.Exception (mask_)
import Effectful.FileSystem.PathReader.Dynamic
  ( PathReader,
    PathType (PathTypeDirectory, PathTypeSymbolicLink),
  )
import Effectful.FileSystem.PathReader.Dynamic qualified as PR
import Effectful.FileSystem.PathWriter.Static qualified as Static
import Effectful.FileSystem.PathWriter.Utils
  ( CopyDirConfig (MkCopyDirConfig, overwrite, targetName),
    Overwrite (OverwriteAll, OverwriteDirectories, OverwriteNone),
    TargetName (TargetNameDest, TargetNameLiteral, TargetNameSrc),
  )
import Effectful.FileSystem.PathWriter.Utils qualified as Utils
import FileSystem.IO qualified as FS.IO
import FileSystem.OsPath (OsPath, (</>))
import Optics.Core ((^.))
import System.Directory (Permissions)
import System.IO.Error qualified as Error
import System.OsPath qualified as FP

-- | Effect for writing paths.
--
-- @since 0.1
data PathWriter :: Effect where
  CreateDirectory :: OsPath -> PathWriter m ()
  CreateDirectoryIfMissing :: Bool -> OsPath -> PathWriter m ()
  RemoveDirectory :: OsPath -> PathWriter m ()
  RemoveDirectoryRecursive :: OsPath -> PathWriter m ()
  RemovePathForcibly :: OsPath -> PathWriter m ()
  RenameDirectory :: OsPath -> OsPath -> PathWriter m ()
  SetCurrentDirectory :: OsPath -> PathWriter m ()
  WithCurrentDirectory :: OsPath -> m a -> PathWriter m a
  RemoveFile :: OsPath -> PathWriter m ()
  RenameFile :: OsPath -> OsPath -> PathWriter m ()
  RenamePath :: OsPath -> OsPath -> PathWriter m ()
  CopyFile :: OsPath -> OsPath -> PathWriter m ()
  CopyFileWithMetadata :: OsPath -> OsPath -> PathWriter m ()
  CreateFileLink :: OsPath -> OsPath -> PathWriter m ()
  CreateDirectoryLink :: OsPath -> OsPath -> PathWriter m ()
  RemoveDirectoryLink :: OsPath -> PathWriter m ()
  SetPermissions :: OsPath -> Permissions -> PathWriter m ()
  CopyPermissions :: OsPath -> OsPath -> PathWriter m ()
  SetAccessTime :: OsPath -> UTCTime -> PathWriter m ()
  SetModificationTime :: OsPath -> UTCTime -> PathWriter m ()

-- | @since 0.1
type instance DispatchOf PathWriter = Dynamic

-- | @since 0.1
instance ShowEffect PathWriter where
  showEffectCons :: forall (m :: * -> *) a. PathWriter m a -> String
showEffectCons = \case
    CreateDirectory OsPath
_ -> String
"CreateDirectory"
    CreateDirectoryIfMissing Bool
_ OsPath
_ -> String
"CreateDirectoryIfMissing"
    RemoveDirectory OsPath
_ -> String
"RemoveDirectory"
    RemoveDirectoryRecursive OsPath
_ -> String
"RemoveDirectoryRecursive"
    RemovePathForcibly OsPath
_ -> String
"RemovePathForcibly"
    RenameDirectory OsPath
_ OsPath
_ -> String
"RenameDirectory"
    SetCurrentDirectory OsPath
_ -> String
"SetCurrentDirectory"
    WithCurrentDirectory OsPath
_ m a
_ -> String
"WithCurrentDirectory"
    RemoveFile OsPath
_ -> String
"RemoveFile"
    RenameFile OsPath
_ OsPath
_ -> String
"RenameFile"
    RenamePath OsPath
_ OsPath
_ -> String
"RenamePath"
    CopyFile OsPath
_ OsPath
_ -> String
"CopyFile"
    CopyFileWithMetadata OsPath
_ OsPath
_ -> String
"CopyFileWithMetadata"
    CreateFileLink OsPath
_ OsPath
_ -> String
"CreateFileLink"
    CreateDirectoryLink OsPath
_ OsPath
_ -> String
"CreateDirectoryLink"
    RemoveDirectoryLink OsPath
_ -> String
"RemoveDirectoryLink"
    SetPermissions OsPath
_ Permissions
_ -> String
"SetPermissions"
    CopyPermissions OsPath
_ OsPath
_ -> String
"CopyPermissions"
    SetAccessTime OsPath
_ UTCTime
_ -> String
"SetAccessTime"
    SetModificationTime OsPath
_ UTCTime
_ -> String
"SetModificationTime"

-- | Runs 'PathWriter' in 'IO'.
--
-- @since 0.1
runPathWriter ::
  ( HasCallStack,
    IOE :> es
  ) =>
  Eff (PathWriter : es) a ->
  Eff es a
runPathWriter :: forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (PathWriter : es) a -> Eff es a
runPathWriter = (Eff (PathWriter : es) a -> Eff es a)
-> EffectHandler PathWriter (PathWriter : es)
-> Eff (PathWriter : es) a
-> Eff es a
forall (e :: (* -> *) -> * -> *)
       (handlerEs :: [(* -> *) -> * -> *]) a (es :: [(* -> *) -> * -> *])
       b.
(HasCallStack, DispatchOf e ~ 'Dynamic) =>
(Eff handlerEs a -> Eff es b)
-> EffectHandler e handlerEs -> Eff (e : es) a -> Eff es b
reinterpret Eff (PathWriter : es) a -> Eff es a
forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, IOE :> es) =>
Eff (PathWriter : es) a -> Eff es a
Static.runPathWriter (EffectHandler PathWriter (PathWriter : es)
 -> Eff (PathWriter : es) a -> Eff es a)
-> EffectHandler PathWriter (PathWriter : es)
-> Eff (PathWriter : es) a
-> Eff es a
forall a b. (a -> b) -> a -> b
$ \LocalEnv localEs (PathWriter : es)
env -> \case
  CreateDirectory OsPath
p -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
Static.createDirectory OsPath
p
  CreateDirectoryIfMissing Bool
b OsPath
p -> Bool -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
Bool -> OsPath -> Eff es ()
Static.createDirectoryIfMissing Bool
b OsPath
p
  RemoveDirectory OsPath
p -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
Static.removeDirectory OsPath
p
  RemoveDirectoryRecursive OsPath
p -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
Static.removeDirectoryRecursive OsPath
p
  RemovePathForcibly OsPath
p -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
Static.removePathForcibly OsPath
p
  RenameDirectory OsPath
p OsPath
p' -> OsPath -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
Static.renameDirectory OsPath
p OsPath
p'
  SetCurrentDirectory OsPath
p -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
Static.setCurrentDirectory OsPath
p
  WithCurrentDirectory OsPath
p Eff localEs a
m -> LocalEnv localEs (PathWriter : es)
-> ((forall r. Eff localEs r -> Eff (PathWriter : es) r)
    -> Eff (PathWriter : es) a)
-> Eff (PathWriter : es) a
forall (es :: [(* -> *) -> * -> *])
       (handlerEs :: [(* -> *) -> * -> *])
       (localEs :: [(* -> *) -> * -> *]) a.
(HasCallStack, SharedSuffix es handlerEs) =>
LocalEnv localEs handlerEs
-> ((forall r. Eff localEs r -> Eff es r) -> Eff es a) -> Eff es a
localSeqUnlift LocalEnv localEs (PathWriter : es)
env (((forall r. Eff localEs r -> Eff (PathWriter : es) r)
  -> Eff (PathWriter : es) a)
 -> Eff (PathWriter : es) a)
-> ((forall r. Eff localEs r -> Eff (PathWriter : es) r)
    -> Eff (PathWriter : es) a)
-> Eff (PathWriter : es) a
forall a b. (a -> b) -> a -> b
$ \forall r. Eff localEs r -> Eff (PathWriter : es) r
runInStatic ->
    OsPath -> Eff (PathWriter : es) a -> Eff (PathWriter : es) a
forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es a -> Eff es a
Static.withCurrentDirectory OsPath
p (Eff localEs a -> Eff (PathWriter : es) a
forall r. Eff localEs r -> Eff (PathWriter : es) r
runInStatic Eff localEs a
m)
  RemoveFile OsPath
p -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
Static.removeFile OsPath
p
  RenameFile OsPath
p OsPath
p' -> OsPath -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
Static.renameFile OsPath
p OsPath
p'
  RenamePath OsPath
p OsPath
p' -> OsPath -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
Static.renamePath OsPath
p OsPath
p'
  CopyFile OsPath
p OsPath
p' -> OsPath -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
Static.copyFile OsPath
p OsPath
p'
  CopyFileWithMetadata OsPath
p OsPath
p' -> OsPath -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
Static.copyFileWithMetadata OsPath
p OsPath
p'
  CreateFileLink OsPath
p OsPath
p' -> OsPath -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
Static.createFileLink OsPath
p OsPath
p'
  CreateDirectoryLink OsPath
p OsPath
p' -> OsPath -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
Static.createDirectoryLink OsPath
p OsPath
p'
  RemoveDirectoryLink OsPath
p -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
Static.removeDirectoryLink OsPath
p
  SetPermissions OsPath
p Permissions
ps -> OsPath -> Permissions -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Permissions -> Eff es ()
Static.setPermissions OsPath
p Permissions
ps
  CopyPermissions OsPath
p OsPath
ps -> OsPath -> OsPath -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
Static.copyPermissions OsPath
p OsPath
ps
  SetAccessTime OsPath
p UTCTime
t -> OsPath -> UTCTime -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> UTCTime -> Eff es ()
Static.setAccessTime OsPath
p UTCTime
t
  SetModificationTime OsPath
p UTCTime
t -> OsPath -> UTCTime -> Eff (PathWriter : es) ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> UTCTime -> Eff es ()
Static.setModificationTime OsPath
p UTCTime
t

-- | Lifted 'Dir.createDirectory'.
--
-- @since 0.1
createDirectory ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  Eff es ()
createDirectory :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
createDirectory = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> PathWriter m ()
CreateDirectory

-- | Lifted 'Dir.createDirectoryIfMissing'.
--
-- @since 0.1
createDirectoryIfMissing ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  Bool ->
  OsPath ->
  Eff es ()
createDirectoryIfMissing :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
Bool -> OsPath -> Eff es ()
createDirectoryIfMissing Bool
b = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). Bool -> OsPath -> PathWriter m ()
CreateDirectoryIfMissing Bool
b

-- | Lifted 'Dir.removeDirectory'.
--
-- @since 0.1
removeDirectory ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  Eff es ()
removeDirectory :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectory = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> PathWriter m ()
RemoveDirectory

-- | Lifted 'Dir.removeDirectoryRecursive'.
--
-- @since 0.1
removeDirectoryRecursive ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  Eff es ()
removeDirectoryRecursive :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectoryRecursive = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> PathWriter m ()
RemoveDirectoryRecursive

-- | Lifted 'Dir.removePathForcibly'.
--
-- @since 0.1
removePathForcibly ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  Eff es ()
removePathForcibly :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removePathForcibly = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> PathWriter m ()
RemovePathForcibly

-- | Lifted 'Dir.renameDirectory'.
--
-- @since 0.1
renameDirectory ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  OsPath ->
  Eff es ()
renameDirectory :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
renameDirectory OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> OsPath -> PathWriter m ()
RenameDirectory OsPath
p

-- | Lifted 'Dir.setCurrentDirectory'.
--
-- @since 0.1
setCurrentDirectory ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  Eff es ()
setCurrentDirectory :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
setCurrentDirectory = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> PathWriter m ()
SetCurrentDirectory

-- | Lifted 'Dir.withCurrentDirectory'.
--
-- @since 0.1
withCurrentDirectory ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  Eff es a ->
  Eff es a
withCurrentDirectory :: forall (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es a -> Eff es a
withCurrentDirectory OsPath
p = PathWriter (Eff es) a -> Eff es a
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) a -> Eff es a)
-> (Eff es a -> PathWriter (Eff es) a) -> Eff es a -> Eff es a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es a -> PathWriter (Eff es) a
forall (m :: * -> *) a. OsPath -> m a -> PathWriter m a
WithCurrentDirectory OsPath
p

-- | Lifted 'Dir.removeFile'.
--
-- @since 0.1
removeFile ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  Eff es ()
removeFile :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeFile = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> PathWriter m ()
RemoveFile

-- | Lifted 'Dir.renameFile'.
--
-- @since 0.1
renameFile ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  OsPath ->
  Eff es ()
renameFile :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
renameFile OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> OsPath -> PathWriter m ()
RenameFile OsPath
p

-- | Lifted 'Dir.renamePath'.
--
-- @since 0.1
renamePath ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  OsPath ->
  Eff es ()
renamePath :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
renamePath OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> OsPath -> PathWriter m ()
RenamePath OsPath
p

-- | Lifted 'Dir.copyFile'.
--
-- @since 0.1
copyFile ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  OsPath ->
  Eff es ()
copyFile :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copyFile OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> OsPath -> PathWriter m ()
CopyFile OsPath
p

-- | Lifted 'Dir.copyFileWithMetadata'.
--
-- @since 0.1
copyFileWithMetadata ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  OsPath ->
  Eff es ()
copyFileWithMetadata :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copyFileWithMetadata OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> OsPath -> PathWriter m ()
CopyFileWithMetadata OsPath
p

-- | Lifted 'Dir.createFileLink'.
--
-- @since 0.1
createFileLink ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  OsPath ->
  Eff es ()
createFileLink :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
createFileLink OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> OsPath -> PathWriter m ()
CreateFileLink OsPath
p

-- | Lifted 'Dir.createDirectoryLink'.
--
-- @since 0.1
createDirectoryLink ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  OsPath ->
  Eff es ()
createDirectoryLink :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
createDirectoryLink OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> OsPath -> PathWriter m ()
CreateDirectoryLink OsPath
p

-- | Lifted 'Dir.removeDirectoryLink'.
--
-- @since 0.1
removeDirectoryLink ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  Eff es ()
removeDirectoryLink :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectoryLink = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> PathWriter m ()
RemoveDirectoryLink

-- | Lifted 'Dir.setPermissions'.
--
-- @since 0.1
setPermissions ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  Permissions ->
  Eff es ()
setPermissions :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Permissions -> Eff es ()
setPermissions OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (Permissions -> PathWriter (Eff es) ())
-> Permissions
-> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Permissions -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> Permissions -> PathWriter m ()
SetPermissions OsPath
p

-- | Lifted 'Dir.copyPermissions'.
--
-- @since 0.1
copyPermissions ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  OsPath ->
  Eff es ()
copyPermissions :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copyPermissions OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (OsPath -> PathWriter (Eff es) ()) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> OsPath -> PathWriter m ()
CopyPermissions OsPath
p

-- | Lifted 'Dir.setAccessTime'.
--
-- @since 0.1
setAccessTime ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  UTCTime ->
  Eff es ()
setAccessTime :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> UTCTime -> Eff es ()
setAccessTime OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (UTCTime -> PathWriter (Eff es) ()) -> UTCTime -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> UTCTime -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> UTCTime -> PathWriter m ()
SetAccessTime OsPath
p

-- | Lifted 'Dir.setModificationTime'.
--
-- @since 0.1
setModificationTime ::
  ( HasCallStack,
    PathWriter :> es
  ) =>
  OsPath ->
  UTCTime ->
  Eff es ()
setModificationTime :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> UTCTime -> Eff es ()
setModificationTime OsPath
p = PathWriter (Eff es) () -> Eff es ()
forall (e :: (* -> *) -> * -> *) (es :: [(* -> *) -> * -> *]) a.
(HasCallStack, DispatchOf e ~ 'Dynamic, e :> es) =>
e (Eff es) a -> Eff es a
send (PathWriter (Eff es) () -> Eff es ())
-> (UTCTime -> PathWriter (Eff es) ()) -> UTCTime -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> UTCTime -> PathWriter (Eff es) ()
forall (m :: * -> *). OsPath -> UTCTime -> PathWriter m ()
SetModificationTime OsPath
p

-- | Variant of 'removeFileIfExists' that ignores the return value.
--
-- @since 0.1
removeFileIfExists_ ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es ()
removeFileIfExists_ :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es ()
removeFileIfExists_ = Eff es Bool -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es Bool -> Eff es ())
-> (OsPath -> Eff es Bool) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removeFileIfExists

-- | Calls 'removeFile' if 'doesFileExist' is 'True'.
--
-- @since 0.1
removeFileIfExists ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es Bool
removeFileIfExists :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removeFileIfExists = (OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
removeIfExists OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.doesFileExist OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeFile

-- | Variant of 'removeDirectoryIfExists' that ignores the return value.
--
-- @since 0.1
removeDirectoryIfExists_ ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es ()
removeDirectoryIfExists_ :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectoryIfExists_ = Eff es Bool -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es Bool -> Eff es ())
-> (OsPath -> Eff es Bool) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removeDirectoryIfExists

-- | Calls 'removeDirectory' if 'doesDirectoryExist' is 'True'.
--
-- @since 0.1
removeDirectoryIfExists ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es Bool
removeDirectoryIfExists :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removeDirectoryIfExists = (OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
removeIfExists OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.doesDirectoryExist OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectory

-- | Variant of 'removeDirectoryRecursiveIfExists' that ignores the return value.
--
-- @since 0.1
removeDirectoryRecursiveIfExists_ ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es ()
removeDirectoryRecursiveIfExists_ :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectoryRecursiveIfExists_ = Eff es Bool -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es Bool -> Eff es ())
-> (OsPath -> Eff es Bool) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removeDirectoryRecursiveIfExists

-- | Calls 'removeDirectoryRecursive' if 'doesDirectoryExist' is 'True'.
--
-- @since 0.1
removeDirectoryRecursiveIfExists ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es Bool
removeDirectoryRecursiveIfExists :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removeDirectoryRecursiveIfExists =
  (OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
removeIfExists OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.doesDirectoryExist OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectoryRecursive

-- | Variant of 'removePathForciblyIfExists' that ignores the return value.
--
-- @since 0.1
removePathForciblyIfExists_ ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es ()
removePathForciblyIfExists_ :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es ()
removePathForciblyIfExists_ = Eff es Bool -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es Bool -> Eff es ())
-> (OsPath -> Eff es Bool) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removePathForciblyIfExists

-- | Calls 'removePathForcibly' if 'doesPathExist' is 'True'.
--
-- @since 0.1
removePathForciblyIfExists ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es Bool
removePathForciblyIfExists :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removePathForciblyIfExists =
  (OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
removeIfExists OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.doesPathExist OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removePathForcibly

-- | Variant of 'removeSymbolicLinkIfExists' that ignores the return value.
--
-- @since 0.1
removeSymbolicLinkIfExists_ ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es ()
removeSymbolicLinkIfExists_ :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es ()
removeSymbolicLinkIfExists_ = Eff es Bool -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es Bool -> Eff es ())
-> (OsPath -> Eff es Bool) -> OsPath -> Eff es ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removeSymbolicLinkIfExists

-- | Calls 'removeSymbolicLink' if 'doesSymbolicLinkExist' is 'True'.
--
-- @since 0.1
removeSymbolicLinkIfExists ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | .
  OsPath ->
  Eff es Bool
removeSymbolicLinkIfExists :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es Bool
removeSymbolicLinkIfExists =
  (OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
removeIfExists OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.doesSymbolicLinkExist OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es ()
removeSymbolicLink

removeIfExists ::
  (OsPath -> Eff es Bool) ->
  (OsPath -> Eff es ()) ->
  OsPath ->
  Eff es Bool
removeIfExists :: forall (es :: [(* -> *) -> * -> *]).
(OsPath -> Eff es Bool)
-> (OsPath -> Eff es ()) -> OsPath -> Eff es Bool
removeIfExists OsPath -> Eff es Bool
existsFn OsPath -> Eff es ()
deleteFn OsPath
f = do
  exists <- OsPath -> Eff es Bool
existsFn OsPath
f
  if exists
    then deleteFn f $> True
    else pure False

-- | 'copyDirectoryRecursiveConfig' with 'defaultCopyDirConfig'.
--
-- @since 0.1
copyDirectoryRecursive ::
  forall es.
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | Source
  OsPath ->
  -- | Destination
  OsPath ->
  Eff es ()
copyDirectoryRecursive :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copyDirectoryRecursive = CopyDirConfig -> OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
CopyDirConfig -> OsPath -> OsPath -> Eff es ()
copyDirectoryRecursiveConfig CopyDirConfig
Utils.defaultCopyDirConfig

-- | @copyDirectoryRecursiveConfig cfg src dest@ copies the @src@ and its
-- contents into @dest@ e.g.
--
-- @
-- copyDirectoryRecursiveConfig cfg "path\/to\/foo" "path\/to\/bar"
-- @
--
-- will create @path\/to\/bar\/foo@, @path\/to\/bar\/\<target\>@, or copy
-- @foo@'s contents directly into @bar@, depending on the value of
-- 'targetName'.
--
-- The atomicity semantics are as follows:
--
-- * 'OverwriteNone': If an error is encountered, we roll back the successful
--    writes by deleting the entire @dest\/\<target\>@.
-- * 'OverwriteDirectories': If an error is encountered, we attempt to delete
--   all successfully written paths/directories. Because these deletes are
--   performed sequentially, we cannot guarantee all are removed before the
--   process is interrupted.
-- * 'OverwriteAll': Same as 'OverwriteDirectories', except paths that were
--   overwritten are not restored. That is, if a path @dest\/\<src\>\/p@ is
--   overwritten and an error later encountered, @p@ is not restored.
--
-- __Throws:__
--
-- * 'PathNotFoundException': if @dest@ does not exist.
-- * 'PathFoundException':
--
--     * 'OverwriteNone' and @dest/\<src\>@ exists.
--     * 'OverwriteDirectories' and some @dest/\<target\>\/p@ would be
--        overwritten.
--
-- @since 0.1
copyDirectoryRecursiveConfig ::
  forall es.
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | Config
  CopyDirConfig ->
  -- | Source
  OsPath ->
  -- | Destination
  OsPath ->
  Eff es ()
copyDirectoryRecursiveConfig :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
CopyDirConfig -> OsPath -> OsPath -> Eff es ()
copyDirectoryRecursiveConfig CopyDirConfig
config OsPath
src OsPath
destRoot = do
  String -> PathType -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
String -> PathType -> OsPath -> Eff es ()
PR.throwIfWrongPathType String
"copyDirectoryRecursiveConfig" PathType
PathTypeDirectory OsPath
src
  String -> PathType -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
String -> PathType -> OsPath -> Eff es ()
PR.throwIfWrongPathType String
"copyDirectoryRecursiveConfig" PathType
PathTypeDirectory OsPath
destRoot

  let dest :: OsPath
dest = case CopyDirConfig
config CopyDirConfig
-> Optic' A_Lens NoIx CopyDirConfig TargetName -> TargetName
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CopyDirConfig TargetName
#targetName of
        -- Use source directory's name
        TargetName
TargetNameSrc ->
          let -- Previously we used takeBaseName, but this caused a bug
              -- where e.g. dir-1.0.0 -> dir-1.0 (i.e. the last dot was treated
              -- as an extension, that takeBaseName removes).
              --
              -- splitFileName seems to do what we want e.g.
              --
              -- (/path/to/, dir-1.0.0) === splitFileName /path/to/dir-1.0.0
              --
              -- Note that dropTrailingPathSeparator needs to be used first
              -- to ensure correctness.
              --
              -- This also caused a bug where hidden directories were copied
              -- incorrectly.
              (OsPath
_, OsPath
name) = OsPath -> (OsPath, OsPath)
FP.splitFileName (OsPath -> OsPath
FP.dropTrailingPathSeparator OsPath
src)
           in OsPath
destRoot OsPath -> OsPath -> OsPath
</> OsPath
name
        -- Use the give name
        TargetNameLiteral OsPath
p -> OsPath
destRoot OsPath -> OsPath -> OsPath
</> OsPath
p
        -- Use dest itself (i.e. top-level copy)
        TargetName
TargetNameDest -> OsPath
destRoot

  case CopyDirConfig
config CopyDirConfig
-> Optic' A_Lens NoIx CopyDirConfig Overwrite -> Overwrite
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx CopyDirConfig Overwrite
#overwrite of
    Overwrite
OverwriteNone -> OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copyDirectoryNoOverwrite OsPath
src OsPath
dest
    Overwrite
OverwriteDirectories -> Bool -> OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
Bool -> OsPath -> OsPath -> Eff es ()
copyDirectoryOverwrite Bool
False OsPath
src OsPath
dest
    Overwrite
OverwriteAll -> Bool -> OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
Bool -> OsPath -> OsPath -> Eff es ()
copyDirectoryOverwrite Bool
True OsPath
src OsPath
dest

copyDirectoryOverwrite ::
  forall es.
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | Overwrite files
  Bool ->
  -- | Source
  OsPath ->
  -- | Destination
  OsPath ->
  Eff es ()
copyDirectoryOverwrite :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
Bool -> OsPath -> OsPath -> Eff es ()
copyDirectoryOverwrite Bool
overwriteFiles OsPath
src OsPath
dest = do
  -- NOTE: The logic here merits explanation. The idea is if we encounter
  -- any errors while copying, we want to "roll back" any successful copies
  -- i.e. copying should try to be atomic.
  --
  -- In copyDirectory this is simple; we can assume the dest/\<src\> does not
  -- exist (otherwise throwing an exception), so the logic is:
  --
  -- 1. Copying: use (createDirectoryIfMissing True) to create the
  --   necessary parent dirs automatically.
  -- 2. Cleanup: If anything goes wrong, delete the entire dest/\<src\>.
  --
  -- For copyDirectoryOverwrite, however, the dest/\<src\> might already exist,
  -- making our job harder. In particular:
  --
  -- 1. Copying:
  --      - Create the parent directories sequentially. We store the
  --        created paths in an IORef.
  --      - Copy the files over, saving the copied paths to another IORef.
  -- 2. Cleanup:
  --      - If anything goes wrong, we cannot simply delete the dest/\<src\>
  --        because it might have already existed. We iterate through our
  --        IORefs, deleting the paths.

  copiedFilesRef <- IO (IORef [OsPath]) -> Eff es (IORef [OsPath])
forall a (es :: [(* -> *) -> * -> *]). IO a -> Eff es a
unsafeEff_ (IO (IORef [OsPath]) -> Eff es (IORef [OsPath]))
-> IO (IORef [OsPath]) -> Eff es (IORef [OsPath])
forall a b. (a -> b) -> a -> b
$ [OsPath] -> IO (IORef [OsPath])
forall a. a -> IO (IORef a)
newIORef []
  createdDirsRef <- unsafeEff_ $ newIORef []
  copiedSymlinksRef <- unsafeEff_ $ newIORef []

  destExists <- PR.doesDirectoryExist dest

  let checkFileOverwrites =
        if Bool -> Bool
not Bool
overwriteFiles
          then \OsPath
f -> do
            exists <- OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.doesFileExist OsPath
f
            when exists $
              FS.IO.throwPathIOError
                f
                "copyDirectoryOverwrite"
                Error.alreadyExistsErrorType
                "Attempted file overwrite when CopyDirConfig.overwriteFiles is false"
          else Eff es () -> OsPath -> Eff es ()
forall a b. a -> b -> a
const (() -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

      checkSymlinkOverwrites =
        if Bool -> Bool
not Bool
overwriteFiles
          then \OsPath
f -> do
            exists <- OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.doesSymbolicLinkExist OsPath
f
            when exists $
              FS.IO.throwPathIOError
                f
                "copyDirectoryOverwrite"
                Error.alreadyExistsErrorType
                "Attempted symlink overwrite when CopyDirConfig.overwriteFiles is false"
          else Eff es () -> OsPath -> Eff es ()
forall a b. a -> b -> a
const (() -> Eff es ()
forall a. a -> Eff es a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

      copyFiles = do
        (subFiles, subDirs, symlinks) <- OsPath -> Eff es ([OsPath], [OsPath], [OsPath])
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es ([OsPath], [OsPath], [OsPath])
PR.listDirectoryRecursiveSymbolicLink OsPath
src

        -- Create dest if it does not exist. Do not need to save dir
        -- in createdDirsRef IORef as it will be correctly deleted by
        -- removeDirectoryRecursive if necessary.
        unless destExists $ createDirectory dest

        -- create the parent directories
        for_ subDirs $ \OsPath
d -> do
          let d' :: OsPath
d' = OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
d
          dExists <- OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.doesDirectoryExist OsPath
d'
          unless dExists $ do
            createDirectoryIfMissing False d'
            unsafeEff_ $ modifyIORef' createdDirsRef (d' :)

        -- copy files
        for_ subFiles $ \OsPath
f -> do
          let f' :: OsPath
f' = OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
f
          OsPath -> Eff es ()
checkFileOverwrites OsPath
f'
          OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copyFileWithMetadata (OsPath
src OsPath -> OsPath -> OsPath
</> OsPath
f) OsPath
f'
          IO () -> Eff es ()
forall a (es :: [(* -> *) -> * -> *]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> IO () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ IORef [OsPath] -> ([OsPath] -> [OsPath]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [OsPath]
copiedFilesRef (OsPath
f' OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
:)

        -- copy symlinks
        for_ symlinks $ \OsPath
s -> do
          let s' :: OsPath
s' = OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
s
          OsPath -> Eff es ()
checkSymlinkOverwrites OsPath
s'
          OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copySymbolicLink (OsPath
src OsPath -> OsPath -> OsPath
</> OsPath
s) OsPath
s'
          IO () -> Eff es ()
forall a (es :: [(* -> *) -> * -> *]). IO a -> Eff es a
unsafeEff_ (IO () -> Eff es ()) -> IO () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ IORef [OsPath] -> ([OsPath] -> [OsPath]) -> IO ()
forall a. IORef a -> (a -> a) -> IO ()
modifyIORef' IORef [OsPath]
copiedSymlinksRef (OsPath
s' OsPath -> [OsPath] -> [OsPath]
forall a. a -> [a] -> [a]
:)

      cleanup =
        if Bool
destExists
          then do
            -- manually delete files and dirs
            IO [OsPath] -> Eff es [OsPath]
forall a (es :: [(* -> *) -> * -> *]). IO a -> Eff es a
unsafeEff_ (IORef [OsPath] -> IO [OsPath]
forall a. IORef a -> IO a
readIORef IORef [OsPath]
copiedFilesRef) Eff es [OsPath] -> ([OsPath] -> Eff es ()) -> Eff es ()
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OsPath -> Eff es ()) -> [OsPath] -> Eff es ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeFile
            IO [OsPath] -> Eff es [OsPath]
forall a (es :: [(* -> *) -> * -> *]). IO a -> Eff es a
unsafeEff_ (IORef [OsPath] -> IO [OsPath]
forall a. IORef a -> IO a
readIORef IORef [OsPath]
createdDirsRef) Eff es [OsPath] -> ([OsPath] -> Eff es ()) -> Eff es ()
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OsPath -> Eff es ()) -> [OsPath] -> Eff es ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectory
            IO [OsPath] -> Eff es [OsPath]
forall a (es :: [(* -> *) -> * -> *]). IO a -> Eff es a
unsafeEff_ (IORef [OsPath] -> IO [OsPath]
forall a. IORef a -> IO a
readIORef IORef [OsPath]
copiedSymlinksRef) Eff es [OsPath] -> ([OsPath] -> Eff es ()) -> Eff es ()
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OsPath -> Eff es ()) -> [OsPath] -> Eff es ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es ()
removeSymbolicLink
          else OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectoryRecursive OsPath
dest

  copyFiles `onSyncException` mask_ cleanup

copyDirectoryNoOverwrite ::
  forall es.
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | Source
  OsPath ->
  -- | Destination
  OsPath ->
  Eff es ()
copyDirectoryNoOverwrite :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copyDirectoryNoOverwrite OsPath
src OsPath
dest = do
  destExists <- OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.doesDirectoryExist OsPath
dest
  when destExists $
    FS.IO.throwPathIOError
      dest
      "copyDirectoryNoOverwrite"
      Error.alreadyExistsErrorType
      "Attempted directory overwrite when CopyDirConfig.overwrite is OverwriteNone"

  let copyFiles = do
        (subFiles, subDirs, symlinks) <- OsPath -> Eff es ([OsPath], [OsPath], [OsPath])
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es ([OsPath], [OsPath], [OsPath])
PR.listDirectoryRecursiveSymbolicLink OsPath
src
        createDirectory dest

        -- create intermediate dirs if they do not exist
        traverse_ (createDirectoryIfMissing True . (dest </>)) subDirs

        -- copy files
        for_ subFiles $ \OsPath
f -> OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copyFileWithMetadata (OsPath
src OsPath -> OsPath -> OsPath
</> OsPath
f) (OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
f)

        -- copy symlinks
        for_ symlinks $ \OsPath
s -> OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copySymbolicLink (OsPath
src OsPath -> OsPath -> OsPath
</> OsPath
s) (OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
s)

      -- delete directory
      cleanup = OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectoryRecursive OsPath
dest

  copyFiles `onSyncException` mask_ cleanup

-- | Removes a symbolic link. On Windows, attempts to distinguish
-- file and directory links (Posix makes no distinction).
--
-- @since 0.1
removeSymbolicLink ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  OsPath ->
  Eff es ()
removeSymbolicLink :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> Eff es ()
removeSymbolicLink OsPath
p = do
  String -> PathType -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
String -> PathType -> OsPath -> Eff es ()
PR.throwIfWrongPathType String
"removeSymbolicLink" PathType
PathTypeSymbolicLink OsPath
p

  OsPath -> Eff es Bool
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es Bool
PR.pathIsSymbolicDirectoryLink OsPath
p Eff es Bool -> (Bool -> Eff es ()) -> Eff es ()
forall a b. Eff es a -> (a -> Eff es b) -> Eff es b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Bool
True -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeDirectoryLink OsPath
p
    Bool
False -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> Eff es ()
removeFile OsPath
p

-- | Copies the symbolic link /without/ traversing the link i.e. copy the
-- link itself. Does not throw an exception if the target does exist.
-- Throws an @IOException@ if the path is not a symbolic link.
--
-- __Windows:__ We have to distinguish between file and directory links
-- (Posix makes no such distinction). If the target does not exist or is
-- not considered a directory (e.g. it could also be a link), we fall back
-- to creating a file link.
--
-- @since 0.1
copySymbolicLink ::
  ( HasCallStack,
    PathReader :> es,
    PathWriter :> es
  ) =>
  -- | Source
  OsPath ->
  -- | Dest
  OsPath ->
  Eff es ()
copySymbolicLink :: forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
copySymbolicLink OsPath
src OsPath
dest = do
  String -> PathType -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
String -> PathType -> OsPath -> Eff es ()
PR.throwIfWrongPathType String
"copySymbolicLink" PathType
PathTypeSymbolicLink OsPath
src

  target <- OsPath -> Eff es OsPath
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathReader :> es) =>
OsPath -> Eff es OsPath
PR.getSymbolicLinkTarget OsPath
src

  -- NOTE: The distinction between a directory vs. file link does not exist
  -- for Posix, so this logic is for Windows. We test if the target exists
  -- and is a directory, in which case we use createDirectoryLink. If the
  -- target is a file, symlink itself, or does not exist, we fall back to
  -- createFileLink.
  PR.pathIsSymbolicDirectoryLink src >>= \case
    Bool
True -> OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
createDirectoryLink OsPath
target OsPath
dest
    Bool
False -> OsPath -> OsPath -> Eff es ()
forall (es :: [(* -> *) -> * -> *]).
(HasCallStack, PathWriter :> es) =>
OsPath -> OsPath -> Eff es ()
createFileLink OsPath
target OsPath
dest

-- $if-exists
-- The @removeXIfExists@ functions should be understood as helper combinators
-- for the obvious @doesXExist -> removeX@ pattern. They should __not__ be
-- understood as a total "delete arbitrary path if it exists" pattern.
--
-- For instance, 'doesDirectoryExist' will return true if the /target/ of a
-- symbolic link is a directory, yet 'removeDirectory' will throw an exception.
-- Thus these functions should only be used when the type (file, dir, symlink)
-- of a (possibly non-extant) path is __known__.