diff options
| -rw-r--r-- | Logs/PreferredContent.hs | 8 | ||||
| -rw-r--r-- | Types/StandardGroups.hs | 6 |
2 files changed, 8 insertions, 6 deletions
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index 202c86997..26eaaaece 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -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 diff --git a/Types/StandardGroups.hs b/Types/StandardGroups.hs index 2d977a357..51788ec4e 100644 --- a/Types/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -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)" |