content: New command line way to view and configure a repository's preferred content settings.
This commit is contained in:
		
					parent
					
						
							
								e3c1586997
							
						
					
				
			
			
				commit
				
					
						b276857a7a
					
				
			
		
					 8 changed files with 70 additions and 8 deletions
				
			
		
							
								
								
									
										48
									
								
								Command/Content.hs
									
										
									
									
									
										Normal file
									
								
							
							
						
						
									
										48
									
								
								Command/Content.hs
									
										
									
									
									
										Normal 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
 | 
				
			||||||
| 
						 | 
					@ -17,7 +17,7 @@ import qualified Data.Set as S
 | 
				
			||||||
 | 
					
 | 
				
			||||||
def :: [Command]
 | 
					def :: [Command]
 | 
				
			||||||
def = [command "group" (paramPair paramRemote paramDesc) seek
 | 
					def = [command "group" (paramPair paramRemote paramDesc) seek
 | 
				
			||||||
	SectionCommon "add a repository to a group"]
 | 
						SectionSetup "add a repository to a group"]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
seek :: [CommandSeek]
 | 
					seek :: [CommandSeek]
 | 
				
			||||||
seek = [withWords start]
 | 
					seek = [withWords start]
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -117,8 +117,8 @@ genCfg cfg descs = unlines $ concat [intro, trust, groups, preferredcontent]
 | 
				
			||||||
		[ ""
 | 
							[ ""
 | 
				
			||||||
		, com "Repository preferred contents"
 | 
							, com "Repository preferred contents"
 | 
				
			||||||
		]
 | 
							]
 | 
				
			||||||
		(\(s, u) -> line "preferred-content" u s)
 | 
							(\(s, u) -> line "content" u s)
 | 
				
			||||||
		(\u -> line "preferred-content" u "")
 | 
							(\u -> line "content" u "")
 | 
				
			||||||
 | 
					
 | 
				
			||||||
	settings field desc showvals showdefaults = concat
 | 
						settings field desc showvals showdefaults = concat
 | 
				
			||||||
		[ desc
 | 
							[ desc
 | 
				
			||||||
| 
						 | 
					@ -167,7 +167,7 @@ parseCfg curcfg = go [] curcfg . lines
 | 
				
			||||||
		| setting == "group" =
 | 
							| setting == "group" =
 | 
				
			||||||
			let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)
 | 
								let m = M.insert u (S.fromList $ words value) (cfgGroupMap cfg)
 | 
				
			||||||
			in Right $ cfg { cfgGroupMap = m }
 | 
								in Right $ cfg { cfgGroupMap = m }
 | 
				
			||||||
		| setting == "preferred-content" = 
 | 
							| setting == "content" = 
 | 
				
			||||||
			case checkPreferredContentExpression value of
 | 
								case checkPreferredContentExpression value of
 | 
				
			||||||
				Just e -> Left e
 | 
									Just e -> Left e
 | 
				
			||||||
				Nothing ->
 | 
									Nothing ->
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -52,6 +52,7 @@ import qualified Command.Untrust
 | 
				
			||||||
import qualified Command.Semitrust
 | 
					import qualified Command.Semitrust
 | 
				
			||||||
import qualified Command.Dead
 | 
					import qualified Command.Dead
 | 
				
			||||||
import qualified Command.Group
 | 
					import qualified Command.Group
 | 
				
			||||||
 | 
					import qualified Command.Content
 | 
				
			||||||
import qualified Command.Ungroup
 | 
					import qualified Command.Ungroup
 | 
				
			||||||
import qualified Command.Vicfg
 | 
					import qualified Command.Vicfg
 | 
				
			||||||
import qualified Command.Sync
 | 
					import qualified Command.Sync
 | 
				
			||||||
| 
						 | 
					@ -105,6 +106,7 @@ cmds = concat
 | 
				
			||||||
	, Command.Semitrust.def
 | 
						, Command.Semitrust.def
 | 
				
			||||||
	, Command.Dead.def
 | 
						, Command.Dead.def
 | 
				
			||||||
	, Command.Group.def
 | 
						, Command.Group.def
 | 
				
			||||||
 | 
						, Command.Content.def
 | 
				
			||||||
	, Command.Ungroup.def
 | 
						, Command.Ungroup.def
 | 
				
			||||||
	, Command.Vicfg.def
 | 
						, Command.Vicfg.def
 | 
				
			||||||
	, Command.FromKey.def
 | 
						, Command.FromKey.def
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										2
									
								
								Usage.hs
									
										
									
									
									
								
							
							
						
						
									
										2
									
								
								Usage.hs
									
										
									
									
									
								
							| 
						 | 
					@ -93,6 +93,8 @@ paramFile :: String
 | 
				
			||||||
paramFile = "FILE"
 | 
					paramFile = "FILE"
 | 
				
			||||||
paramGroup :: String
 | 
					paramGroup :: String
 | 
				
			||||||
paramGroup = "GROUP"
 | 
					paramGroup = "GROUP"
 | 
				
			||||||
 | 
					paramExpression :: String
 | 
				
			||||||
 | 
					paramExpression = "EXPR"
 | 
				
			||||||
paramSize :: String
 | 
					paramSize :: String
 | 
				
			||||||
paramSize = "SIZE"
 | 
					paramSize = "SIZE"
 | 
				
			||||||
paramAddress :: String
 | 
					paramAddress :: String
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
							
								
								
									
										2
									
								
								debian/changelog
									
										
									
									
										vendored
									
									
								
							
							
						
						
									
										2
									
								
								debian/changelog
									
										
									
									
										vendored
									
									
								
							| 
						 | 
					@ -15,6 +15,8 @@ git-annex (4.20130522) UNRELEASED; urgency=low
 | 
				
			||||||
    are staged.
 | 
					    are staged.
 | 
				
			||||||
  * Improve error handling when getting uuid of http remotes to auto-ignore,
 | 
					  * Improve error handling when getting uuid of http remotes to auto-ignore,
 | 
				
			||||||
    like with ssh remotes.
 | 
					    like with ssh remotes.
 | 
				
			||||||
 | 
					  * content: New command line way to view and configure a repository's
 | 
				
			||||||
 | 
					    preferred content settings.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 -- Joey Hess <joeyh@debian.org>  Tue, 21 May 2013 18:22:46 -0400
 | 
					 -- Joey Hess <joeyh@debian.org>  Tue, 21 May 2013 18:22:46 -0400
 | 
				
			||||||
 | 
					
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -306,6 +306,14 @@ subdirectories).
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  Removes a repository from a group.
 | 
					  Removes a repository from a group.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					* content repository [expression]
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  When run with an expression, configures the content that is preferred
 | 
				
			||||||
 | 
					  to be held in the archive. See PREFERRED CONTENT below.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
 | 
					  Without an expression, displays the current preferred content setting
 | 
				
			||||||
 | 
					  of the repository.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
* vicfg
 | 
					* vicfg
 | 
				
			||||||
 | 
					
 | 
				
			||||||
  Opens EDITOR on a temp file containing most of the above configuration
 | 
					  Opens EDITOR on a temp file containing most of the above configuration
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
| 
						 | 
					@ -6,10 +6,10 @@ control over which repositories prefer to have which content. Configuring
 | 
				
			||||||
this allows `git annex get --auto`, `git annex drop --auto`, etc to do
 | 
					this allows `git annex get --auto`, `git annex drop --auto`, etc to do
 | 
				
			||||||
smarter things.
 | 
					smarter things.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
Currently, preferred content settings can only be edited using `git
 | 
					Preferred content settings can be edited using `git
 | 
				
			||||||
annex vicfg`. Each repository can have its own settings, and other
 | 
					annex vicfg`, or viewed and set at the command line with `git annex content`.
 | 
				
			||||||
repositories may also try to honor those settings. So there's no local
 | 
					Each repository can have its own settings, and other repositories may also
 | 
				
			||||||
`.git/config` setting it.
 | 
					try to honor those settings. So there's no local `.git/config` setting it.
 | 
				
			||||||
 | 
					
 | 
				
			||||||
The idea is that you write an expression that files are matched against.
 | 
					The idea is that you write an expression that files are matched against.
 | 
				
			||||||
If a file matches, it's preferred to have its content stored in the
 | 
					If a file matches, it's preferred to have its content stored in the
 | 
				
			||||||
| 
						 | 
					
 | 
				
			||||||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue