diff options
Diffstat (limited to 'Logs/PreferredContent.hs')
| -rw-r--r-- | Logs/PreferredContent.hs | 47 |
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 |