Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Synopsis
- mergeFileTree :: (MonadMask m, MonadReader env m, HasDirs env, HasLog env, MonadCatch m, MonadIO m, MonadUnliftIO m) => GHCupPath -> InstallDirResolved -> Tool -> GHCTargetVersion -> (FilePath -> FilePath -> m ()) -> Excepts '[MergeFileTreeError] m ()
- copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Bool -> Excepts xs m ()
- findFilesDeep :: GHCupPath -> Regex -> IO [FilePath]
- getDirectoryContentsRecursive :: MonadResource m => GHCupPath -> ConduitT i FilePath m ()
- getDirectoryContentsRecursiveUnsafe :: MonadResource m => FilePath -> ConduitT i FilePath m ()
- recordedInstallationFile :: (MonadReader env m, HasDirs env) => Tool -> GHCTargetVersion -> m FilePath
- module GHCup.Prelude.File.Search
- chmod_755 :: MonadIO m => FilePath -> m ()
- isBrokenSymlink :: FilePath -> IO Bool
- copyFile :: FilePath -> FilePath -> Bool -> IO ()
- deleteFile :: FilePath -> IO ()
- install :: FilePath -> FilePath -> Bool -> IO ()
- removeEmptyDirectory :: FilePath -> IO ()
- removeDirIfEmptyOrIsSymlink :: (MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
- removeEmptyDirsRecursive :: (MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m ()
- rmFileForce :: (MonadMask m, MonadIO m) => FilePath -> m ()
- createDirRecursive' :: FilePath -> IO ()
- recyclePathForcibly :: (MonadIO m, MonadReader env m, HasDirs env, MonadMask m) => GHCupPath -> m ()
- rmDirectory :: (MonadIO m, MonadMask m) => GHCupPath -> m ()
- recycleFile :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env) => FilePath -> m ()
- rmFile :: (MonadIO m, MonadMask m) => FilePath -> m ()
- rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env) => FilePath -> m ()
- moveFilePortable :: FilePath -> FilePath -> IO ()
- moveFile :: FilePath -> FilePath -> IO ()
- rmPathForcibly :: (MonadIO m, MonadMask m) => GHCupPath -> m ()
- exeExt :: String
- exeExt' :: ByteString
- getLinkTarget :: FilePath -> IO FilePath
- pathIsLink :: FilePath -> IO Bool
- rmLink :: (MonadReader env m, HasDirs env, MonadIO m, MonadMask m) => FilePath -> m ()
- createLink :: (MonadMask m, MonadThrow m, HasLog env, MonadIO m, MonadReader env m, HasDirs env, MonadUnliftIO m, MonadFail m) => FilePath -> FilePath -> m ()
Documentation
:: (MonadMask m, MonadReader env m, HasDirs env, HasLog env, MonadCatch m, MonadIO m, MonadUnliftIO m) | |
=> GHCupPath | source base directory from which to install findFiles |
-> InstallDirResolved | destination base dir |
-> Tool | |
-> GHCTargetVersion | |
-> (FilePath -> FilePath -> m ()) | file copy operation |
-> Excepts '[MergeFileTreeError] m () |
Merge one file tree to another given a copy operation.
Records every successfully installed file into the destination
returned by recordedInstallationFile
.
If any copy operation fails, the record file is deleted, as well as the partially installed files.
copyFileE :: (CopyError :< xs, MonadCatch m, MonadIO m) => FilePath -> FilePath -> Bool -> Excepts xs m () Source #
getDirectoryContentsRecursive :: MonadResource m => GHCupPath -> ConduitT i FilePath m () Source #
getDirectoryContentsRecursiveUnsafe :: MonadResource m => FilePath -> ConduitT i FilePath m () Source #
recordedInstallationFile :: (MonadReader env m, HasDirs env) => Tool -> GHCTargetVersion -> m FilePath Source #
module GHCup.Prelude.File.Search
deleteFile :: FilePath -> IO () Source #
Deletes the given file. Raises eISDIR
if run on a directory. Does not follow symbolic links.
Throws:
InappropriateType
for wrong file type (directory)NoSuchThing
if the file does not existPermissionDenied
if the directory cannot be read
Notes: calls unlink
removeEmptyDirectory :: FilePath -> IO () Source #
removeDirIfEmptyOrIsSymlink :: (MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () Source #
removeEmptyDirsRecursive :: (MonadMask m, MonadIO m, MonadCatch m) => FilePath -> m () Source #
createDirRecursive' :: FilePath -> IO () Source #
More permissive version of createDirRecursive
. This doesn't
error when the destination is a symlink to a directory.
recyclePathForcibly :: (MonadIO m, MonadReader env m, HasDirs env, MonadMask m) => GHCupPath -> m () Source #
recycleFile :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env) => FilePath -> m () Source #
rmDirectoryLink :: (MonadIO m, MonadMask m, MonadReader env m, HasDirs env) => FilePath -> m () Source #
exeExt' :: ByteString Source #
The file extension for executables.
getLinkTarget :: FilePath -> IO FilePath Source #
On unix, we can use symlinks, so we just get the symbolic link target.
On windows, we have to emulate symlinks via shims,
see createLink
.
:: (MonadMask m, MonadThrow m, HasLog env, MonadIO m, MonadReader env m, HasDirs env, MonadUnliftIO m, MonadFail m) | |
=> FilePath | path to the target executable |
-> FilePath | path to be created |
-> m () |
Creates a symbolic link on unix and a fake symlink on windows for executables, which: 1. is a shim exe 2. has a corresponding .shim file in the same directory that contains the target
This overwrites previously existing files.
On windows, this requires that ensureShimGen
was run beforehand.