split

Assistant/Drop.hs

@@ -0,0 +1,60 @@
+{- git-annex assistant dropping of unwanted content
+ -
+ - Copyright 2012 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Assistant.Drop where
+
+import Assistant.Common
+import Logs.Location
+import Logs.Trust
+import qualified Remote
+import qualified Command.Drop
+import Command
+import Annex.Wanted
+import Config
+
+{- Drop from local or remote when allowed by the preferred content and
+ - numcopies settings. -}
+handleDrops :: [Remote] -> Bool -> FilePath -> Key -> Annex ()
+handleDrops rs present f key = do
+	locs <- loggedLocations key
+	handleDrops' locs rs present f key
+
+handleDrops' :: [UUID] -> [Remote] -> Bool -> FilePath -> Key -> Annex ()
+handleDrops' locs rs present f key
+	| present = do
+		n <- getcopies
+		if checkcopies n
+			then go rs =<< dropl n
+			else go rs n
+	| otherwise = go rs =<< getcopies
+	where
+		getcopies = do
+			have <- length . snd <$> trustPartition UnTrusted locs
+			numcopies <- getNumCopies =<< numCopies f
+			return (have, numcopies)
+		checkcopies (have, numcopies) = have > numcopies
+		decrcopies (have, numcopies) = (have - 1, numcopies)
+
+		go [] _ = noop
+		go (r:rest) n
+			| checkcopies n = dropr r n >>= go rest
+			| otherwise = noop
+
+		checkdrop n@(_, numcopies) u a = 
+			ifM (wantDrop u (Just f))
+				( ifM (doCommand $ a (Just numcopies))
+					( return $ decrcopies n
+					, return n
+					)
+				, return n
+				)
+
+		dropl n = checkdrop n Nothing $ \numcopies ->
+			Command.Drop.startLocal f numcopies key
+
+		dropr r n  = checkdrop n (Just $ Remote.uuid r) $ \numcopies ->
+			Command.Drop.startRemote f numcopies key r

Assistant/Threads/TransferScanner.hs

@@ -13,19 +13,17 @@ import Assistant.TransferQueue
 import Assistant.ThreadedMonad
 import Assistant.DaemonStatus
 import Assistant.Alert
+import Assistant.Drop
 import Logs.Transfer
 import Logs.Location
-import Logs.Trust
 import Logs.Web (webUUID)
 import qualified Remote
 import qualified Types.Remote as Remote
 import Utility.ThreadScheduler
 import qualified Git.LsFiles as LsFiles
-import qualified Command.Drop
 import Command
 import Annex.Content
 import Annex.Wanted
-import Config
 
 import qualified Data.Set as S
 
@@ -127,7 +125,7 @@ expensiveScan st dstatus transferqueue rs = unless onlyweb $ do
 			syncrs <- liftIO $ syncRemotes <$> getDaemonStatus dstatus
 			present <- inAnnex key
 
-			handleDrops locs syncrs present f key
+			handleDrops' locs syncrs present f key
 
 			let slocs = S.fromList locs
 			let use a = return $ catMaybes $ map (a key slocs) syncrs
@@ -144,44 +142,6 @@ genTransfer direction want key slocs r
 		(r, Transfer direction (Remote.uuid r) key)
 	| otherwise = Nothing
 
-{- Drop from local or remote when allowed by the preferred content and
- - numcopies settings. -}
-handleDrops :: [UUID] -> [Remote] -> Bool -> FilePath -> Key -> Annex ()
-handleDrops locs rs present f key
-	| present = do
-		n <- getcopies
-		if checkcopies n
-			then go rs =<< dropl n
-			else go rs n
-	| otherwise = go rs =<< getcopies
-	where
-		getcopies = do
-			have <- length . snd <$> trustPartition UnTrusted locs
-			numcopies <- getNumCopies =<< numCopies f
-			return (have, numcopies)
-		checkcopies (have, numcopies) = have > numcopies
-		decrcopies (have, numcopies) = (have - 1, numcopies)
-
-		go [] _ = noop
-		go (r:rest) n
-			| checkcopies n = dropr r n >>= go rest
-			| otherwise = noop
-
-		checkdrop n@(_, numcopies) u a = 
-			ifM (wantDrop u (Just f))
-				( ifM (doCommand $ a (Just numcopies))
-					( return $ decrcopies n
-					, return n
-					)
-				, return n
-				)
-
-		dropl n = checkdrop n Nothing $ \numcopies ->
-			Command.Drop.startLocal f numcopies key
-
-		dropr r n  = checkdrop n (Just $ Remote.uuid r) $ \numcopies ->
-			Command.Drop.startRemote f numcopies key r
-
 remoteHas :: Remote -> Key -> Annex Bool
 remoteHas r key = elem
 	<$> pure (Remote.uuid r)

doc/design/assistant/transfer_control.mdwn

@@ -32,7 +32,7 @@ the same content, this gets tricky. Let's assume there are not.)
    with this is an expensive scan. (The rest of the items below come from
    analizing the terminals used in preferred content expressions.) **done**
 2. renaming of a file (ie, moved to `archive/`)
-3. some other repository gets the file (`in`, `copies`)
+3. we get a file (`in`, `copies`)
 4. some other repository drops the file (`in`, `copies` .. However, it's
    unlikely that an expression would prefer content when *more* copies
    exisited, and want to drop it when less do. That's nearly a pathological