importtree: support preferred content expressions needing keys

When importing from a special remote, support preferred content expressions
that use terms that match on keys (eg "present", "copies=1"). Such terms
are ignored when importing, since the key is not known yet.

When "standard" or "groupwanted" is used, the terms in those
expressions also get pruned accordingly.

This does allow setting preferred content to "not (copies=1)" to make a
special remote into a "source" type of repository. Importing from it will
import all files. Then exporting to it will drop all files from it.

In the case of setting preferred content to "present", it's pruned on
import, so everything gets imported from it. Then on export, it's applied,
and everything in it is left on it, and no new content is exported to it.

Since the old behavior on these preferred content expressions was for
importtree to error out, there's no backwards compatability to worry about.
Except that sync/pull/etc will now import where before it errored out.
This commit is contained in:
Joey Hess 2023-12-18 16:27:26 -04:00
parent 0e161a7404
commit 9a67ed0f10
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
8 changed files with 94 additions and 54 deletions

View file

@ -24,6 +24,7 @@ module Utility.Matcher (
MatchResult(..),
syntaxToken,
generate,
pruneMatcher,
match,
match',
matchM,
@ -99,6 +100,28 @@ generate = simplify . process MAny . implicitAnd . tokenGroups
simplify (MNot x) = MNot (simplify x)
simplify x = x
{- Prunes selected ops from the Matcher. -}
pruneMatcher :: (op -> Bool) -> Matcher op -> Matcher op
pruneMatcher f = fst . go
where
go MAny = (MAny, False)
go (MAnd a b) = case (go a, go b) of
((_, True), (_, True)) -> (MAny, True)
((a', False), (b', False)) -> (MAnd a' b', False)
((_, True), (b', False)) -> (b', False)
((a', False), (_, True)) -> (a', False)
go (MOr a b) = case (go a, go b) of
((_, True), (_, True)) -> (MAny, True)
((a', False), (b', False)) -> (MOr a' b', False)
((_, True), (b', False)) -> (b', False)
((a', False), (_, True)) -> (a', False)
go (MNot a) = case go a of
(_, True) -> (MAny, True)
(a', False) -> (MNot a', False)
go (MOp op)
| f op = (MAny, True)
| otherwise = (MOp op, False)
data TokenGroup op = One (Token op) | Group [TokenGroup op]
deriving (Show, Eq)