From 5f8d17ef558ee82e4cf9e75b8d750e90d35731ee Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Mon, 8 Oct 2012 17:14:01 -0400
Subject: generalized Annex.Wanted

this should make it easy to use from inside the assistant, where
everything is an AssociatedFile.
---
 Annex/Wanted.hs | 46 ++++++++++++++++++----------------------------
 Command.hs      |  5 +++++
 Command/Copy.hs |  4 ++--
 Command/Drop.hs |  2 +-
 Command/Get.hs  |  2 +-
 5 files changed, 27 insertions(+), 32 deletions(-)

diff --git a/Annex/Wanted.hs b/Annex/Wanted.hs
index 2775c22cb..8310fdd8f 100644
--- a/Annex/Wanted.hs
+++ b/Annex/Wanted.hs
@@ -8,43 +8,33 @@
 module Annex.Wanted where
 
 import Common.Annex
-import qualified Remote
-import Annex.Content
 import Logs.PreferredContent
 import Git.FilePath
 import qualified Annex
 import Annex.UUID
+import Types.Remote
 
 import qualified Data.Set as S
 
-checkAuto :: (Bool -> Annex Bool) -> Annex Bool
-checkAuto a = Annex.getState Annex.auto >>= a
-
-{- A file's content should be gotten if it's not already present.
- - In auto mode, only get files that are preferred content. -}
-shouldGet :: FilePath -> Key -> Bool -> Annex Bool
-shouldGet file key auto = (not <$> inAnnex key) <&&> want
-	where
-		want
-			| auto = do
-				fp <- inRepo $ toTopFilePath file
-				isPreferredContent Nothing S.empty fp
-			| otherwise = return True
+{- Check if a file is preferred content for the local repository. -}
+wantGet :: AssociatedFile -> Annex Bool
+wantGet Nothing = return True
+wantGet (Just file) = do
+	fp <- inRepo $ toTopFilePath file
+	isPreferredContent Nothing S.empty fp
 
-{- A file's content should be sent to a remote.
- - In auto mode, only send files that are preferred content of the remote. -}
-shouldSend :: Remote -> FilePath -> Bool -> Annex Bool
-shouldSend _ _ False = return True
-shouldSend to file True = do
+{- Check if a file is preferred content for a remote. -}
+wantSend :: UUID -> AssociatedFile -> Annex Bool
+wantSend _ Nothing = return True
+wantSend to (Just file) = do
 	fp <- inRepo $ toTopFilePath file
-	isPreferredContent (Just $ Remote.uuid to) S.empty fp
+	isPreferredContent (Just to) S.empty fp
 
-{- A file's content should be dropped normally.
- - (This does not check numcopies though.)
- - In auto mode, hold on to preferred content. -}
-shouldDrop :: Maybe Remote -> FilePath -> Bool -> Annex Bool
-shouldDrop _ _ False = return True
-shouldDrop from file True = do
+{- Check if a file can be dropped, maybe from a remote.
+ - Don't drop files that are preferred content. -}
+wantDrop :: Maybe UUID -> AssociatedFile -> Annex Bool
+wantDrop _ Nothing = return True
+wantDrop from (Just file) = do
 	fp <- inRepo $ toTopFilePath file
-	u <- maybe getUUID (return . Remote.uuid) from
+	u <- maybe getUUID (return . id) from
 	not <$> isPreferredContent (Just u) (S.singleton u) fp
diff --git a/Command.hs b/Command.hs
index f2b95aa4c..8e7bf9758 100644
--- a/Command.hs
+++ b/Command.hs
@@ -22,6 +22,7 @@ module Command (
 	numCopies,
 	autoCopies,
 	autoCopiesWith,
+	checkAuto,
 	module ReExported
 ) where
 
@@ -137,3 +138,7 @@ autoCopiesWith file key vs a = do
 			if length have `vs` needed
 				then a numcopiesattr
 				else stop
+
+checkAuto :: Annex Bool -> Annex Bool
+checkAuto checker = ifM (Annex.getState Annex.auto)
+	( checker , return True )
diff --git a/Command/Copy.hs b/Command/Copy.hs
index c8a2d7efc..f044facf4 100644
--- a/Command/Copy.hs
+++ b/Command/Copy.hs
@@ -31,5 +31,5 @@ start to from file (key, backend) = autoCopies file key (<) $
 		Command.Move.start to from False file (key, backend)
 	where
 		shouldCopy = case to of
-			Nothing -> checkAuto $ shouldGet file key
-			Just r -> checkAuto $ shouldSend r file
+			Nothing -> checkAuto $ wantGet (Just file)
+			Just r -> checkAuto $ wantSend (Remote.uuid r) (Just file)
diff --git a/Command/Drop.hs b/Command/Drop.hs
index 3fe5ab20a..26e80f8e5 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -32,7 +32,7 @@ seek = [withField fromOption Remote.byName $ \from ->
 
 start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
 start from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
-	stopUnless (checkAuto $ shouldDrop from file) $
+	stopUnless (checkAuto $ wantDrop (Remote.uuid <$> from) (Just file)) $
 		case from of
 			Nothing -> startLocal file numcopies key
 			Just remote -> do
diff --git a/Command/Get.hs b/Command/Get.hs
index 10b74bfc7..c95e4eb94 100644
--- a/Command/Get.hs
+++ b/Command/Get.hs
@@ -24,7 +24,7 @@ seek = [withField Command.Move.fromOption Remote.byName $ \from ->
 	withFilesInGit $ whenAnnexed $ start from]
 
 start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start from file (key, _) = stopUnless (checkAuto $ shouldGet file key) $
+start from file (key, _) = stopUnless ((not <$> inAnnex key) <&&> checkAuto (wantGet $ Just file)) $
 	autoCopies file key (<) $
 		case from of
 			Nothing -> go $ perform key file
-- 
cgit v1.2.3