diff options
| -rw-r--r-- | Logs/Group.hs | 10 | ||||
| -rw-r--r-- | Logs/PreferredContent.hs | 9 | ||||
| -rw-r--r-- | Types/StandardGroups.hs (renamed from Annex/StandardGroups.hs) | 9 |
3 files changed, 21 insertions, 7 deletions
diff --git a/Logs/Group.hs b/Logs/Group.hs index 09d431e63..a58eafe92 100644 --- a/Logs/Group.hs +++ b/Logs/Group.hs @@ -10,6 +10,7 @@ module Logs.Group ( groupSet, lookupGroups, groupMap, + getStandardGroup ) where import qualified Data.Map as M @@ -21,6 +22,7 @@ import qualified Annex.Branch import qualified Annex import Logs.UUIDBased import Types.Group +import Types.StandardGroups {- Filename of group.log. -} groupLog :: FilePath @@ -64,3 +66,11 @@ makeGroupMap byuuid = GroupMap byuuid bygroup bygroup = M.fromListWith S.union $ concat $ map explode $ M.toList byuuid explode (u, s) = map (\g -> (g, S.singleton u)) (S.toList s) + +{- If a repository is in exactly one standard group, returns it. -} +getStandardGroup :: UUID -> GroupMap -> Maybe StandardGroup +getStandardGroup u m = maybe Nothing go $ u `M.lookup` groupsByUUID m + where + go s = case catMaybes $ map toStandardGroup $ S.toList s of + [g] -> Just g + _ -> Nothing diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs index ed6dbb43e..840c36155 100644 --- a/Logs/PreferredContent.hs +++ b/Logs/PreferredContent.hs @@ -29,7 +29,7 @@ import Annex.UUID import Git.FilePath import Types.Group import Logs.Group -import Annex.StandardGroups +import Types.StandardGroups {- Filename of preferred-content.log. -} preferredContentLog :: FilePath @@ -89,12 +89,9 @@ makeMatcher groupmap u s {- Standard matchers are pre-defined for some groups. If none is defined, - or a repository is in multiple groups with standard matchers, match all. -} standardMatcher :: GroupMap -> UUID -> Utility.Matcher.Matcher MatchFiles -standardMatcher groupmap u = - maybe matchAll findmatcher $ u `M.lookup` groupsByUUID groupmap +standardMatcher m u = maybe matchAll use (getStandardGroup u m) where - findmatcher s = case catMaybes $ map toStandardGroup $ S.toList s of - [g] -> makeMatcher groupmap u $ preferredContent g - _ -> matchAll + use = makeMatcher m u . preferredContent matchAll :: Utility.Matcher.Matcher MatchFiles matchAll = Utility.Matcher.generate [] diff --git a/Annex/StandardGroups.hs b/Types/StandardGroups.hs index 7c47cc628..151fc3304 100644 --- a/Annex/StandardGroups.hs +++ b/Types/StandardGroups.hs @@ -5,9 +5,10 @@ - Licensed under the GNU GPL version 3 or higher. -} -module Annex.StandardGroups where +module Types.StandardGroups where data StandardGroup = ClientGroup | TransferGroup | ArchiveGroup | BackupGroup + deriving (Eq, Ord, Enum, Bounded, Show) fromStandardGroup :: StandardGroup -> String fromStandardGroup ClientGroup = "client" @@ -22,6 +23,12 @@ toStandardGroup "archive" = Just ArchiveGroup toStandardGroup "backup" = Just BackupGroup toStandardGroup _ = Nothing +descStandardGroup :: StandardGroup -> String +descStandardGroup ClientGroup = "client: a repository on your computer" +descStandardGroup TransferGroup = "transfer: distributes data to clients" +descStandardGroup ArchiveGroup = "archive: collect content that is not archived elsewhere" +descStandardGroup BackupGroup = "backup: collects all content" + {- See doc/preferred_content.mdwn for explanations of these expressions. -} preferredContent :: StandardGroup -> String preferredContent ClientGroup = "exclude=*/archive/*" |