From e3154828f5f44071536c19044ea14240efd9880c Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 20 Jan 2014 13:31:03 -0400
Subject: much better command action handling for sync --content

---
 Annex/Drop.hs | 31 ++++++++++++++-----------------
 1 file changed, 14 insertions(+), 17 deletions(-)

(limited to 'Annex')

diff --git a/Annex/Drop.hs b/Annex/Drop.hs
index 3e915c315..6386f11bb 100644
--- a/Annex/Drop.hs
+++ b/Annex/Drop.hs
@@ -18,6 +18,7 @@ import Annex.Wanted
 import Annex.Exception
 import Config
 import Annex.Content.Direct
+import RunCommand
 
 import qualified Data.Set as S
 import System.Log.Logger (debugM)
@@ -27,29 +28,24 @@ type Reason = String
 {- Drop a key from local and/or remote when allowed by the preferred content
  - and numcopies settings.
  -
- - The Remote list can include other remotes that do not have the content.
+ - The UUIDs are ones where the content is believed to be present.
+ - The Remote list can include other remotes that do not have the content;
+ - only ones that match the UUIDs will be dropped from.
+ - If allowed to drop fromhere, that drop will be tried first.
  -
  - A remote can be specified that is known to have the key. This can be
  - used an an optimisation when eg, a key has just been uploaded to a
  - remote.
- -}
-handleDrops :: Reason -> [Remote] -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex ()
-handleDrops _ _ _ _ Nothing _ = noop
-handleDrops reason rs fromhere key f knownpresentremote = do
-	locs <- loggedLocations key
-	handleDropsFrom locs rs reason fromhere key f knownpresentremote
-
-{- The UUIDs are ones where the content is believed to be present.
- - The Remote list can include other remotes that do not have the content;
- - only ones that match the UUIDs will be dropped from.
- - If allowed to drop fromhere, that drop will be tried first.
  -
  - In direct mode, all associated files are checked, and only if all
  - of them are unwanted are they dropped.
+ -
+ - The runner is used to run commands, and so can be either callCommand
+ - or commandAction.
  -}
-handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> Annex ()
-handleDropsFrom _ _ _ _ _ Nothing _ = noop
-handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
+handleDropsFrom :: [UUID] -> [Remote] -> Reason -> Bool -> Key -> AssociatedFile -> Maybe Remote -> CommandActionRunner -> Annex ()
+handleDropsFrom _ _ _ _ _ Nothing _ _ = noop
+handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote runner = do
 	fs <- ifM isDirect
 		( do
 			l <- associatedFilesRelative key
@@ -92,7 +88,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
 
 	checkdrop fs n@(have, numcopies, _untrusted) u a =
 		ifM (allM (wantDrop True u . Just) fs)
-			( ifM (safely $ callCommand $ a (Just numcopies))
+			( ifM (safely $ runner $ a (Just numcopies))
 				( do
 					liftIO $ debugM "drop" $ unwords
 						[ "dropped"
@@ -113,6 +109,7 @@ handleDropsFrom locs rs reason fromhere key (Just afile) knownpresentremote = do
 	dropr fs r n  = checkdrop fs n (Just $ Remote.uuid r) $ \numcopies ->
 		Command.Drop.startRemote (Just afile) numcopies key r
 
+	slocs = S.fromList locs
+	
 	safely a = either (const False) id <$> tryAnnex a
 
-	slocs = S.fromList locs
-- 
cgit v1.2.3