diff --git a/Command/Export.hs b/Command/Export.hs index 2c75d0164c..56676809fc 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 eb644efc71..cfd3f77459 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 44fa47ca56..101124cef2 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 798bf1af5e..671d90b79d 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