add PreferredContentExpression type
This commit is contained in:
		
					parent
					
						
							
								255637ffa2
							
						
					
				
			
			
				commit
				
					
						f0a6de1ca2
					
				
			
		
					 2 changed files with 8 additions and 6 deletions
				
			
		|  | @ -37,7 +37,7 @@ import Logs.Remote | |||
| import Types.StandardGroups | ||||
| 
 | ||||
| {- Changes the preferred content configuration of a remote. -} | ||||
| preferredContentSet :: UUID -> String -> Annex () | ||||
| preferredContentSet :: UUID -> PreferredContentExpression -> Annex () | ||||
| preferredContentSet uuid@(UUID _) val = do | ||||
| 	ts <- liftIO getPOSIXTime | ||||
| 	Annex.Branch.change preferredContentLog $ | ||||
|  | @ -71,7 +71,7 @@ preferredContentMapLoad = do | |||
| 	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m } | ||||
| 	return m | ||||
| 
 | ||||
| preferredContentMapRaw :: Annex (M.Map UUID String) | ||||
| preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression) | ||||
| preferredContentMapRaw = simpleMap . parseLog Just | ||||
| 	<$> Annex.Branch.get preferredContentLog | ||||
| 
 | ||||
|  | @ -79,7 +79,7 @@ preferredContentMapRaw = simpleMap . parseLog Just | |||
|  - because the configuration is shared among repositories and newer | ||||
|  - versions of git-annex may add new features. Instead, parse errors | ||||
|  - result in a Matcher that will always succeed. -} | ||||
| makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> String -> FileMatcher | ||||
| makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> UUID -> PreferredContentExpression -> FileMatcher | ||||
| makeMatcher groupmap configmap u expr | ||||
| 	| expr == "standard" = standardMatcher groupmap configmap u | ||||
| 	| null (lefts tokens) = Utility.Matcher.generate $ rights tokens | ||||
|  | @ -95,7 +95,7 @@ standardMatcher groupmap configmap u = | |||
| 		getStandardGroup =<< u `M.lookup` groupsByUUID groupmap | ||||
| 
 | ||||
| {- Checks if an expression can be parsed, if not returns Just error -} | ||||
| checkPreferredContentExpression :: String -> Maybe String | ||||
| checkPreferredContentExpression :: PreferredContentExpression -> Maybe String | ||||
| checkPreferredContentExpression expr | ||||
| 	| expr == "standard" = Nothing | ||||
| 	| otherwise = case parsedToMatcher tokens of | ||||
|  |  | |||
|  | @ -12,6 +12,8 @@ import Types.Remote (RemoteConfig) | |||
| import qualified Data.Map as M | ||||
| import Data.Maybe | ||||
| 
 | ||||
| type PreferredContentExpression = String | ||||
| 
 | ||||
| data StandardGroup | ||||
| 	= ClientGroup | ||||
| 	| TransferGroup | ||||
|  | @ -71,7 +73,7 @@ associatedDirectory Nothing PublicGroup = Just "public" | |||
| associatedDirectory _ _ = Nothing | ||||
| 
 | ||||
| {- See doc/preferred_content.mdwn for explanations of these expressions. -} | ||||
| preferredContent :: StandardGroup -> String | ||||
| preferredContent :: StandardGroup -> PreferredContentExpression | ||||
| preferredContent ClientGroup = lastResort $ | ||||
| 	"(exclude=*/archive/* and exclude=archive/*) or (" ++ notArchived ++ ")" | ||||
| preferredContent TransferGroup = lastResort $ | ||||
|  | @ -92,5 +94,5 @@ notArchived = "not (copies=archive:1 or copies=smallarchive:1)" | |||
|   	 | ||||
| {- Most repositories want any content that is only on untrusted | ||||
|  - or dead repositories. -} | ||||
| lastResort :: String -> String | ||||
| lastResort :: String -> PreferredContentExpression | ||||
| lastResort s = "(" ++ s ++ ") or (not copies=semitrusted+:1)" | ||||
|  |  | |||
		Loading…
	
	Add table
		Add a link
		
	
		Reference in a new issue
	
	 Joey Hess
				Joey Hess