required: New command, like wanted, but for required content.

Also refactored some code to reduce duplication.

CmdLine/GitAnnex.hs

@@ -74,6 +74,7 @@ import qualified Command.Dead
 import qualified Command.Group
 import qualified Command.Wanted
 import qualified Command.GroupWanted
+import qualified Command.Required
 import qualified Command.Schedule
 import qualified Command.Ungroup
 import qualified Command.Vicfg
@@ -149,6 +150,7 @@ cmds = concat
 	, Command.Group.cmd
 	, Command.Wanted.cmd
 	, Command.GroupWanted.cmd
+	, Command.Required.cmd
 	, Command.Schedule.cmd
 	, Command.Ungroup.cmd
 	, Command.Vicfg.cmd

Command/GroupWanted.hs

@@ -13,6 +13,7 @@ import Command
 import Logs.PreferredContent
 import Types.Messages
 import Types.Group
+import Command.Wanted (performGet, performSet)
 
 import qualified Data.Map as M
 
@@ -24,22 +25,8 @@ seek :: CommandSeek
 seek = withWords start
 
 start :: [String] -> CommandStart
-start (g:[]) = next $ performGet g
+start (g:[]) = next $ performGet groupPreferredContentMapRaw g
 start (g:expr:[]) = do
 	showStart "groupwanted" g
-	next $ performSet g expr
+	next $ performSet groupPreferredContentSet expr g
 start _ = error "Specify a group."
-
-performGet :: Group -> CommandPerform
-performGet g = do
-	Annex.setOutput QuietOutput
-	m <- groupPreferredContentMapRaw
-	liftIO $ putStrLn $ fromMaybe "" $ M.lookup g m
-	next $ return True
-
-performSet :: Group -> String -> CommandPerform
-performSet g expr = case checkPreferredContentExpression expr of
-	Just e -> error $ "Parse error: " ++ e
-	Nothing -> do
-		groupPreferredContentSet g expr
-		next $ return True

Command/Wanted.hs

@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2013 Joey Hess <id@joeyh.name>
+ - Copyright 2013-2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -13,39 +13,47 @@ import Command
 import qualified Remote
 import Logs.PreferredContent
 import Types.Messages
+import Types.StandardGroups
 
 import qualified Data.Map as M
 
 cmd :: [Command]
-cmd = [command "wanted" (paramPair paramRemote (paramOptional paramExpression)) seek
+cmd = cmd' "wanted" "get or set preferred content expression" 
-	SectionSetup "get or set preferred content expression"]
+	preferredContentMapRaw
+	preferredContentSet
 
-seek :: CommandSeek
+cmd'
-seek = withWords start
+	:: String
-
+	-> String
-start :: [String] -> CommandStart
+	-> Annex (M.Map UUID PreferredContentExpression)
-start = parse
+	-> (UUID -> PreferredContentExpression -> Annex ())
+	-> [Command]
+cmd' name desc getter setter = [command name pdesc seek SectionSetup desc]
   where
-	parse (name:[]) = go name performGet
+	pdesc = paramPair paramRemote (paramOptional paramExpression)
-	parse (name:expr:[]) = go name $ \uuid -> do
-		showStart "wanted" name
-		performSet expr uuid
-	parse _ = error "Specify a repository."
 
-	go name a = do
+	seek = withWords start
-		u <- Remote.nameToUUID name
+
+	start (rname:[]) = go rname (performGet getter)
+	start (rname:expr:[]) = go rname $ \uuid -> do
+		showStart name rname
+		performSet setter expr uuid
+	start _ = error "Specify a repository."
+		
+	go rname a = do
+		u <- Remote.nameToUUID rname
 		next $ a u
 
-performGet :: UUID -> CommandPerform
+performGet :: Ord a => Annex (M.Map a PreferredContentExpression) -> a -> CommandPerform
-performGet uuid = do
+performGet getter a = do
 	Annex.setOutput QuietOutput
-	m <- preferredContentMapRaw
+	m <- getter
-	liftIO $ putStrLn $ fromMaybe "" $ M.lookup uuid m
+	liftIO $ putStrLn $ fromMaybe "" $ M.lookup a m
 	next $ return True
 
-performSet :: String -> UUID -> CommandPerform
+performSet :: Ord a => (a -> PreferredContentExpression -> Annex ()) -> String -> a -> CommandPerform
-performSet expr uuid = case checkPreferredContentExpression expr of
+performSet setter expr a = case checkPreferredContentExpression expr of
 	Just e -> error $ "Parse error: " ++ e
 	Nothing -> do
-		preferredContentSet uuid expr
+		setter a expr
 		next $ return True

debian/changelog

@@ -22,6 +22,7 @@ git-annex (5.20150410) UNRELEASED; urgency=medium
     the bad content in .git/annex/bad/ to avoid further data loss.
   * fsck --from remote: Avoid downloading a key if it would go over
     the annex.diskreserve limit.
+  * required: New command, like wanted, but for required content.
 
  -- Joey Hess <id@joeyh.name>  Thu, 09 Apr 2015 20:59:43 -0400
 

doc/git-annex-preferred-content.mdwn

@@ -10,6 +10,13 @@ using `git annex vicfg` or `git annex wanted`.
 They are used by the `--auto` option, by `git annex sync --content`,
 and by the git-annex assistant.
 
+While preferred content expresses a preference, it can be overridden
+by simply using `git annex drop`. On the other hand, required content
+settings are enforced; `git annex drop` will refuse to drop a file if
+doing so would violate its required content settings. A repository's
+required content can be configured using `git annex vicfg` or
+`git annex required`.
+
 Preferred content expressions are similar, but not identical to
 the [[git-annex-matching-options]](1), just without the dashes.
 For example:

doc/git-annex.mdwn

@@ -264,8 +264,16 @@ subdirectories).
 
 * `groupwanted groupname [expression]`
 
+  Get or set groupwanted expression.
+
   See [[git-annex-groupwanted]](1) for details.
 
+* `required repository [expression]`
+  
+  Get or set required content expression.
+  
+  See [[git-annex-required]](1) for details.
+
 * `schedule repository [expression]`
 
   Get or set scheduled jobs.

doc/required_content.mdwn

@@ -6,7 +6,8 @@ archival repositories, and also require that one copy be stored offsite.
 The format of required content expressions is the same as
 [[preferred_content]] expressions.
 
-Required content settings can be edited using `git annex vicfg`.
+Required content settings can be edited using `git annex vicfg`
+or set using `git annex required`.
 Each repository can have its own settings, and other repositories will
 try to honor those settings when interacting with it.
 

doc/todo/command_line_interface_for_required_content_setthings.mdwn

@@ -9,3 +9,5 @@ used feature, and vicfg can already configure it.
 one when it comes to that. Oh well.)
 
 --[[Joey]]
+
+> [[done]] --[[Joey]]