diff options
Diffstat (limited to 'Command/Drop.hs')
| -rw-r--r-- | Command/Drop.hs | 41 |
1 files changed, 22 insertions, 19 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 = |