diff options
-rw-r--r-- | CmdLine/GitAnnex.hs | 2 | ||||
-rw-r--r-- | Command/GroupWanted.hs | 19 | ||||
-rw-r--r-- | Command/Wanted.hs | 56 | ||||
-rw-r--r-- | debian/changelog | 1 | ||||
-rw-r--r-- | doc/git-annex-preferred-content.mdwn | 7 | ||||
-rw-r--r-- | doc/git-annex.mdwn | 8 | ||||
-rw-r--r-- | doc/required_content.mdwn | 3 | ||||
-rw-r--r-- | doc/todo/command_line_interface_for_required_content_setthings.mdwn | 2 |
8 files changed, 57 insertions, 41 deletions
diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs index fde4e2d08..326dd3b2b 100644 --- a/CmdLine/GitAnnex.hs +++ b/CmdLine/GitAnnex.hs @@ -74,6 +74,7 @@ import qualified Command.Dead import qualified Command.Group import qualified Command.Wanted import qualified Command.GroupWanted +import qualified Command.Required import qualified Command.Schedule import qualified Command.Ungroup import qualified Command.Vicfg @@ -149,6 +150,7 @@ cmds = concat , Command.Group.cmd , Command.Wanted.cmd , Command.GroupWanted.cmd + , Command.Required.cmd , Command.Schedule.cmd , Command.Ungroup.cmd , Command.Vicfg.cmd diff --git a/Command/GroupWanted.hs b/Command/GroupWanted.hs index 859a39c1b..8fff47013 100644 --- a/Command/GroupWanted.hs +++ b/Command/GroupWanted.hs @@ -13,6 +13,7 @@ import Command import Logs.PreferredContent import Types.Messages import Types.Group +import Command.Wanted (performGet, performSet) import qualified Data.Map as M @@ -24,22 +25,8 @@ seek :: CommandSeek seek = withWords start start :: [String] -> CommandStart -start (g:[]) = next $ performGet g +start (g:[]) = next $ performGet groupPreferredContentMapRaw g start (g:expr:[]) = do showStart "groupwanted" g - next $ performSet g expr + next $ performSet groupPreferredContentSet expr g start _ = error "Specify a group." - -performGet :: Group -> CommandPerform -performGet g = do - Annex.setOutput QuietOutput - m <- groupPreferredContentMapRaw - liftIO $ putStrLn $ fromMaybe "" $ M.lookup g m - next $ return True - -performSet :: Group -> String -> CommandPerform -performSet g expr = case checkPreferredContentExpression expr of - Just e -> error $ "Parse error: " ++ e - Nothing -> do - groupPreferredContentSet g expr - next $ return True 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 diff --git a/debian/changelog b/debian/changelog index 2acdfac96..53de77cc8 100644 --- a/debian/changelog +++ b/debian/changelog @@ -22,6 +22,7 @@ git-annex (5.20150410) UNRELEASED; urgency=medium the bad content in .git/annex/bad/ to avoid further data loss. * fsck --from remote: Avoid downloading a key if it would go over the annex.diskreserve limit. + * required: New command, like wanted, but for required content. -- Joey Hess <id@joeyh.name> Thu, 09 Apr 2015 20:59:43 -0400 diff --git a/doc/git-annex-preferred-content.mdwn b/doc/git-annex-preferred-content.mdwn index 95dae8c14..49512f465 100644 --- a/doc/git-annex-preferred-content.mdwn +++ b/doc/git-annex-preferred-content.mdwn @@ -10,6 +10,13 @@ using `git annex vicfg` or `git annex wanted`. They are used by the `--auto` option, by `git annex sync --content`, and by the git-annex assistant. +While preferred content expresses a preference, it can be overridden +by simply using `git annex drop`. On the other hand, required content +settings are enforced; `git annex drop` will refuse to drop a file if +doing so would violate its required content settings. A repository's +required content can be configured using `git annex vicfg` or +`git annex required`. + Preferred content expressions are similar, but not identical to the [[git-annex-matching-options]](1), just without the dashes. For example: diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn index 6fd10aed0..3dc54a308 100644 --- a/doc/git-annex.mdwn +++ b/doc/git-annex.mdwn @@ -264,8 +264,16 @@ subdirectories). * `groupwanted groupname [expression]` + Get or set groupwanted expression. + See [[git-annex-groupwanted]](1) for details. +* `required repository [expression]` + + Get or set required content expression. + + See [[git-annex-required]](1) for details. + * `schedule repository [expression]` Get or set scheduled jobs. diff --git a/doc/required_content.mdwn b/doc/required_content.mdwn index 91c5614a8..e17951d9d 100644 --- a/doc/required_content.mdwn +++ b/doc/required_content.mdwn @@ -6,7 +6,8 @@ archival repositories, and also require that one copy be stored offsite. The format of required content expressions is the same as [[preferred_content]] expressions. -Required content settings can be edited using `git annex vicfg`. +Required content settings can be edited using `git annex vicfg` +or set using `git annex required`. Each repository can have its own settings, and other repositories will try to honor those settings when interacting with it. diff --git a/doc/todo/command_line_interface_for_required_content_setthings.mdwn b/doc/todo/command_line_interface_for_required_content_setthings.mdwn index 1334b151a..30889f8bb 100644 --- a/doc/todo/command_line_interface_for_required_content_setthings.mdwn +++ b/doc/todo/command_line_interface_for_required_content_setthings.mdwn @@ -9,3 +9,5 @@ used feature, and vicfg can already configure it. one when it comes to that. Oh well.) --[[Joey]] + +> [[done]] --[[Joey]] |