improve drop proof code

2 files changed, 28 insertions, 23 deletions

diff --git a/Command/Drop.hs b/Command/Drop.hs
index 26872c6c0..fa8ac45ad 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -99,12 +99,12 @@ performLocal key afile numcopies preverified = lockContentExclusive key $ \conte
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = Remote.remotesWithoutUUID remotes (map toUUID preverified'++untrusteduuids)
 	u <- getUUID
-	ifM (canDrop u key afile numcopies [] preverified' tocheck)
+	doDrop u key afile numcopies [] preverified' tocheck
 		( do
 			removeAnnex contentlock
 			notifyDrop afile True
 			next $ cleanupLocal key
-		, do
+		, do 
 			notifyDrop afile False
 			stop
 		)
@@ -121,9 +121,12 @@ performRemote key afile numcopies remote = do
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = filter (/= remote) $
 		Remote.remotesWithoutUUID remotes (trusted++untrusteduuids)
-	stopUnless (canDrop uuid key afile numcopies [uuid] preverified tocheck) $ do
-		ok <- Remote.removeKey remote key
-		next $ cleanupRemote key remote ok
+	doDrop uuid key afile numcopies [uuid] preverified tocheck
+		( do 
+			ok <- Remote.removeKey remote key
+			next $ cleanupRemote key remote ok
+		, stop
+		)
   where
 	uuid = Remote.uuid remote
 
@@ -138,29 +141,29 @@ cleanupRemote key remote ok = do
 		Remote.logStatus remote key InfoMissing
 	return ok
 
-{- Checks specified remotes to verify that enough copies of a key exist to
- - allow it to be safely removed (with no data loss).
+{- Before running the dropaction, checks specified remotes to
+ - verify that enough copies of a key exist to allow it to be
+ - safely removed (with no data loss).
  -
  - Also checks if it's required content, and refuses to drop if so.
  -
  - --force overrides and always allows dropping.
  -}
-canDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [VerifiedCopy] -> [Remote] -> Annex Bool
-canDrop dropfrom key afile numcopies skip preverified check = 
+doDrop :: UUID -> Key -> AssociatedFile -> NumCopies -> [UUID] -> [VerifiedCopy] -> [Remote] -> (CommandPerform, CommandPerform) -> CommandPerform
+doDrop dropfrom key afile numcopies skip preverified check (dropaction, nodropaction) = 
 	ifM (Annex.getState Annex.force)
-		( return True
-			, ifM (checkRequiredContent dropfrom key afile
-				<&&> verifyEnoughCopies nolocmsg key numcopies skip preverified check
-				)
-				( return True
-				, do
-					hint
-					return False
-				)
+		( dropaction
+		, ifM (checkRequiredContent dropfrom key afile)
+			( verifyEnoughCopiesToDrop nolocmsg key numcopies
+				skip preverified check (const dropaction) (forcehint nodropaction)
+			, stop
+			)
 		)
   where
 	nolocmsg = "Rather than dropping this file, try using: git annex move"
-	hint = showLongNote "(Use --force to override this check, or adjust numcopies.)"
+	forcehint a = do
+		showLongNote "(Use --force to override this check, or adjust numcopies.)"
+		a
 
 checkRequiredContent :: UUID -> Key -> AssociatedFile -> Annex Bool
 checkRequiredContent u k afile =
diff --git a/Command/Import.hs b/Command/Import.hs
index 3206ad48b..f486da7c5 100644
--- a/Command/Import.hs
+++ b/Command/Import.hs
@@ -83,7 +83,7 @@ start mode (srcfile, destfile) =
   where
 	deletedup k = do
 		showNote $ "duplicate of " ++ key2file k
-		ifM (verifiedExisting k destfile)
+		verifyExisting k destfile
 			( do
 				liftIO $ removeFile srcfile
 				next $ return True
@@ -134,8 +134,8 @@ start mode (srcfile, destfile) =
 		SkipDuplicates -> checkdup Nothing (Just importfile)
 		_ -> return (Just importfile)
 
-verifiedExisting :: Key -> FilePath -> Annex Bool
-verifiedExisting key destfile = do
+verifyExisting :: Key -> FilePath -> (CommandPerform, CommandPerform) -> CommandPerform
+verifyExisting key destfile (yes, no) = do
 	-- Look up the numcopies setting for the file that it would be
 	-- imported to, if it were imported.
 	need <- getFileNumCopies destfile
@@ -143,4 +143,6 @@ verifiedExisting key destfile = do
 	(remotes, trusteduuids) <- knownCopies key
 	untrusteduuids <- trustGet UnTrusted
 	let tocheck = Remote.remotesWithoutUUID remotes (trusteduuids++untrusteduuids)
-	verifyEnoughCopies [] key need [] (map (mkVerifiedCopy TrustedCopy) trusteduuids) tocheck
+	let preverified = map (mkVerifiedCopy TrustedCopy) trusteduuids
+	verifyEnoughCopiesToDrop [] key need [] preverified tocheck
+		(const yes) no