{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableInstances #-}
#if __GLASGOW_HASKELL__ >= 902 && __GLASGOW_HASKELL__ < 904
{-# LANGUAGE TypeFamilies #-}
#endif
module Effects.FileSystem.PathWriter
(
MonadPathWriter (..),
OsPath,
CopyDirConfig (..),
Overwrite (..),
TargetName (..),
defaultCopyDirConfig,
copyDirectoryRecursive,
copyDirectoryRecursiveConfig,
copySymbolicLink,
_OverwriteNone,
_OverwriteDirectories,
_OverwriteAll,
_TargetNameSrc,
_TargetNameLiteral,
_TargetNameDest,
removeFileIfExists,
removeFileIfExists_,
removeDirectoryIfExists,
removeDirectoryIfExists_,
removeDirectoryRecursiveIfExists,
removeDirectoryRecursiveIfExists_,
removePathForciblyIfExists,
removePathForciblyIfExists_,
removeSymbolicLink,
removeSymbolicLinkIfExists,
removeSymbolicLinkIfExists_,
IOException,
Permissions (..),
UTCTime (..),
)
where
import Control.DeepSeq (NFData)
import Control.Exception (IOException)
import Control.Exception.Utils (onSyncException)
import Control.Monad (unless, void, when)
import Control.Monad.Catch (MonadCatch, MonadMask, mask_)
import Control.Monad.Trans.Class (MonadTrans (lift))
import Control.Monad.Trans.Reader (ReaderT, ask, runReaderT)
import Data.Foldable (for_, traverse_)
import Data.Functor (($>))
import Data.Time (UTCTime (UTCTime, utctDay, utctDayTime))
import Effects.FileSystem.PathReader
( MonadPathReader
( doesDirectoryExist,
doesFileExist,
doesPathExist,
getSymbolicLinkTarget
),
PathType (PathTypeDirectory, PathTypeSymbolicLink),
doesSymbolicLinkExist,
listDirectoryRecursiveSymbolicLink,
pathIsSymbolicDirectoryLink,
)
import Effects.FileSystem.PathReader qualified as PR
import Effects.IORef
( MonadIORef (modifyIORef', newIORef, readIORef),
)
import FileSystem.IO qualified as FS.IO
import FileSystem.OsPath (OsPath, (</>))
import GHC.Generics (Generic)
import GHC.Stack (HasCallStack)
import Optics.Core
( A_Lens,
LabelOptic (labelOptic),
Prism',
lensVL,
prism,
(^.),
)
import System.Directory (Permissions)
import System.Directory.OsPath qualified as Dir
import System.IO.Error qualified as Error
import System.OsPath qualified as FP
class (Monad m) => MonadPathWriter m where
createDirectory :: (HasCallStack) => OsPath -> m ()
createDirectoryIfMissing ::
(HasCallStack) =>
Bool ->
OsPath ->
m ()
removeDirectory :: (HasCallStack) => OsPath -> m ()
removeDirectoryRecursive :: (HasCallStack) => OsPath -> m ()
removePathForcibly :: (HasCallStack) => OsPath -> m ()
renameDirectory :: (HasCallStack) => OsPath -> OsPath -> m ()
setCurrentDirectory :: (HasCallStack) => OsPath -> m ()
withCurrentDirectory :: (HasCallStack) => OsPath -> m a -> m a
removeFile :: (HasCallStack) => OsPath -> m ()
renameFile :: (HasCallStack) => OsPath -> OsPath -> m ()
renamePath ::
(HasCallStack) =>
OsPath ->
OsPath ->
m ()
copyFile ::
(HasCallStack) =>
OsPath ->
OsPath ->
m ()
copyFileWithMetadata ::
(HasCallStack) =>
OsPath ->
OsPath ->
m ()
createFileLink ::
(HasCallStack) =>
OsPath ->
OsPath ->
m ()
createDirectoryLink ::
(HasCallStack) =>
OsPath ->
OsPath ->
m ()
removeDirectoryLink :: (HasCallStack) => OsPath -> m ()
setPermissions :: (HasCallStack) => OsPath -> Permissions -> m ()
copyPermissions :: (HasCallStack) => OsPath -> OsPath -> m ()
setAccessTime :: (HasCallStack) => OsPath -> UTCTime -> m ()
setModificationTime :: (HasCallStack) => OsPath -> UTCTime -> m ()
instance MonadPathWriter IO where
createDirectory :: HasCallStack => OsPath -> IO ()
createDirectory = OsPath -> IO ()
Dir.createDirectory
{-# INLINEABLE createDirectory #-}
createDirectoryIfMissing :: HasCallStack => Bool -> OsPath -> IO ()
createDirectoryIfMissing = Bool -> OsPath -> IO ()
Dir.createDirectoryIfMissing
{-# INLINEABLE createDirectoryIfMissing #-}
removeDirectory :: HasCallStack => OsPath -> IO ()
removeDirectory = OsPath -> IO ()
Dir.removeDirectory
{-# INLINEABLE removeDirectory #-}
removeDirectoryRecursive :: HasCallStack => OsPath -> IO ()
removeDirectoryRecursive = OsPath -> IO ()
Dir.removeDirectoryRecursive
{-# INLINEABLE removeDirectoryRecursive #-}
removePathForcibly :: HasCallStack => OsPath -> IO ()
removePathForcibly = OsPath -> IO ()
Dir.removePathForcibly
{-# INLINEABLE removePathForcibly #-}
renameDirectory :: HasCallStack => OsPath -> OsPath -> IO ()
renameDirectory = OsPath -> OsPath -> IO ()
Dir.renameDirectory
{-# INLINEABLE renameDirectory #-}
setCurrentDirectory :: HasCallStack => OsPath -> IO ()
setCurrentDirectory = OsPath -> IO ()
Dir.setCurrentDirectory
{-# INLINEABLE setCurrentDirectory #-}
withCurrentDirectory :: forall a. HasCallStack => OsPath -> IO a -> IO a
withCurrentDirectory = OsPath -> IO a -> IO a
forall a. OsPath -> IO a -> IO a
Dir.withCurrentDirectory
{-# INLINEABLE withCurrentDirectory #-}
removeFile :: HasCallStack => OsPath -> IO ()
removeFile = OsPath -> IO ()
Dir.removeFile
{-# INLINEABLE removeFile #-}
renameFile :: HasCallStack => OsPath -> OsPath -> IO ()
renameFile = OsPath -> OsPath -> IO ()
Dir.renameFile
{-# INLINEABLE renameFile #-}
renamePath :: HasCallStack => OsPath -> OsPath -> IO ()
renamePath = OsPath -> OsPath -> IO ()
Dir.renamePath
{-# INLINEABLE renamePath #-}
copyFile :: HasCallStack => OsPath -> OsPath -> IO ()
copyFile = OsPath -> OsPath -> IO ()
Dir.copyFile
{-# INLINEABLE copyFile #-}
copyFileWithMetadata :: HasCallStack => OsPath -> OsPath -> IO ()
copyFileWithMetadata = OsPath -> OsPath -> IO ()
Dir.copyFileWithMetadata
{-# INLINEABLE copyFileWithMetadata #-}
createFileLink :: HasCallStack => OsPath -> OsPath -> IO ()
createFileLink = OsPath -> OsPath -> IO ()
Dir.createFileLink
{-# INLINEABLE createFileLink #-}
createDirectoryLink :: HasCallStack => OsPath -> OsPath -> IO ()
createDirectoryLink = OsPath -> OsPath -> IO ()
Dir.createDirectoryLink
{-# INLINEABLE createDirectoryLink #-}
removeDirectoryLink :: HasCallStack => OsPath -> IO ()
removeDirectoryLink = OsPath -> IO ()
Dir.removeDirectoryLink
{-# INLINEABLE removeDirectoryLink #-}
setPermissions :: HasCallStack => OsPath -> Permissions -> IO ()
setPermissions = OsPath -> Permissions -> IO ()
Dir.setPermissions
{-# INLINEABLE setPermissions #-}
copyPermissions :: HasCallStack => OsPath -> OsPath -> IO ()
copyPermissions = OsPath -> OsPath -> IO ()
Dir.copyPermissions
{-# INLINEABLE copyPermissions #-}
setAccessTime :: HasCallStack => OsPath -> UTCTime -> IO ()
setAccessTime = OsPath -> UTCTime -> IO ()
Dir.setAccessTime
{-# INLINEABLE setAccessTime #-}
setModificationTime :: HasCallStack => OsPath -> UTCTime -> IO ()
setModificationTime = OsPath -> UTCTime -> IO ()
Dir.setModificationTime
{-# INLINEABLE setModificationTime #-}
instance (MonadPathWriter m) => MonadPathWriter (ReaderT env m) where
createDirectory :: HasCallStack => OsPath -> ReaderT env m ()
createDirectory = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
createDirectory
{-# INLINEABLE createDirectory #-}
createDirectoryIfMissing :: HasCallStack => Bool -> OsPath -> ReaderT env m ()
createDirectoryIfMissing Bool
b = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
createDirectoryIfMissing Bool
b
{-# INLINEABLE createDirectoryIfMissing #-}
removeDirectory :: HasCallStack => OsPath -> ReaderT env m ()
removeDirectory = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectory
{-# INLINEABLE removeDirectory #-}
removeDirectoryRecursive :: HasCallStack => OsPath -> ReaderT env m ()
removeDirectoryRecursive = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectoryRecursive
{-# INLINEABLE removeDirectoryRecursive #-}
removePathForcibly :: HasCallStack => OsPath -> ReaderT env m ()
removePathForcibly = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removePathForcibly
{-# INLINEABLE removePathForcibly #-}
renameDirectory :: HasCallStack => OsPath -> OsPath -> ReaderT env m ()
renameDirectory OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
renameDirectory OsPath
p
{-# INLINEABLE renameDirectory #-}
setCurrentDirectory :: HasCallStack => OsPath -> ReaderT env m ()
setCurrentDirectory = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
setCurrentDirectory
{-# INLINEABLE setCurrentDirectory #-}
withCurrentDirectory :: forall a.
HasCallStack =>
OsPath -> ReaderT env m a -> ReaderT env m a
withCurrentDirectory OsPath
p ReaderT env m a
action =
ReaderT env m env
forall (m :: * -> *) r. Monad m => ReaderT r m r
ask ReaderT env m env -> (env -> ReaderT env m a) -> ReaderT env m a
forall a b.
ReaderT env m a -> (a -> ReaderT env m b) -> ReaderT env m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= m a -> ReaderT env m a
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m a -> ReaderT env m a) -> (env -> m a) -> env -> ReaderT env m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \env
e -> OsPath -> m a -> m a
forall a. HasCallStack => OsPath -> m a -> m a
forall (m :: * -> *) a.
(MonadPathWriter m, HasCallStack) =>
OsPath -> m a -> m a
withCurrentDirectory OsPath
p (ReaderT env m a -> env -> m a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT env m a
action env
e)
{-# INLINEABLE withCurrentDirectory #-}
removeFile :: HasCallStack => OsPath -> ReaderT env m ()
removeFile = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeFile
{-# INLINEABLE removeFile #-}
renameFile :: HasCallStack => OsPath -> OsPath -> ReaderT env m ()
renameFile OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
renameFile OsPath
p
{-# INLINEABLE renameFile #-}
renamePath :: HasCallStack => OsPath -> OsPath -> ReaderT env m ()
renamePath OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
renamePath OsPath
p
{-# INLINEABLE renamePath #-}
copyFile :: HasCallStack => OsPath -> OsPath -> ReaderT env m ()
copyFile OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
copyFile OsPath
p
{-# INLINEABLE copyFile #-}
copyFileWithMetadata :: HasCallStack => OsPath -> OsPath -> ReaderT env m ()
copyFileWithMetadata OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
copyFileWithMetadata OsPath
p
{-# INLINEABLE copyFileWithMetadata #-}
createFileLink :: HasCallStack => OsPath -> OsPath -> ReaderT env m ()
createFileLink OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
createFileLink OsPath
p
{-# INLINEABLE createFileLink #-}
createDirectoryLink :: HasCallStack => OsPath -> OsPath -> ReaderT env m ()
createDirectoryLink OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
createDirectoryLink OsPath
p
{-# INLINEABLE createDirectoryLink #-}
removeDirectoryLink :: HasCallStack => OsPath -> ReaderT env m ()
removeDirectoryLink = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectoryLink
{-# INLINEABLE removeDirectoryLink #-}
setPermissions :: HasCallStack => OsPath -> Permissions -> ReaderT env m ()
setPermissions OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (Permissions -> m ()) -> Permissions -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> Permissions -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> Permissions -> m ()
setPermissions OsPath
p
{-# INLINEABLE setPermissions #-}
copyPermissions :: HasCallStack => OsPath -> OsPath -> ReaderT env m ()
copyPermissions OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (OsPath -> m ()) -> OsPath -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
copyPermissions OsPath
p
{-# INLINEABLE copyPermissions #-}
setAccessTime :: HasCallStack => OsPath -> UTCTime -> ReaderT env m ()
setAccessTime OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (UTCTime -> m ()) -> UTCTime -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> UTCTime -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> UTCTime -> m ()
setAccessTime OsPath
p
{-# INLINEABLE setAccessTime #-}
setModificationTime :: HasCallStack => OsPath -> UTCTime -> ReaderT env m ()
setModificationTime OsPath
p = m () -> ReaderT env m ()
forall (m :: * -> *) a. Monad m => m a -> ReaderT env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (m () -> ReaderT env m ())
-> (UTCTime -> m ()) -> UTCTime -> ReaderT env m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> UTCTime -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> UTCTime -> m ()
setModificationTime OsPath
p
{-# INLINEABLE setModificationTime #-}
data Overwrite
=
OverwriteNone
|
OverwriteDirectories
|
OverwriteAll
deriving stock
(
Overwrite -> Overwrite -> Bool
(Overwrite -> Overwrite -> Bool)
-> (Overwrite -> Overwrite -> Bool) -> Eq Overwrite
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Overwrite -> Overwrite -> Bool
== :: Overwrite -> Overwrite -> Bool
$c/= :: Overwrite -> Overwrite -> Bool
/= :: Overwrite -> Overwrite -> Bool
Eq,
(forall x. Overwrite -> Rep Overwrite x)
-> (forall x. Rep Overwrite x -> Overwrite) -> Generic Overwrite
forall x. Rep Overwrite x -> Overwrite
forall x. Overwrite -> Rep Overwrite x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Overwrite -> Rep Overwrite x
from :: forall x. Overwrite -> Rep Overwrite x
$cto :: forall x. Rep Overwrite x -> Overwrite
to :: forall x. Rep Overwrite x -> Overwrite
Generic,
Int -> Overwrite -> ShowS
[Overwrite] -> ShowS
Overwrite -> String
(Int -> Overwrite -> ShowS)
-> (Overwrite -> String)
-> ([Overwrite] -> ShowS)
-> Show Overwrite
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Overwrite -> ShowS
showsPrec :: Int -> Overwrite -> ShowS
$cshow :: Overwrite -> String
show :: Overwrite -> String
$cshowList :: [Overwrite] -> ShowS
showList :: [Overwrite] -> ShowS
Show
)
deriving anyclass
(
Overwrite -> ()
(Overwrite -> ()) -> NFData Overwrite
forall a. (a -> ()) -> NFData a
$crnf :: Overwrite -> ()
rnf :: Overwrite -> ()
NFData
)
_OverwriteNone :: Prism' Overwrite ()
_OverwriteNone :: Prism' Overwrite ()
_OverwriteNone =
(() -> Overwrite)
-> (Overwrite -> Either Overwrite ()) -> Prism' Overwrite ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(Overwrite -> () -> Overwrite
forall a b. a -> b -> a
const Overwrite
OverwriteNone)
( \case
Overwrite
OverwriteNone -> () -> Either Overwrite ()
forall a b. b -> Either a b
Right ()
Overwrite
x -> Overwrite -> Either Overwrite ()
forall a b. a -> Either a b
Left Overwrite
x
)
{-# INLINE _OverwriteNone #-}
_OverwriteDirectories :: Prism' Overwrite ()
_OverwriteDirectories :: Prism' Overwrite ()
_OverwriteDirectories =
(() -> Overwrite)
-> (Overwrite -> Either Overwrite ()) -> Prism' Overwrite ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(Overwrite -> () -> Overwrite
forall a b. a -> b -> a
const Overwrite
OverwriteDirectories)
( \case
Overwrite
OverwriteDirectories -> () -> Either Overwrite ()
forall a b. b -> Either a b
Right ()
Overwrite
x -> Overwrite -> Either Overwrite ()
forall a b. a -> Either a b
Left Overwrite
x
)
{-# INLINE _OverwriteDirectories #-}
_OverwriteAll :: Prism' Overwrite ()
_OverwriteAll :: Prism' Overwrite ()
_OverwriteAll =
(() -> Overwrite)
-> (Overwrite -> Either Overwrite ()) -> Prism' Overwrite ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(Overwrite -> () -> Overwrite
forall a b. a -> b -> a
const Overwrite
OverwriteAll)
( \case
Overwrite
OverwriteAll -> () -> Either Overwrite ()
forall a b. b -> Either a b
Right ()
Overwrite
x -> Overwrite -> Either Overwrite ()
forall a b. a -> Either a b
Left Overwrite
x
)
{-# INLINE _OverwriteAll #-}
data TargetName
=
TargetNameSrc
|
TargetNameLiteral !OsPath
|
TargetNameDest
deriving stock
(
TargetName -> TargetName -> Bool
(TargetName -> TargetName -> Bool)
-> (TargetName -> TargetName -> Bool) -> Eq TargetName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TargetName -> TargetName -> Bool
== :: TargetName -> TargetName -> Bool
$c/= :: TargetName -> TargetName -> Bool
/= :: TargetName -> TargetName -> Bool
Eq,
(forall x. TargetName -> Rep TargetName x)
-> (forall x. Rep TargetName x -> TargetName) -> Generic TargetName
forall x. Rep TargetName x -> TargetName
forall x. TargetName -> Rep TargetName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TargetName -> Rep TargetName x
from :: forall x. TargetName -> Rep TargetName x
$cto :: forall x. Rep TargetName x -> TargetName
to :: forall x. Rep TargetName x -> TargetName
Generic,
Int -> TargetName -> ShowS
[TargetName] -> ShowS
TargetName -> String
(Int -> TargetName -> ShowS)
-> (TargetName -> String)
-> ([TargetName] -> ShowS)
-> Show TargetName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TargetName -> ShowS
showsPrec :: Int -> TargetName -> ShowS
$cshow :: TargetName -> String
show :: TargetName -> String
$cshowList :: [TargetName] -> ShowS
showList :: [TargetName] -> ShowS
Show
)
deriving anyclass
(
TargetName -> ()
(TargetName -> ()) -> NFData TargetName
forall a. (a -> ()) -> NFData a
$crnf :: TargetName -> ()
rnf :: TargetName -> ()
NFData
)
_TargetNameSrc :: Prism' TargetName ()
_TargetNameSrc :: Prism' TargetName ()
_TargetNameSrc =
(() -> TargetName)
-> (TargetName -> Either TargetName ()) -> Prism' TargetName ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(TargetName -> () -> TargetName
forall a b. a -> b -> a
const TargetName
TargetNameSrc)
( \case
TargetName
TargetNameSrc -> () -> Either TargetName ()
forall a b. b -> Either a b
Right ()
TargetName
x -> TargetName -> Either TargetName ()
forall a b. a -> Either a b
Left TargetName
x
)
{-# INLINE _TargetNameSrc #-}
_TargetNameLiteral :: Prism' TargetName OsPath
_TargetNameLiteral :: Prism' TargetName OsPath
_TargetNameLiteral =
(OsPath -> TargetName)
-> (TargetName -> Either TargetName OsPath)
-> Prism' TargetName OsPath
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
OsPath -> TargetName
TargetNameLiteral
( \case
TargetNameLiteral OsPath
p -> OsPath -> Either TargetName OsPath
forall a b. b -> Either a b
Right OsPath
p
TargetName
x -> TargetName -> Either TargetName OsPath
forall a b. a -> Either a b
Left TargetName
x
)
{-# INLINE _TargetNameLiteral #-}
_TargetNameDest :: Prism' TargetName ()
_TargetNameDest :: Prism' TargetName ()
_TargetNameDest =
(() -> TargetName)
-> (TargetName -> Either TargetName ()) -> Prism' TargetName ()
forall b t s a. (b -> t) -> (s -> Either t a) -> Prism s t a b
prism
(TargetName -> () -> TargetName
forall a b. a -> b -> a
const TargetName
TargetNameDest)
( \case
TargetName
TargetNameDest -> () -> Either TargetName ()
forall a b. b -> Either a b
Right ()
TargetName
x -> TargetName -> Either TargetName ()
forall a b. a -> Either a b
Left TargetName
x
)
{-# INLINE _TargetNameDest #-}
data CopyDirConfig = MkCopyDirConfig
{
CopyDirConfig -> Overwrite
overwrite :: !Overwrite,
CopyDirConfig -> TargetName
targetName :: !TargetName
}
deriving stock
(
CopyDirConfig -> CopyDirConfig -> Bool
(CopyDirConfig -> CopyDirConfig -> Bool)
-> (CopyDirConfig -> CopyDirConfig -> Bool) -> Eq CopyDirConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CopyDirConfig -> CopyDirConfig -> Bool
== :: CopyDirConfig -> CopyDirConfig -> Bool
$c/= :: CopyDirConfig -> CopyDirConfig -> Bool
/= :: CopyDirConfig -> CopyDirConfig -> Bool
Eq,
(forall x. CopyDirConfig -> Rep CopyDirConfig x)
-> (forall x. Rep CopyDirConfig x -> CopyDirConfig)
-> Generic CopyDirConfig
forall x. Rep CopyDirConfig x -> CopyDirConfig
forall x. CopyDirConfig -> Rep CopyDirConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CopyDirConfig -> Rep CopyDirConfig x
from :: forall x. CopyDirConfig -> Rep CopyDirConfig x
$cto :: forall x. Rep CopyDirConfig x -> CopyDirConfig
to :: forall x. Rep CopyDirConfig x -> CopyDirConfig
Generic,
Int -> CopyDirConfig -> ShowS
[CopyDirConfig] -> ShowS
CopyDirConfig -> String
(Int -> CopyDirConfig -> ShowS)
-> (CopyDirConfig -> String)
-> ([CopyDirConfig] -> ShowS)
-> Show CopyDirConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CopyDirConfig -> ShowS
showsPrec :: Int -> CopyDirConfig -> ShowS
$cshow :: CopyDirConfig -> String
show :: CopyDirConfig -> String
$cshowList :: [CopyDirConfig] -> ShowS
showList :: [CopyDirConfig] -> ShowS
Show
)
deriving anyclass
(
CopyDirConfig -> ()
(CopyDirConfig -> ()) -> NFData CopyDirConfig
forall a. (a -> ()) -> NFData a
$crnf :: CopyDirConfig -> ()
rnf :: CopyDirConfig -> ()
NFData
)
instance
(k ~ A_Lens, a ~ Overwrite, b ~ Overwrite) =>
LabelOptic "overwrite" k CopyDirConfig CopyDirConfig a b
where
labelOptic :: Optic k NoIx CopyDirConfig CopyDirConfig a b
labelOptic = LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b)
-> LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkCopyDirConfig Overwrite
a1 TargetName
a2) ->
(Overwrite -> CopyDirConfig) -> f Overwrite -> f CopyDirConfig
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Overwrite
b -> Overwrite -> TargetName -> CopyDirConfig
MkCopyDirConfig Overwrite
b TargetName
a2) (a -> f b
f a
Overwrite
a1)
{-# INLINE labelOptic #-}
instance
(k ~ A_Lens, a ~ TargetName, b ~ TargetName) =>
LabelOptic "targetName" k CopyDirConfig CopyDirConfig a b
where
labelOptic :: Optic k NoIx CopyDirConfig CopyDirConfig a b
labelOptic = LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b)
-> LensVL CopyDirConfig CopyDirConfig a b
-> Lens CopyDirConfig CopyDirConfig a b
forall a b. (a -> b) -> a -> b
$ \a -> f b
f (MkCopyDirConfig Overwrite
a1 TargetName
a2) ->
(TargetName -> CopyDirConfig) -> f TargetName -> f CopyDirConfig
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Overwrite -> TargetName -> CopyDirConfig
MkCopyDirConfig Overwrite
a1) (a -> f b
f a
TargetName
a2)
{-# INLINE labelOptic #-}
defaultCopyDirConfig :: CopyDirConfig
defaultCopyDirConfig :: CopyDirConfig
defaultCopyDirConfig = Overwrite -> TargetName -> CopyDirConfig
MkCopyDirConfig Overwrite
OverwriteNone TargetName
TargetNameSrc
copyDirectoryRecursive ::
forall m.
( HasCallStack,
MonadIORef m,
MonadMask m,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
OsPath ->
m ()
copyDirectoryRecursive :: forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> OsPath -> m ()
copyDirectoryRecursive = CopyDirConfig -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
MonadPathWriter m) =>
CopyDirConfig -> OsPath -> OsPath -> m ()
copyDirectoryRecursiveConfig CopyDirConfig
defaultCopyDirConfig
{-# INLINEABLE copyDirectoryRecursive #-}
copyDirectoryRecursiveConfig ::
forall m.
( HasCallStack,
MonadIORef m,
MonadMask m,
MonadPathReader m,
MonadPathWriter m
) =>
CopyDirConfig ->
OsPath ->
OsPath ->
m ()
copyDirectoryRecursiveConfig :: forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
MonadPathWriter m) =>
CopyDirConfig -> OsPath -> OsPath -> m ()
copyDirectoryRecursiveConfig CopyDirConfig
config OsPath
src OsPath
destRoot = do
String -> PathType -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
String -> PathType -> OsPath -> m ()
PR.throwIfWrongPathType String
"copyDirectoryRecursiveConfig" PathType
PathTypeDirectory OsPath
src
String -> PathType -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
String -> PathType -> OsPath -> m ()
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
TargetName
TargetNameSrc ->
let
(OsPath
_, OsPath
name) = OsPath -> (OsPath, OsPath)
FP.splitFileName (OsPath -> OsPath
FP.dropTrailingPathSeparator OsPath
src)
in OsPath
destRoot OsPath -> OsPath -> OsPath
</> OsPath
name
TargetNameLiteral OsPath
p -> OsPath
destRoot OsPath -> OsPath -> OsPath
</> OsPath
p
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 -> m ()
forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> OsPath -> m ()
copyDirectoryNoOverwrite OsPath
src OsPath
dest
Overwrite
OverwriteDirectories -> Bool -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
MonadPathWriter m) =>
Bool -> OsPath -> OsPath -> m ()
copyDirectoryOverwrite Bool
False OsPath
src OsPath
dest
Overwrite
OverwriteAll -> Bool -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
MonadPathWriter m) =>
Bool -> OsPath -> OsPath -> m ()
copyDirectoryOverwrite Bool
True OsPath
src OsPath
dest
{-# INLINEABLE copyDirectoryRecursiveConfig #-}
copyDirectoryOverwrite ::
forall m.
( HasCallStack,
MonadIORef m,
MonadMask m,
MonadPathReader m,
MonadPathWriter m
) =>
Bool ->
OsPath ->
OsPath ->
m ()
copyDirectoryOverwrite :: forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
MonadPathWriter m) =>
Bool -> OsPath -> OsPath -> m ()
copyDirectoryOverwrite Bool
overwriteFiles OsPath
src OsPath
dest = do
IORef [OsPath]
copiedFilesRef <- [OsPath] -> m (IORef [OsPath])
forall a. HasCallStack => a -> m (IORef a)
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef []
IORef [OsPath]
createdDirsRef <- [OsPath] -> m (IORef [OsPath])
forall a. HasCallStack => a -> m (IORef a)
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef []
IORef [OsPath]
copiedSymlinksRef <- [OsPath] -> m (IORef [OsPath])
forall a. HasCallStack => a -> m (IORef a)
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
a -> m (IORef a)
newIORef []
Bool
destExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath
dest
let checkFileOverwrites :: OsPath -> m ()
checkFileOverwrites =
if Bool -> Bool
not Bool
overwriteFiles
then \OsPath
f -> do
Bool
exists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath
f
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
OsPath -> String -> IOErrorType -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
OsPath -> String -> IOErrorType -> String -> m a
FS.IO.throwPathIOError
OsPath
f
String
"copyDirectoryOverwrite"
IOErrorType
Error.alreadyExistsErrorType
String
"Attempted file overwrite when CopyDirConfig.overwriteFiles is false"
else m () -> OsPath -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
checkSymlinkOverwrites :: OsPath -> m ()
checkSymlinkOverwrites =
if Bool -> Bool
not Bool
overwriteFiles
then \OsPath
f -> do
Bool
exists <- OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m Bool
doesSymbolicLinkExist OsPath
f
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
OsPath -> String -> IOErrorType -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
OsPath -> String -> IOErrorType -> String -> m a
FS.IO.throwPathIOError
OsPath
f
String
"copyDirectoryOverwrite"
IOErrorType
Error.alreadyExistsErrorType
String
"Attempted symlink overwrite when CopyDirConfig.overwriteFiles is false"
else m () -> OsPath -> m ()
forall a b. a -> b -> a
const (() -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
copyFiles :: m ()
copyFiles = do
([OsPath]
subFiles, [OsPath]
subDirs, [OsPath]
symlinks) <- OsPath -> m ([OsPath], [OsPath], [OsPath])
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m ([OsPath], [OsPath], [OsPath])
listDirectoryRecursiveSymbolicLink OsPath
src
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
destExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
createDirectory OsPath
dest
[OsPath] -> (OsPath -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [OsPath]
subDirs ((OsPath -> m ()) -> m ()) -> (OsPath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \OsPath
d -> do
let d' :: OsPath
d' = OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
d
Bool
dExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath
d'
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
dExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
createDirectoryIfMissing Bool
False OsPath
d'
IORef [OsPath] -> ([OsPath] -> [OsPath]) -> m ()
forall a. HasCallStack => IORef a -> (a -> a) -> m ()
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> (a -> a) -> m ()
modifyIORef' IORef [OsPath]
createdDirsRef (OsPath
d' :)
[OsPath] -> (OsPath -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [OsPath]
subFiles ((OsPath -> m ()) -> m ()) -> (OsPath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \OsPath
f -> do
let f' :: OsPath
f' = OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
f
OsPath -> m ()
checkFileOverwrites OsPath
f'
OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
copyFileWithMetadata (OsPath
src OsPath -> OsPath -> OsPath
</> OsPath
f) OsPath
f'
IORef [OsPath] -> ([OsPath] -> [OsPath]) -> m ()
forall a. HasCallStack => IORef a -> (a -> a) -> m ()
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> (a -> a) -> m ()
modifyIORef' IORef [OsPath]
copiedFilesRef (OsPath
f' :)
[OsPath] -> (OsPath -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [OsPath]
symlinks ((OsPath -> m ()) -> m ()) -> (OsPath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \OsPath
s -> do
let s' :: OsPath
s' = OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
s
OsPath -> m ()
checkSymlinkOverwrites OsPath
s'
OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> OsPath -> m ()
copySymbolicLink (OsPath
src OsPath -> OsPath -> OsPath
</> OsPath
s) OsPath
s'
IORef [OsPath] -> ([OsPath] -> [OsPath]) -> m ()
forall a. HasCallStack => IORef a -> (a -> a) -> m ()
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> (a -> a) -> m ()
modifyIORef' IORef [OsPath]
copiedSymlinksRef (OsPath
s' :)
cleanup :: m ()
cleanup =
if Bool
destExists
then do
IORef [OsPath] -> m [OsPath]
forall a. HasCallStack => IORef a -> m a
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef [OsPath]
copiedFilesRef m [OsPath] -> ([OsPath] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OsPath -> m ()) -> [OsPath] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeFile
IORef [OsPath] -> m [OsPath]
forall a. HasCallStack => IORef a -> m a
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef [OsPath]
createdDirsRef m [OsPath] -> ([OsPath] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OsPath -> m ()) -> [OsPath] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectory
IORef [OsPath] -> m [OsPath]
forall a. HasCallStack => IORef a -> m a
forall (m :: * -> *) a.
(MonadIORef m, HasCallStack) =>
IORef a -> m a
readIORef IORef [OsPath]
copiedSymlinksRef m [OsPath] -> ([OsPath] -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (OsPath -> m ()) -> [OsPath] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> m ()
removeSymbolicLink
else OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectoryRecursive OsPath
dest
m ()
copyFiles m () -> m () -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`onSyncException` m () -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
mask_ m ()
cleanup
{-# INLINEABLE copyDirectoryOverwrite #-}
copyDirectoryNoOverwrite ::
forall m.
( HasCallStack,
MonadIORef m,
MonadMask m,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
OsPath ->
m ()
copyDirectoryNoOverwrite :: forall (m :: * -> *).
(HasCallStack, MonadIORef m, MonadMask m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> OsPath -> m ()
copyDirectoryNoOverwrite OsPath
src OsPath
dest = do
Bool
destExists <- OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath
dest
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
destExists (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
OsPath -> String -> IOErrorType -> String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
OsPath -> String -> IOErrorType -> String -> m a
FS.IO.throwPathIOError
OsPath
dest
String
"copyDirectoryNoOverwrite"
IOErrorType
Error.alreadyExistsErrorType
String
"Attempted directory overwrite when CopyDirConfig.overwrite is OverwriteNone"
let copyFiles :: m ()
copyFiles = do
([OsPath]
subFiles, [OsPath]
subDirs, [OsPath]
symlinks) <- OsPath -> m ([OsPath], [OsPath], [OsPath])
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m ([OsPath], [OsPath], [OsPath])
listDirectoryRecursiveSymbolicLink OsPath
src
OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
createDirectory OsPath
dest
(OsPath -> m ()) -> [OsPath] -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Bool -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
Bool -> OsPath -> m ()
createDirectoryIfMissing Bool
True (OsPath -> m ()) -> (OsPath -> OsPath) -> OsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OsPath
dest </>)) [OsPath]
subDirs
[OsPath] -> (OsPath -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [OsPath]
subFiles ((OsPath -> m ()) -> m ()) -> (OsPath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \OsPath
f -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
copyFileWithMetadata (OsPath
src OsPath -> OsPath -> OsPath
</> OsPath
f) (OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
f)
[OsPath] -> (OsPath -> m ()) -> m ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [OsPath]
symlinks ((OsPath -> m ()) -> m ()) -> (OsPath -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \OsPath
s -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> OsPath -> m ()
copySymbolicLink (OsPath
src OsPath -> OsPath -> OsPath
</> OsPath
s) (OsPath
dest OsPath -> OsPath -> OsPath
</> OsPath
s)
cleanup :: m ()
cleanup = OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectoryRecursive OsPath
dest
m ()
copyFiles m () -> m () -> m ()
forall (m :: * -> *) a b.
(HasCallStack, MonadCatch m) =>
m a -> m b -> m a
`onSyncException` m () -> m ()
forall (m :: * -> *) a. (HasCallStack, MonadMask m) => m a -> m a
mask_ m ()
cleanup
{-# INLINEABLE copyDirectoryNoOverwrite #-}
removeFileIfExists_ ::
( HasCallStack,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m ()
removeFileIfExists_ :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m ()
removeFileIfExists_ = m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> (OsPath -> m Bool) -> OsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m Bool
removeFileIfExists
{-# INLINEABLE removeFileIfExists_ #-}
removeFileIfExists ::
( HasCallStack,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m Bool
removeFileIfExists :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m Bool
removeFileIfExists = (OsPath -> m Bool) -> (OsPath -> m ()) -> OsPath -> m Bool
forall (m :: * -> *) t.
Monad m =>
(t -> m Bool) -> (t -> m ()) -> t -> m Bool
removeIfExists OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesFileExist OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeFile
{-# INLINEABLE removeFileIfExists #-}
removeDirectoryIfExists_ ::
( HasCallStack,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m ()
removeDirectoryIfExists_ :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m ()
removeDirectoryIfExists_ = m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> (OsPath -> m Bool) -> OsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m Bool
removeDirectoryIfExists
{-# INLINEABLE removeDirectoryIfExists_ #-}
removeDirectoryIfExists ::
( HasCallStack,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m Bool
removeDirectoryIfExists :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m Bool
removeDirectoryIfExists = (OsPath -> m Bool) -> (OsPath -> m ()) -> OsPath -> m Bool
forall (m :: * -> *) t.
Monad m =>
(t -> m Bool) -> (t -> m ()) -> t -> m Bool
removeIfExists OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectory
{-# INLINEABLE removeDirectoryIfExists #-}
removeDirectoryRecursiveIfExists_ ::
( HasCallStack,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m ()
removeDirectoryRecursiveIfExists_ :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m ()
removeDirectoryRecursiveIfExists_ = m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> (OsPath -> m Bool) -> OsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m Bool
removeDirectoryRecursiveIfExists
{-# INLINEABLE removeDirectoryRecursiveIfExists_ #-}
removeDirectoryRecursiveIfExists ::
( HasCallStack,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m Bool
removeDirectoryRecursiveIfExists :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m Bool
removeDirectoryRecursiveIfExists =
(OsPath -> m Bool) -> (OsPath -> m ()) -> OsPath -> m Bool
forall (m :: * -> *) t.
Monad m =>
(t -> m Bool) -> (t -> m ()) -> t -> m Bool
removeIfExists OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesDirectoryExist OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectoryRecursive
{-# INLINEABLE removeDirectoryRecursiveIfExists #-}
removePathForciblyIfExists_ ::
( HasCallStack,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m ()
removePathForciblyIfExists_ :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m ()
removePathForciblyIfExists_ = m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> (OsPath -> m Bool) -> OsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m Bool
removePathForciblyIfExists
{-# INLINEABLE removePathForciblyIfExists_ #-}
removePathForciblyIfExists ::
( HasCallStack,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m Bool
removePathForciblyIfExists :: forall (m :: * -> *).
(HasCallStack, MonadPathReader m, MonadPathWriter m) =>
OsPath -> m Bool
removePathForciblyIfExists =
(OsPath -> m Bool) -> (OsPath -> m ()) -> OsPath -> m Bool
forall (m :: * -> *) t.
Monad m =>
(t -> m Bool) -> (t -> m ()) -> t -> m Bool
removeIfExists OsPath -> m Bool
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m Bool
doesPathExist OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removePathForcibly
{-# INLINEABLE removePathForciblyIfExists #-}
removeSymbolicLinkIfExists_ ::
( HasCallStack,
MonadCatch m,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m ()
removeSymbolicLinkIfExists_ :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> m ()
removeSymbolicLinkIfExists_ = m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> (OsPath -> m Bool) -> OsPath -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> m Bool
removeSymbolicLinkIfExists
{-# INLINEABLE removeSymbolicLinkIfExists_ #-}
removeSymbolicLinkIfExists ::
( HasCallStack,
MonadCatch m,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m Bool
removeSymbolicLinkIfExists :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> m Bool
removeSymbolicLinkIfExists =
(OsPath -> m Bool) -> (OsPath -> m ()) -> OsPath -> m Bool
forall (m :: * -> *) t.
Monad m =>
(t -> m Bool) -> (t -> m ()) -> t -> m Bool
removeIfExists OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
OsPath -> m Bool
doesSymbolicLinkExist OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> m ()
removeSymbolicLink
{-# INLINEABLE removeSymbolicLinkIfExists #-}
removeIfExists :: (Monad m) => (t -> m Bool) -> (t -> m ()) -> t -> m Bool
removeIfExists :: forall (m :: * -> *) t.
Monad m =>
(t -> m Bool) -> (t -> m ()) -> t -> m Bool
removeIfExists t -> m Bool
existsFn t -> m ()
deleteFn t
f = do
Bool
exists <- t -> m Bool
existsFn t
f
if Bool
exists
then t -> m ()
deleteFn t
f m () -> Bool -> m Bool
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
else Bool -> m Bool
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
{-# INLINEABLE removeIfExists #-}
removeSymbolicLink ::
( HasCallStack,
MonadCatch m,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
m ()
removeSymbolicLink :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> m ()
removeSymbolicLink OsPath
p = do
String -> PathType -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
String -> PathType -> OsPath -> m ()
PR.throwIfWrongPathType String
"removeSymbolicLink" PathType
PathTypeSymbolicLink OsPath
p
OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m Bool
pathIsSymbolicDirectoryLink OsPath
p m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeDirectoryLink OsPath
p
Bool
False -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> m ()
removeFile OsPath
p
{-# INLINEABLE removeSymbolicLink #-}
copySymbolicLink ::
( HasCallStack,
MonadCatch m,
MonadPathReader m,
MonadPathWriter m
) =>
OsPath ->
OsPath ->
m ()
copySymbolicLink :: forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m,
MonadPathWriter m) =>
OsPath -> OsPath -> m ()
copySymbolicLink OsPath
src OsPath
dest = do
String -> PathType -> OsPath -> m ()
forall (m :: * -> *).
(HasCallStack, MonadCatch m, MonadPathReader m) =>
String -> PathType -> OsPath -> m ()
PR.throwIfWrongPathType String
"copySymbolicLink" PathType
PathTypeSymbolicLink OsPath
src
OsPath
target <- OsPath -> m OsPath
forall (m :: * -> *).
(MonadPathReader m, HasCallStack) =>
OsPath -> m OsPath
getSymbolicLinkTarget OsPath
src
OsPath -> m Bool
forall (m :: * -> *).
(HasCallStack, MonadPathReader m) =>
OsPath -> m Bool
pathIsSymbolicDirectoryLink OsPath
src m Bool -> (Bool -> m ()) -> m ()
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Bool
True -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
createDirectoryLink OsPath
target OsPath
dest
Bool
False -> OsPath -> OsPath -> m ()
forall (m :: * -> *).
(MonadPathWriter m, HasCallStack) =>
OsPath -> OsPath -> m ()
createFileLink OsPath
target OsPath
dest
{-# INLINEABLE copySymbolicLink #-}