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

Also refactored some code to reduce duplication.

1 files changed, 32 insertions, 24 deletions

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