Added required content configuration.

This includes checking when dropping files that any required content
configuration is satisfied. However, it does not yet include an active
check on the required content; the location log is trusted when checking
the required content expression.

1 files changed, 32 insertions, 15 deletions

diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index 480ac2e6d..ead303f1f 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -6,16 +6,19 @@
  -}
 
 module Logs.PreferredContent (
-	preferredContentLog,
 	preferredContentSet,
+	requiredContentSet,
 	groupPreferredContentSet,
 	isPreferredContent,
+	isRequiredContent,
 	preferredContentMap,
-	preferredContentMapLoad,
 	preferredContentMapRaw,
+	requiredContentMap,
+	requiredContentMapRaw,
 	groupPreferredContentMapRaw,
 	checkPreferredContentExpression,
 	setStandardGroup,
+	preferredRequiredMapsLoad,
 ) where
 
 import qualified Data.Map as M
@@ -42,29 +45,43 @@ import Limit
 {- Checks if a file is preferred content for the specified repository
  - (or the current repository if none is specified). -}
 isPreferredContent :: Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool
-isPreferredContent mu notpresent mkey afile def = do
+isPreferredContent = checkMap preferredContentMap
+
+isRequiredContent :: Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool
+isRequiredContent = checkMap requiredContentMap
+
+checkMap :: Annex (FileMatcherMap Annex) -> Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool
+checkMap getmap mu notpresent mkey afile def = do
 	u <- maybe getUUID return mu
-	m <- preferredContentMap
+	m <- getmap
 	case M.lookup u m of
 		Nothing -> return def
 		Just matcher -> checkMatcher matcher mkey afile notpresent def
 
-{- The map is cached for speed. -}
 preferredContentMap :: Annex (FileMatcherMap Annex)
-preferredContentMap = maybe preferredContentMapLoad return
+preferredContentMap = maybe (fst <$> preferredRequiredMapsLoad) return
 	=<< Annex.getState Annex.preferredcontentmap
 
-{- Loads the map, updating the cache. -}
-preferredContentMapLoad :: Annex (FileMatcherMap Annex)
-preferredContentMapLoad = do
+requiredContentMap :: Annex (FileMatcherMap Annex)
+requiredContentMap = maybe (snd <$> preferredRequiredMapsLoad) return
+	=<< Annex.getState Annex.requiredcontentmap
+
+preferredRequiredMapsLoad :: Annex (FileMatcherMap Annex, FileMatcherMap Annex)
+preferredRequiredMapsLoad = do
 	groupmap <- groupMap
 	configmap <- readRemoteLog
-	groupwantedmap <- groupPreferredContentMapRaw
-	m <- simpleMap
-		. parseLogWithUUID ((Just .) . makeMatcher groupmap configmap groupwantedmap)
-		<$> Annex.Branch.get preferredContentLog
-	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Just m }
-	return m
+	let genmap l gm = simpleMap
+		. parseLogWithUUID ((Just .) . makeMatcher groupmap configmap gm)
+		<$> Annex.Branch.get l
+	pc <- genmap preferredContentLog =<< groupPreferredContentMapRaw
+	rc <- genmap requiredContentLog M.empty
+	-- Required content is implicitly also preferred content, so OR
+	let m = M.unionWith MOr pc rc
+	Annex.changeState $ \s -> s
+		{ Annex.preferredcontentmap = Just m
+		, Annex.requiredcontentmap = Just rc
+		}
+	return (m, rc)
 
 {- This intentionally never fails, even on unparsable expressions,
  - because the configuration is shared among repositories and newer