standard preferred content settings for client, transfer, backup, and archive repositories

I've designed these to work well together, I hope. If I get it wrong,
I can just change the code in one place, since these expressions
won't be stored in the git-annex branch.

Logs/PreferredContent.hs

@@ -14,8 +14,10 @@ module Logs.PreferredContent (
 ) where
 
 import qualified Data.Map as M
+import qualified Data.Set as S
 import Data.Either
 import Data.Time.Clock.POSIX
+import Data.Monoid
 
 import Common.Annex
 import qualified Annex.Branch
@@ -61,7 +63,8 @@ preferredContentMap = do
 	case cached of
 		Just m -> return m
 		Nothing -> do
-			m <- simpleMap . parseLog (Just . makeMatcher groupmap)
+			m <- simpleMap
+				. parseLogWithUUID ((Just .) . makeMatcher groupmap)
 				<$> Annex.Branch.get preferredContentLog
 			Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
 			return m
@@ -74,17 +77,39 @@ preferredContentMapRaw = simpleMap . parseLog Just
  - because the configuration is shared amoung repositories and newer
  - versions of git-annex may add new features. Instead, parse errors
  - result in a Matcher that will always succeed. -}
-makeMatcher :: GroupMap -> String -> Utility.Matcher.Matcher MatchFiles
-makeMatcher groupmap s
+makeMatcher :: GroupMap -> UUID -> String -> Utility.Matcher.Matcher MatchFiles
+makeMatcher groupmap u s
+	| s == "standard" = standardMatcher groupmap u
 	| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
- 	| otherwise = Utility.Matcher.generate []
+ 	| otherwise = matchAll
 	where
 		tokens = map (parseToken groupmap) (tokenizeMatcher s)
 
+matchAll :: Utility.Matcher.Matcher MatchFiles
+matchAll = Utility.Matcher.generate []
+
+{- Standard matchers are pre-defined for some groups. If none is defined,
+ - or a repository is in multiple groups with standard matchers, match all. -}
+standardMatcher :: GroupMap -> UUID -> Utility.Matcher.Matcher MatchFiles
+standardMatcher groupmap u =
+	maybe matchAll findmatcher $ u `M.lookup` groupsByUUID groupmap
+	where
+		findmatcher s = case catMaybes $ map standard $ S.toList s of
+			[m] -> makeMatcher groupmap u m
+			_ -> matchAll
+ 		{- See doc/preferred_content.mdwn for explanations
+		 - of these expressions. -}
+		standard "client" = Just "exclude=*/archive/*"
+		standard "transfer" = Just "not inallgroup=client and " <> standard "client"
+		standard "archive" = Just "not copies=archive:1"
+		-- backup preferrs all content
+		standard _ = Nothing
+
 {- Checks if an expression can be parsed, if not returns Just error -}
 checkPreferredContentExpression :: String -> Maybe String
-checkPreferredContentExpression s = 
-	case lefts $ map (parseToken emptyGroupMap) (tokenizeMatcher s) of
+checkPreferredContentExpression s
+	| s == "standard" = Nothing
+	| otherwise = case lefts $ map (parseToken emptyGroupMap) (tokenizeMatcher s) of
 		[] -> Nothing
 		l -> Just $ unwords $ map ("Parse failure: " ++) l
 

Logs/UUIDBased.hs

@@ -17,6 +17,7 @@ module Logs.UUIDBased (
 	LogEntry(..),
 	TimeStamp(..),
 	parseLog,
+	parseLogWithUUID,
 	showLog,
 	changeLog,
 	addLog,
@@ -56,15 +57,18 @@ showLog shower = unlines . map showpair . M.toList
 			unwords [fromUUID k, shower v]
 
 parseLog :: (String -> Maybe a) -> String -> Log a
-parseLog parser = M.fromListWith best . mapMaybe parse . lines
+parseLog = parseLogWithUUID . const
+
+parseLogWithUUID :: (UUID -> String -> Maybe a) -> String -> Log a
+parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines
 	where
 		parse line
 			| null ws = Nothing
-			| otherwise = parser (unwords info) >>= makepair
+			| otherwise = parser u (unwords info) >>= makepair
 			where
-				makepair v = Just (toUUID u, LogEntry ts v)
+				makepair v = Just (u, LogEntry ts v)
 				ws = words line
-				u = Prelude.head ws
+				u = toUUID $ Prelude.head ws
 				t = Prelude.last ws
 				ts
 					| tskey `isPrefixOf` t =

doc/preferred_content.mdwn

@@ -28,10 +28,52 @@ The equivilant preferred content expression looks like this:
 
 So, just remove the dashes, basically.
 
+## file matching
+
 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
+top of the git repository. Perhaps you put files into `archive` directories
 when you're done with them. Then you could configure your laptop to prefer
 to not retain those files, like this:
 
-	exclude=*/out/*
+	exclude=*/archive/*
+
+## standard expressions
+
+git-annex comes with some standard preferred content expressions, that can
+be used with repositories that are in some pre-defined groups. To make a
+repository use one of these, just set its preferred content expression
+to "standard", and put it in one of these groups:
+
+### client
+
+All content is preferred, unless it's in a "archive" directory.
+
+`exclude=*/archive/*`
+
+### transfer
+
+Use for repositories that are used to transfer data between other
+repositories, but do not need to retain data themselves. For
+example, a repository on a server, or in the cloud, or a small
+USB drive used in a sneakernet.
+
+The preferred content expression for these causes them to get and retain
+data until all clients have a copy.
+
+`not inallgroup=client and exclude=*/archive/*`
+
+### archive
+
+All content is preferred, unless it's already been archived somewhere else.
+
+`not copies=archive:1`
+
+Note that if you want to archive multiple copies (not a bad idea!),
+you should instead configure all your archive repositories with a
+version of the above preferred content expression with a larger
+number of copies.
+
+### backup
+
+All content is preferred.