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