honor preferred content when importing

Importing from a special remote honors its preferred content too; unwanted
files are not imported. But, some preferred content expressions can't be
checked before files are imported, and trying to import with such an
expression will fail.

Tested this with scenarios including changing the preferred content
expression and making sure merging the import didn't delete files that were
no longer wanted.

There was one minor inefficiency mentioned in the todo that I punted on.
This commit is contained in:
Joey Hess 2019-05-21 14:38:00 -04:00
parent ec11575d17
commit e06feb7316
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
9 changed files with 130 additions and 50 deletions

View file

@ -20,6 +20,7 @@ module Logs.PreferredContent (
setStandardGroup,
defaultStandardGroup,
preferredRequiredMapsLoad,
preferredRequiredMapsLoad',
prop_standardGroups_parse,
) where
@ -71,24 +72,37 @@ requiredContentMap = maybe (snd <$> preferredRequiredMapsLoad preferredContentTo
preferredRequiredMapsLoad :: (PreferredContentData -> [ParseToken (MatchFiles Annex)]) -> Annex (FileMatcherMap Annex, FileMatcherMap Annex)
preferredRequiredMapsLoad mktokens = do
(pc, rc) <- preferredRequiredMapsLoad' mktokens
let pc' = handleunknown pc
let rc' = handleunknown rc
Annex.changeState $ \s -> s
{ Annex.preferredcontentmap = Just pc'
, Annex.requiredcontentmap = Just rc'
}
return (pc', rc')
where
handleunknown = M.mapWithKey $ \u ->
fromRight (unknownMatcher u)
preferredRequiredMapsLoad' :: (PreferredContentData -> [ParseToken (MatchFiles Annex)]) -> Annex (M.Map UUID (Either String (FileMatcher Annex)), M.Map UUID (Either String (FileMatcher Annex)))
preferredRequiredMapsLoad' mktokens = do
groupmap <- groupMap
configmap <- readRemoteLog
let genmap l gm =
let mk u = fromRight (unknownMatcher u) .
makeMatcher groupmap configmap gm u mktokens
let mk u = makeMatcher groupmap configmap gm u mktokens
in simpleMap
. parseLogOldWithUUID (\u -> mk u . decodeBS <$> A.takeByteString)
<$> Annex.Branch.get l
pc <- genmap preferredContentLog =<< groupPreferredContentMapRaw
rc <- genmap requiredContentLog M.empty
-- Required content is implicitly also preferred content, so
-- combine.
let m = M.unionWith combineMatchers pc rc
Annex.changeState $ \s -> s
{ Annex.preferredcontentmap = Just m
, Annex.requiredcontentmap = Just rc
}
return (m, rc)
-- Required content is implicitly also preferred content, so combine.
let pc' = M.unionWith combiner pc rc
return (pc', rc)
where
combiner (Right a) (Right b) = Right (combineMatchers a b)
combiner (Left a) (Left b) = Left (a ++ " " ++ b)
combiner (Left a) (Right _) = Left a
combiner (Right _) (Left b) = Left b
{- This intentionally never fails, even on unparsable expressions,
- because the configuration is shared among repositories and newer