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

Also refactored some code to reduce duplication.

8 files changed, 57 insertions, 41 deletions

diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index fde4e2d08..326dd3b2b 100644
--- a/CmdLine/GitAnnex.hs
+++ b/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
diff --git a/Command/GroupWanted.hs b/Command/GroupWanted.hs
index 859a39c1b..8fff47013 100644
--- a/Command/GroupWanted.hs
+++ b/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
diff --git a/Command/Wanted.hs b/Command/Wanted.hs
index 6b87e51d8..07f5ee7c3 100644
--- a/Command/Wanted.hs
+++ b/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
-	SectionSetup "get or set preferred content expression"]
-
-seek :: CommandSeek
-seek = withWords start
-
-start :: [String] -> CommandStart
-start = parse
+cmd = cmd' "wanted" "get or set preferred content expression" 
+	preferredContentMapRaw
+	preferredContentSet
+
+cmd'
+	:: String
+	-> String
+	-> Annex (M.Map UUID PreferredContentExpression)
+	-> (UUID -> PreferredContentExpression -> Annex ())
+	-> [Command]
+cmd' name desc getter setter = [command name pdesc seek SectionSetup desc]
   where
-	parse (name:[]) = go name performGet
-	parse (name:expr:[]) = go name $ \uuid -> do
-		showStart "wanted" name
-		performSet expr uuid
-	parse _ = error "Specify a repository."
-
-	go name a = do
-		u <- Remote.nameToUUID name
+	pdesc = paramPair paramRemote (paramOptional paramExpression)
+
+	seek = withWords start
+
+	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 uuid = do
+performGet :: Ord a => Annex (M.Map a PreferredContentExpression) -> a -> CommandPerform
+performGet getter a = do
 	Annex.setOutput QuietOutput
-	m <- preferredContentMapRaw
-	liftIO $ putStrLn $ fromMaybe "" $ M.lookup uuid m
+	m <- getter
+	liftIO $ putStrLn $ fromMaybe "" $ M.lookup a m
 	next $ return True
 
-performSet :: String -> UUID -> CommandPerform
-performSet expr uuid = case checkPreferredContentExpression expr of
+performSet :: Ord a => (a -> PreferredContentExpression -> Annex ()) -> String -> a -> CommandPerform
+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
diff --git a/debian/changelog b/debian/changelog
index 2acdfac96..53de77cc8 100644
--- a/debian/changelog
+++ b/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
 
diff --git a/doc/git-annex-preferred-content.mdwn b/doc/git-annex-preferred-content.mdwn
index 95dae8c14..49512f465 100644
--- a/doc/git-annex-preferred-content.mdwn
+++ b/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:
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 6fd10aed0..3dc54a308 100644
--- a/doc/git-annex.mdwn
+++ b/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.
diff --git a/doc/required_content.mdwn b/doc/required_content.mdwn
index 91c5614a8..e17951d9d 100644
--- a/doc/required_content.mdwn
+++ b/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.
 
diff --git a/doc/todo/command_line_interface_for_required_content_setthings.mdwn b/doc/todo/command_line_interface_for_required_content_setthings.mdwn
index 1334b151a..30889f8bb 100644
--- a/doc/todo/command_line_interface_for_required_content_setthings.mdwn
+++ b/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]]