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
Reference in a new issue