diff options
author | Joey Hess <joeyh@joeyh.name> | 2017-09-15 13:15:47 -0400 |
---|---|---|
committer | Joey Hess <joeyh@joeyh.name> | 2017-09-15 13:18:21 -0400 |
commit | 269c6925ded8145aaea1f8ccdbb747f65f076131 (patch) | |
tree | 53baca2cb95215158d98e008614f4e7ab5e79e95 /Remote/Directory.hs | |
parent | 1890f6ee7a791db909055b4760919e6979ddd3ae (diff) |
implement removeExportDirectory
Not yet called by Command.Export.
WebDAV needs this to clean up empty collections. Also, example.sh turned
out to not be cleaning up directories when removing content
from them, so it made sense for it to use this.
Remote.Directory did not need it, and since its cleanup method for empty
directories is more efficient than what Command.Export will need to do
to find empty directories, it uses Nothing so that extra work can be
avoided.
This commit was sponsored by Thom May on Patreon.
Diffstat (limited to 'Remote/Directory.hs')
-rw-r--r-- | Remote/Directory.hs | 67 |
1 files changed, 35 insertions, 32 deletions
diff --git a/Remote/Directory.hs b/Remote/Directory.hs index c3ebeb899..24f35868b 100644 --- a/Remote/Directory.hs +++ b/Remote/Directory.hs @@ -47,26 +47,29 @@ gen r u c gc = do let chunkconfig = getChunkConfig c return $ Just $ specialRemote c (prepareStore dir chunkconfig) - (retrieve dir chunkconfig) - (simplyPrepare $ remove dir) - (simplyPrepare $ checkKey dir chunkconfig) + (retrieveKeyFileM dir chunkconfig) + (simplyPrepare $ removeKeyM dir) + (simplyPrepare $ checkPresentM dir chunkconfig) Remote { uuid = u , cost = cst , name = Git.repoDescribe r , storeKey = storeKeyDummy , retrieveKeyFile = retreiveKeyFileDummy - , retrieveKeyFileCheap = retrieveCheap dir chunkconfig + , retrieveKeyFileCheap = retrieveKeyFileCheapM dir chunkconfig , removeKey = removeKeyDummy , lockContent = Nothing , checkPresent = checkPresentDummy , checkPresentCheap = True , exportActions = return $ ExportActions - { storeExport = storeExportDirectory dir - , retrieveExport = retrieveExportDirectory dir - , removeExport = removeExportDirectory dir - , checkPresentExport = checkPresentExportDirectory dir - , renameExport = renameExportDirectory dir + { storeExport = storeExportM dir + , retrieveExport = retrieveExportM dir + , removeExport = removeExportM dir + , checkPresentExport = checkPresentExportM dir + -- Not needed because removeExportLocation + -- auto-removes empty directories. + , removeExportDirectory = Nothing + , renameExport = renameExportM dir } , whereisKey = Nothing , remoteFsck = Nothing @@ -166,17 +169,17 @@ finalizeStoreGeneric tmp dest = do mapM_ preventWrite =<< dirContents dest preventWrite dest -retrieve :: FilePath -> ChunkConfig -> Preparer Retriever -retrieve d (LegacyChunks _) = Legacy.retrieve locations d -retrieve d _ = simplyPrepare $ byteRetriever $ \k sink -> +retrieveKeyFileM :: FilePath -> ChunkConfig -> Preparer Retriever +retrieveKeyFileM d (LegacyChunks _) = Legacy.retrieve locations d +retrieveKeyFileM d _ = simplyPrepare $ byteRetriever $ \k sink -> sink =<< liftIO (L.readFile =<< getLocation d k) -retrieveCheap :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> Annex Bool +retrieveKeyFileCheapM :: FilePath -> ChunkConfig -> Key -> AssociatedFile -> FilePath -> Annex Bool -- no cheap retrieval possible for chunks -retrieveCheap _ (UnpaddedChunks _) _ _ _ = return False -retrieveCheap _ (LegacyChunks _) _ _ _ = return False +retrieveKeyFileCheapM _ (UnpaddedChunks _) _ _ _ = return False +retrieveKeyFileCheapM _ (LegacyChunks _) _ _ _ = return False #ifndef mingw32_HOST_OS -retrieveCheap d NoChunks k _af f = liftIO $ catchBoolIO $ do +retrieveKeyFileCheapM d NoChunks k _af f = liftIO $ catchBoolIO $ do file <- absPath =<< getLocation d k ifM (doesFileExist file) ( do @@ -185,11 +188,11 @@ retrieveCheap d NoChunks k _af f = liftIO $ catchBoolIO $ do , return False ) #else -retrieveCheap _ _ _ _ _ = return False +retrieveKeyFileCheapM _ _ _ _ _ = return False #endif -remove :: FilePath -> Remover -remove d k = liftIO $ removeDirGeneric d (storeDir d k) +removeKeyM :: FilePath -> Remover +removeKeyM d k = liftIO $ removeDirGeneric d (storeDir d k) {- Removes the directory, which must be located under the topdir. - @@ -216,9 +219,9 @@ removeDirGeneric topdir dir = do then return ok else doesDirectoryExist topdir <&&> (not <$> doesDirectoryExist dir) -checkKey :: FilePath -> ChunkConfig -> CheckPresent -checkKey d (LegacyChunks _) k = Legacy.checkKey d locations k -checkKey d _ k = checkPresentGeneric d (locations d k) +checkPresentM :: FilePath -> ChunkConfig -> CheckPresent +checkPresentM d (LegacyChunks _) k = Legacy.checkKey d locations k +checkPresentM d _ k = checkPresentGeneric d (locations d k) checkPresentGeneric :: FilePath -> [FilePath] -> Annex Bool checkPresentGeneric d ps = liftIO $ @@ -230,8 +233,8 @@ checkPresentGeneric d ps = liftIO $ ) ) -storeExportDirectory :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool -storeExportDirectory d src _k loc p = liftIO $ catchBoolIO $ do +storeExportM :: FilePath -> FilePath -> Key -> ExportLocation -> MeterUpdate -> Annex Bool +storeExportM d src _k loc p = liftIO $ catchBoolIO $ do createDirectoryIfMissing True (takeDirectory dest) -- Write via temp file so that checkPresentGeneric will not -- see it until it's fully stored. @@ -240,27 +243,27 @@ storeExportDirectory d src _k loc p = liftIO $ catchBoolIO $ do where dest = exportPath d loc -retrieveExportDirectory :: FilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool -retrieveExportDirectory d _k loc dest p = liftIO $ catchBoolIO $ do +retrieveExportM :: FilePath -> Key -> ExportLocation -> FilePath -> MeterUpdate -> Annex Bool +retrieveExportM d _k loc dest p = liftIO $ catchBoolIO $ do withMeteredFile src p (L.writeFile dest) return True where src = exportPath d loc -removeExportDirectory :: FilePath -> Key -> ExportLocation -> Annex Bool -removeExportDirectory d _k loc = liftIO $ do +removeExportM :: FilePath -> Key -> ExportLocation -> Annex Bool +removeExportM d _k loc = liftIO $ do nukeFile src removeExportLocation d loc return True where src = exportPath d loc -checkPresentExportDirectory :: FilePath -> Key -> ExportLocation -> Annex Bool -checkPresentExportDirectory d _k loc = +checkPresentExportM :: FilePath -> Key -> ExportLocation -> Annex Bool +checkPresentExportM d _k loc = checkPresentGeneric d [exportPath d loc] -renameExportDirectory :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex Bool -renameExportDirectory d _k oldloc newloc = liftIO $ catchBoolIO $ do +renameExportM :: FilePath -> Key -> ExportLocation -> ExportLocation -> Annex Bool +renameExportM d _k oldloc newloc = liftIO $ catchBoolIO $ do createDirectoryIfMissing True (takeDirectory dest) renameFile src dest removeExportLocation d oldloc |