content: New command line way to view and configure a repository's preferred content settings.

This commit is contained in:
Joey Hess 2013-05-25 12:44:58 -04:00
parent e3c1586997
commit b276857a7a
8 changed files with 70 additions and 8 deletions

48
Command/Content.hs Normal file
View file

@ -0,0 +1,48 @@
{- git-annex command
-
- Copyright 2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Command.Content where
import Common.Annex
import Command
import qualified Remote
import Logs.PreferredContent
import qualified Data.Map as M
def :: [Command]
def = [command "content" (paramPair paramRemote (paramOptional paramExpression)) seek
SectionSetup "get or set preferred content expression"]
seek :: [CommandSeek]
seek = [withWords start]
start :: [String] -> CommandStart
start = parse
where
parse (name:[]) = go name performGet
parse (name:expr:[]) = go name $ \uuid -> do
showStart "content" name
performSet expr uuid
parse _ = error "Specify a repository."
go name a = do
u <- Remote.nameToUUID name
next $ a u
performGet :: UUID -> CommandPerform
performGet uuid = do
m <- preferredContentMapRaw
liftIO $ putStrLn $ fromMaybe "" $ M.lookup uuid m
next $ return True
performSet :: String -> UUID -> CommandPerform
performSet expr uuid = case checkPreferredContentExpression expr of
Just e -> error $ "Parse error: " ++ e
Nothing -> do
preferredContentSet uuid expr
next $ return True

View file

@ -17,7 +17,7 @@ import qualified Data.Set as S
def :: [Command]
def = [command "group" (paramPair paramRemote paramDesc) seek
SectionCommon "add a repository to a group"]
SectionSetup "add a repository to a group"]
seek :: [CommandSeek]
seek = [withWords start]

View file

@ -117,8 +117,8 @@ genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent]
[ ""
, com "Repository preferred contents"
]
(\(s, u) -> line "preferred-content" u s)
(\u -> line "preferred-content" u "")
(\(s, u) -> line "content" u s)
(\u -> line "content" u "")
settings field desc showvals showdefaults = concat
[ desc
@ -167,7 +167,7 @@ parseCfg curcfg = go [] curcfg . lines
| setting == "group" =
let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)
in Right $ cfg { cfgGroupMap = m }
| setting == "preferred-content" =
| setting == "content" =
case checkPreferredContentExpression value of
Just e -> Left e
Nothing ->