{- git-annex command - - Copyright 2013-2015 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} module Command.Wanted where import Command import qualified Remote import Logs.PreferredContent 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 = noMessages $ command name SectionSetup desc pdesc (withParams seek) where pdesc = paramPair paramRemote (paramOptional paramExpression) seek = withWords (commandAction . start) start (rname:[]) = go rname (performGet getter) start (rname:expr:[]) = go rname $ \uuid -> do allowMessages showStart' name (Just rname) performSet setter expr uuid start _ = giveup "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 m <- getter liftIO $ putStrLn $ fromMaybe "" $ M.lookup a m next $ return True performSet :: (a -> PreferredContentExpression -> Annex ()) -> String -> a -> CommandPerform performSet setter expr a = case checkPreferredContentExpression expr of Just e -> giveup $ "Parse error: " ++ e Nothing -> do setter a expr next $ return True