1{- git-annex command
2 -
3 - Copyright 2013-2015 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Command.Wanted where
9
10import Command
11import qualified Remote
12import Logs.PreferredContent
13import Types.StandardGroups
14
15import qualified Data.Map as M
16
17cmd :: Command
18cmd = cmd' "wanted" "get or set preferred content expression"
19	preferredContentMapRaw
20	preferredContentSet
21
22cmd'
23	:: String
24	-> String
25	-> Annex (M.Map UUID PreferredContentExpression)
26	-> (UUID -> PreferredContentExpression -> Annex ())
27	-> Command
28cmd' name desc getter setter = noMessages $
29	command name SectionSetup desc pdesc (withParams seek)
30  where
31	pdesc = paramPair paramRemote (paramOptional paramExpression)
32
33	seek = withWords (commandAction . start)
34
35	start (rname:[]) = do
36		u <- Remote.nameToUUID rname
37		startingCustomOutput (ActionItemOther Nothing) $
38			performGet getter u
39	start ps@(rname:expr:[]) = do
40		u <- Remote.nameToUUID rname
41		let si = SeekInput ps
42		let ai = ActionItemOther (Just rname)
43		startingUsualMessages name ai si $
44			performSet setter expr u
45	start _ = giveup "Specify a repository."
46
47performGet :: Ord a => Annex (M.Map a PreferredContentExpression) -> a -> CommandPerform
48performGet getter a = do
49	m <- getter
50	liftIO $ putStrLn $ fromMaybe "" $ M.lookup a m
51	next $ return True
52
53performSet :: (a -> PreferredContentExpression -> Annex ()) -> String -> a -> CommandPerform
54performSet setter expr a = case checkPreferredContentExpression expr of
55	Just e -> giveup $ "Parse error: " ++ e
56	Nothing -> do
57		setter a expr
58		next $ return True
59