wired preferred content up to get, copy, and drop --auto

8 files changed, 105 insertions, 10 deletions

diff --git a/Command.hs b/Command.hs
index ce45599c8..af38d01ed 100644
--- a/Command.hs
+++ b/Command.hs
@@ -21,7 +21,7 @@ module Command (
 	isBareRepo,
 	numCopies,
 	autoCopies,
-	autoCopiesWith,
+	autoCopiesDrop,
 	module ReExported
 ) where
 
@@ -38,6 +38,11 @@ import Usage as ReExported
 import Logs.Trust
 import Config
 import Annex.CheckAttr
+import Logs.PreferredContent
+import Git.FilePath
+import Annex.UUID
+
+import qualified Data.Set as S
 
 {- Generates a normal command -}
 command :: String -> String -> [CommandSeek] -> String -> Command
@@ -113,7 +118,8 @@ numCopies file = readish <$> checkAttr "annex.numcopies" file
  -
  - In auto mode, first checks that the number of known
  - copies of the key is > or < than the numcopies setting, before running
- - the action. -}
+ - the action. Also checks any preferred content settings.
+ -}
 autoCopies :: FilePath -> Key -> (Int -> Int -> Bool) -> CommandStart -> CommandStart
 autoCopies file key vs a = Annex.getState Annex.auto >>= go
 	where
@@ -122,10 +128,20 @@ autoCopies file key vs a = Annex.getState Annex.auto >>= go
 			numcopiesattr <- numCopies file
 			needed <- getNumCopies numcopiesattr
 			(_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
-			if length have `vs` needed then a else stop
-
-autoCopiesWith :: FilePath -> Key -> (Int -> Int -> Bool) -> (Maybe Int -> CommandStart) -> CommandStart
-autoCopiesWith file key vs a = do
+			if length have `vs` needed
+				then do
+					fp <- inRepo $ toTopFilePath file
+					ifM (isPreferredContent Nothing S.empty fp)
+						( a, stop )
+				else stop
+
+{- For dropping, supplies the number of known copies to the action.
+ - 
+ - In auto mode, checks the number of known copies.
+ - Also, checks if the repo would prefer to retain the content.
+ -}
+autoCopiesDrop :: FilePath -> Key -> (Int -> Int -> Bool) -> (Maybe Int -> CommandStart) -> CommandStart
+autoCopiesDrop file key vs a = do
 	numcopiesattr <- numCopies file
 	Annex.getState Annex.auto >>= auto numcopiesattr
 	where
@@ -133,4 +149,10 @@ autoCopiesWith file key vs a = do
 		auto numcopiesattr True = do
 			needed <- getNumCopies numcopiesattr
 			(_, have) <- trustPartition UnTrusted =<< Remote.keyLocations key
-			if length have `vs` needed then a numcopiesattr else stop
+			if length have `vs` needed
+				then do
+					fp <- inRepo $ toTopFilePath file
+					u <- getUUID
+					ifM (isPreferredContent (Just u) (S.singleton u) fp)
+						( stop, a numcopiesattr )
+				else stop
diff --git a/Command/Drop.hs b/Command/Drop.hs
index ddf44ab82..440526347 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -30,7 +30,7 @@ seek = [withField fromOption Remote.byName $ \from ->
 	withFilesInGit $ whenAnnexed $ start from]
 
 start :: Maybe Remote -> FilePath -> (Key, Backend) -> CommandStart
-start from file (key, _) = autoCopiesWith file key (>) $ \numcopies ->
+start from file (key, _) = autoCopiesDrop file key (>) $ \numcopies ->
 	case from of
 		Nothing -> startLocal file numcopies key
 		Just remote -> do
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index 77e4f2705..8d812ec4d 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -7,6 +7,7 @@
 
 module Logs.PreferredContent (
 	preferredContentSet,
+	isPreferredContent,
 	preferredContentMap,
 	preferredContentMapRaw,
 	checkPreferredContentExpression,
@@ -20,8 +21,10 @@ import Common.Annex
 import qualified Annex.Branch
 import qualified Annex
 import Logs.UUIDBased
-import Limit (MatchFiles, limitInclude, limitExclude, limitIn, limitCopies, limitInBackend)
+import Limit (MatchFiles, AssumeNotPresent, limitInclude, limitExclude, limitIn, limitCopies, limitInBackend)
 import qualified Utility.Matcher
+import Annex.UUID
+import Git.FilePath
 
 {- Filename of preferred-content.log. -}
 preferredContentLog :: FilePath
@@ -36,6 +39,18 @@ preferredContentSet uuid@(UUID _) val = do
 	Annex.changeState $ \s -> s { Annex.groupmap = Nothing }
 preferredContentSet NoUUID _ = error "unknown UUID; cannot modify"
 
+{- Checks if a file is preferred content for the specified repository
+ - (or the current repository if none is specified). -}
+isPreferredContent :: Maybe UUID -> AssumeNotPresent -> TopFilePath -> Annex Bool
+isPreferredContent mu notpresent file = do
+	u <- maybe getUUID return mu
+	m <- preferredContentMap
+	case M.lookup u m of
+		Nothing -> return True
+		Just matcher ->
+			Utility.Matcher.matchM2 matcher notpresent $
+				getTopFilePath file
+
 {- Read the preferredContentLog into a map. The map is cached for speed. -}
 preferredContentMap :: Annex Annex.PreferredContentMap
 preferredContentMap = do
diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs
index 83a2b1d61..6e88aa100 100644
--- a/Utility/Matcher.hs
+++ b/Utility/Matcher.hs
@@ -23,6 +23,7 @@ module Utility.Matcher (
 	generate,
 	match,
 	matchM,
+	matchM2,
 	matchesAny
 ) where
 
@@ -96,6 +97,15 @@ matchM m v = go m
 		go (MNot m1) = liftM not (go m1)
 		go (MOp o) = o v
 
+matchM2 :: Monad m => Matcher (v1 -> v2 -> m Bool) -> v1 -> v2 -> m Bool
+matchM2 m v1 v2 = go m
+	where
+		go MAny = return True
+		go (MAnd m1 m2) = go m1 <&&> go m2
+		go (MOr m1 m2) =  go m1 <||> go m2
+		go (MNot m1) = liftM not (go m1)
+		go (MOp o) = o v1 v2
+
 {- Checks is a matcher contains no limits, and so (presumably) matches
  - anything. Note that this only checks the trivial case; it is possible
  - to construct matchers that match anything but are more complicated. -}
diff --git a/debian/changelog b/debian/changelog
index f612238aa..a3442b1fb 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -8,6 +8,11 @@ git-annex (3.20121002) UNRELEASED; urgency=low
     as normal files.
   * vicfg: New command, allows editing (or simply viewing) most
     of the repository configuration settings stored in the git-annex branch.
+  * Added preferred content expressions, configurable using vicfg.
+  * get --auto, copy --auto: If the local repository has preferred content
+    configured, only get that content.
+  * drop --auto: If the local repository has preferred content configured,
+    drop content that is not preferred, if numcopies allows.
   * Only build-depend on libghc-clientsession-dev on arches that will have
     the webapp.
   * uninit: Unset annex.version. Closes: #689852
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index abda54f76..5c762593e 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -502,7 +502,8 @@ subdirectories).
 * --auto
 
   Enables automatic mode. Commands that get, drop, or move file contents
-  will only do so when needed to help satisfy the setting of annex.numcopies.
+  will only do so when needed to help satisfy the setting of annex.numcopies,
+  and preferred content configuration.
 
 * --quiet
 
diff --git a/doc/preferred_content.mdwn b/doc/preferred_content.mdwn
new file mode 100644
index 000000000..7c7d11267
--- /dev/null
+++ b/doc/preferred_content.mdwn
@@ -0,0 +1,37 @@
+git-annex tries to ensure that the configured number of [[copies]] of your
+data always exist, and leaves it up to you to use commands like `git annex
+get` and `git annex drop` to move the content to the repositories you want
+to contain it. But sometimes, it can be good to have more fine-grained
+control over which repositories prefer to have which content. Configuring
+this allows `git annex get --auto`, `git annex drop --auto`, etc to do
+smarter things.
+
+Currently, preferred content settings can only be edited using `git
+annex vicfg`. Each repository can have its own settings, and other
+repositories may also try to honor those settings. So there's no local
+`.git/config` setting it.
+
+The idea is that you write an expression that files are matched against.
+If a file matches, it's preferred to have its content stored in the
+repository. If it doesn't, it's preferred to drop its content from
+the repository (if there are enough copies elsewhere).
+
+The expressions are very similar to the file matching options documented
+on the [[git-annex]] man page. At the command line, you can use those
+options in commands like this:
+
+	git annex get --include='*.mp3' --and -'(' --not --in=archive -')'
+
+The equivilant preferred content expression looks like this:
+
+	include=*.mp3 and (not in=archive)
+
+So, just remove the dashes, basically.
+
+Note that while --include and --exclude match files relative to the current
+directory, preferred content expressions always match files relative to the
+top of the git repository. Perhaps you put files into `out/` directories
+when you're done with them. Then you could configure your laptop to prefer
+to not retain those files, like this:
+
+	exclude=*/out/*
diff --git a/doc/walkthrough/automatically_managing_content.mdwn b/doc/walkthrough/automatically_managing_content.mdwn
index ef883efef..0080ebcb5 100644
--- a/doc/walkthrough/automatically_managing_content.mdwn
+++ b/doc/walkthrough/automatically_managing_content.mdwn
@@ -38,3 +38,8 @@ work toward having two copies of your files.
 
 The --auto option can also be used with the copy command,
 again this lets git-annex decide whether to actually copy content.
+
+The above shows how to use --auto to manage content based on the number
+of copies. It's also possible to configure, on a per-repository basis,
+which content is desired. Then --auto also takes that into account
+see [[preferred_content]] for details.