aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Command/Export.hs22
-rw-r--r--Database/Export.hs12
-rw-r--r--Remote/Helper/Export.hs38
-rw-r--r--Types/Remote.hs15
4 files changed, 58 insertions, 29 deletions
diff --git a/Command/Export.hs b/Command/Export.hs
index 2c75d0164..56676809f 100644
--- a/Command/Export.hs
+++ b/Command/Export.hs
@@ -25,6 +25,7 @@ import Annex.CatFile
import Logs.Location
import Logs.Export
import Database.Export
+import Remote.Helper.Export
import Messages.Progress
import Utility.Tmp
@@ -252,24 +253,24 @@ startUnexport' r ea db f ek = do
performUnexport :: Remote -> ExportActions Annex -> ExportHandle -> [ExportKey] -> ExportLocation -> CommandPerform
performUnexport r ea db eks loc = do
ifM (allM (\ek -> removeExport ea (asKey ek) loc) eks)
- ( next $ cleanupUnexport r db eks loc
+ ( next $ cleanupUnexport r ea db eks loc
, stop
)
-cleanupUnexport :: Remote -> ExportHandle -> [ExportKey] -> ExportLocation -> CommandCleanup
-cleanupUnexport r db eks loc = do
+cleanupUnexport :: Remote -> ExportActions Annex -> ExportHandle -> [ExportKey] -> ExportLocation -> CommandCleanup
+cleanupUnexport r ea db eks loc = do
liftIO $ do
forM_ eks $ \ek ->
removeExportLocation db (asKey ek) loc
- -- Flush so that getExportLocation sees this and any
- -- other removals of the key.
flushDbQueue db
+
remaininglocs <- liftIO $
concat <$> forM eks (\ek -> getExportLocation db (asKey ek))
when (null remaininglocs) $
forM_ eks $ \ek ->
logChange (asKey ek) (uuid r) InfoMissing
- return True
+
+ removeEmptyDirectories ea db loc (map asKey eks)
startRecoverIncomplete :: Remote -> ExportActions Annex -> ExportHandle -> Git.Sha -> TopFilePath -> CommandStart
startRecoverIncomplete r ea db sha oldf
@@ -306,7 +307,7 @@ startMoveFromTempName r ea db ek f = do
performRename :: Remote -> ExportActions Annex -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandPerform
performRename r ea db ek src dest = do
ifM (renameExport ea (asKey ek) src dest)
- ( next $ cleanupRename db ek src dest
+ ( next $ cleanupRename ea db ek src dest
-- In case the special remote does not support renaming,
-- unexport the src instead.
, do
@@ -314,11 +315,10 @@ performRename r ea db ek src dest = do
performUnexport r ea db [ek] src
)
-cleanupRename :: ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandCleanup
-cleanupRename db ek src dest = do
+cleanupRename :: ExportActions Annex -> ExportHandle -> ExportKey -> ExportLocation -> ExportLocation -> CommandCleanup
+cleanupRename ea db ek src dest = do
liftIO $ do
removeExportLocation db (asKey ek) src
addExportLocation db (asKey ek) dest
- -- Flush so that getExportLocation sees this.
flushDbQueue db
- return True
+ removeEmptyDirectories ea db src [asKey ek]
diff --git a/Database/Export.hs b/Database/Export.hs
index eb644efc7..cfd3f7745 100644
--- a/Database/Export.hs
+++ b/Database/Export.hs
@@ -28,11 +28,10 @@ import qualified Database.Queue as H
import Database.Init
import Annex.Locations
import Annex.Common hiding (delete)
-import Types.Remote (ExportLocation(..), ExportDirectory(..))
+import Types.Remote (ExportLocation(..), ExportDirectory(..), exportedDirectories)
import Database.Persist.TH
import Database.Esqueleto hiding (Key)
-import qualified System.FilePath.Posix as Posix
newtype ExportHandle = ExportHandle H.DbQueue
@@ -114,12 +113,3 @@ isExportDirectoryEmpty (ExportHandle h) (ExportDirectory d) = H.queryDbQueue h $
return $ null l
where
ed = toSFilePath d
-
-exportedDirectories :: ExportLocation -> [ExportDirectory]
-exportedDirectories (ExportLocation f) =
- map (ExportDirectory . Posix.joinPath . reverse) $
- subs [] $ map Posix.dropTrailingPathSeparator $
- Posix.splitPath $ Posix.takeDirectory f
- where
- subs _ [] = []
- subs ps (d:ds) = (d:ps) : subs (d:ps) ds
diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs
index 44fa47ca5..101124cef 100644
--- a/Remote/Helper/Export.hs
+++ b/Remote/Helper/Export.hs
@@ -120,12 +120,15 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
, removeKey = \k -> do
locs <- liftIO $ getExportLocation db k
ea <- exportActions r
- oks <- forM locs $ \loc -> do
- ok <- removeExport ea k loc
- when ok $
- liftIO $ removeExportLocation db k loc
- return ok
- liftIO $ flushDbQueue db
+ oks <- forM locs $ \loc ->
+ ifM (removeExport ea k loc)
+ ( do
+ liftIO $ do
+ removeExportLocation db k loc
+ flushDbQueue db
+ removeEmptyDirectories ea db loc [k]
+ , return False
+ )
return (and oks)
-- Can't lock content on exports, since they're
-- not key/value stores, and someone else could
@@ -143,3 +146,26 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
is <- getInfo r
return (is++[("export", "yes")])
}
+
+-- | Remove empty directories from the export. Call after removing an
+-- exported file, and after calling removeExportLocation and flushing the
+-- database.
+removeEmptyDirectories :: ExportActions Annex -> ExportHandle -> ExportLocation -> [Key] -> Annex Bool
+removeEmptyDirectories ea db loc ks = case removeExportDirectory ea of
+ Nothing -> return True
+ Just removeexportdirectory -> do
+ ok <- allM (go removeexportdirectory)
+ (reverse (exportedDirectories loc))
+ unless ok $ liftIO $ do
+ -- Add back to export database, so this is
+ -- tried again next time.
+ forM_ ks $ \k ->
+ addExportLocation db k loc
+ flushDbQueue db
+ return ok
+ where
+ go removeexportdirectory d =
+ ifM (liftIO $ isExportDirectoryEmpty db d)
+ ( removeexportdirectory d
+ , return True
+ )
diff --git a/Types/Remote.hs b/Types/Remote.hs
index 798bf1af5..671d90b79 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -22,11 +22,13 @@ module Types.Remote
, ExportDirectory(..)
, isExportSupported
, ExportActions(..)
+ , exportedDirectories
)
where
-import Data.Map as M
+import qualified Data.Map as M
import Data.Ord
+import qualified System.FilePath.Posix as Posix
import qualified Git
import Types.Key
@@ -198,3 +200,14 @@ data ExportActions a = ExportActions
-- support renames.
, renameExport :: Key -> ExportLocation -> ExportLocation -> a Bool
}
+
+-- | All directories down to the ExportLocation, with the deepest ones
+-- last.
+exportedDirectories :: ExportLocation -> [ExportDirectory]
+exportedDirectories (ExportLocation f) =
+ map (ExportDirectory . Posix.joinPath . reverse) $
+ subs [] $ map Posix.dropTrailingPathSeparator $
+ Posix.splitPath $ Posix.takeDirectory f
+ where
+ subs _ [] = []
+ subs ps (d:ds) = (d:ps) : subs (d:ps) ds
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-02 10:24:57 +0000