split

2 files changed, 62 insertions, 42 deletions

diff --git a/Assistant/Drop.hs b/Assistant/Drop.hs
new file mode 100644
index 000000000..b3dca3929
--- /dev/null
+++ b/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
diff --git a/Assistant/Threads/TransferScanner.hs b/Assistant/Threads/TransferScanner.hs
index 6606bdc35..5eb3784bd 100644
--- a/Assistant/Threads/TransferScanner.hs
+++ b/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)