summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Logs/Group.hs10
-rw-r--r--Logs/PreferredContent.hs9
-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/*"