summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2017-09-15 16:30:49 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2017-09-15 16:30:49 -0400
commit2d3f18876550ee2e37a60aea1c0faaa369606ae0 (patch)
tree5da6331d2e4d03748cf0c00c0cb87d82c78c16c1
parentc26b2eb2a4f261fd903b02d397737cf6a3a0196b (diff)
avoid unncessary db queries when exported directory can't be empty
In rename foo/bar to foo/baz, foo can't be empty. In delete zxyyz, there's no exported directory (top doesn't count).
-rw-r--r--Command/Export.hs4
-rw-r--r--Remote/Helper/Export.hs26
-rw-r--r--Types/Remote.hs13
3 files changed, 24 insertions, 19 deletions
diff --git a/Command/Export.hs b/Command/Export.hs
index 56676809f..cc463b7dc 100644
--- a/Command/Export.hs
+++ b/Command/Export.hs
@@ -321,4 +321,6 @@ cleanupRename ea db ek src dest = do
removeExportLocation db (asKey ek) src
addExportLocation db (asKey ek) dest
flushDbQueue db
- removeEmptyDirectories ea db src [asKey ek]
+ if exportedDirectories src /= exportedDirectories dest
+ then removeEmptyDirectories ea db src [asKey ek]
+ else return True
diff --git a/Remote/Helper/Export.hs b/Remote/Helper/Export.hs
index 101124cef..3067ac837 100644
--- a/Remote/Helper/Export.hs
+++ b/Remote/Helper/Export.hs
@@ -151,18 +151,20 @@ adjustExportable r = case M.lookup "exporttree" (config r) of
-- 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
+removeEmptyDirectories ea db loc ks
+ | null (exportedDirectories loc) = return True
+ | otherwise = 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)
diff --git a/Types/Remote.hs b/Types/Remote.hs
index 671d90b79..adec32973 100644
--- a/Types/Remote.hs
+++ b/Types/Remote.hs
@@ -27,8 +27,8 @@ module Types.Remote
where
import qualified Data.Map as M
-import Data.Ord
import qualified System.FilePath.Posix as Posix
+import Data.Ord
import qualified Git
import Types.Key
@@ -201,13 +201,14 @@ data ExportActions a = ExportActions
, renameExport :: Key -> ExportLocation -> ExportLocation -> a Bool
}
--- | All directories down to the ExportLocation, with the deepest ones
--- last.
+-- | All subdirectories down to the ExportLocation, with the deepest ones
+-- last. Does not include the top of the export.
exportedDirectories :: ExportLocation -> [ExportDirectory]
exportedDirectories (ExportLocation f) =
- map (ExportDirectory . Posix.joinPath . reverse) $
- subs [] $ map Posix.dropTrailingPathSeparator $
- Posix.splitPath $ Posix.takeDirectory f
+ map (ExportDirectory . Posix.joinPath . reverse) (subs [] dirs)
where
subs _ [] = []
subs ps (d:ds) = (d:ps) : subs (d:ps) ds
+
+ dirs = map Posix.dropTrailingPathSeparator $
+ reverse $ drop 1 $ reverse $ Posix.splitPath f