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:
parent
ec11575d17
commit
e06feb7316
9 changed files with 130 additions and 50 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue