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.

2 files changed, 49 insertions, 19 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
diff --git a/Logs/PreferredContent/Raw.hs b/Logs/PreferredContent/Raw.hs
index ce91c2dcd..bbf5a1edc 100644
--- a/Logs/PreferredContent/Raw.hs
+++ b/Logs/PreferredContent/Raw.hs
@@ -21,14 +21,23 @@ import Types.Group
 
 {- Changes the preferred content configuration of a remote. -}
 preferredContentSet :: UUID -> PreferredContentExpression -> Annex ()
-preferredContentSet uuid@(UUID _) val = do
+preferredContentSet = setLog preferredContentLog
+
+requiredContentSet :: UUID -> PreferredContentExpression -> Annex ()
+requiredContentSet = setLog requiredContentLog
+
+setLog :: FilePath -> UUID -> PreferredContentExpression -> Annex ()
+setLog logfile uuid@(UUID _) val = do
 	ts <- liftIO getPOSIXTime
-	Annex.Branch.change preferredContentLog $
+	Annex.Branch.change logfile $
 		showLog id
 		. changeLog ts uuid val
 		. parseLog Just
-	Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
-preferredContentSet NoUUID _ = error "unknown UUID; cannot modify"
+	Annex.changeState $ \s -> s 
+		{ Annex.preferredcontentmap = Nothing
+		, Annex.requiredcontentmap = Nothing
+		}
+setLog _ NoUUID _ = error "unknown UUID; cannot modify"
 
 {- Changes the preferred content configuration of a group. -}
 groupPreferredContentSet :: Group -> PreferredContentExpression -> Annex ()
@@ -44,6 +53,10 @@ preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
 preferredContentMapRaw = simpleMap . parseLog Just
 	<$> Annex.Branch.get preferredContentLog
 
+requiredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
+requiredContentMapRaw = simpleMap . parseLog Just
+	<$> Annex.Branch.get requiredContentLog
+
 groupPreferredContentMapRaw :: Annex (M.Map Group PreferredContentExpression)
 groupPreferredContentMapRaw = simpleMap . parseMapLog Just Just
 	<$> Annex.Branch.get groupPreferredContentLog