summaryrefslogtreecommitdiff
path: root/Command/Wanted.hs
blob: 649f19c2b0927af459f4c2373203c34da465e107 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
{- git-annex command
 -
 - Copyright 2013-2015 Joey Hess <id@joeyh.name>
 -
 - Licensed under the GNU GPL version 3 or higher.
 -}

module Command.Wanted where

import Common.Annex
import qualified Annex
import Command
import qualified Remote
import Logs.PreferredContent
import Types.Messages
import Types.StandardGroups

import qualified Data.Map as M

cmd :: Command
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 SectionSetup desc pdesc (withParams seek)
  where
	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 :: Ord a => Annex (M.Map a PreferredContentExpression) -> a -> CommandPerform
performGet getter a = do
	Annex.setOutput QuietOutput
	m <- getter
	liftIO $ putStrLn $ fromMaybe "" $ M.lookup a m
	next $ return True

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
		setter a expr
		next $ return True