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