mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

almost finished with applySimCommand

Browse source 
Added checks that repo names are ones that have been added to the sim.

Implemented preferred content etc setting. It does not need to parse the
expression in applySimCommand, instead that can be done when running the
sim. This keeps it pure.

But, it can't be entirely pure because of CommandAddTree. So made it
return an Annex action when necessary.

Moved makeMatcher into Annex.FileMatcher in preparation for using it,
but it's not used yet. Also moved checkPreferredContentExpression.
This commit is contained in:
Joey Hess 2024-09-05 15:22:41 -04:00
parent 710a199ce9
commit 8f8e35ac3b
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
3 changed files with 157 additions and 125 deletions
Download patch file Download diff file Expand all files Collapse all files

75
Logs/PreferredContent.hs
View file

@ -1,6 +1,6 @@
{- git-annex preferred content matcher configuration
-
- Copyright 2012-2023 Joey Hess <id@joeyh.name>
- Copyright 2012-2024 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
@ -25,11 +25,6 @@ module Logs.PreferredContent (
prop_standardGroups_parse,
) where
import qualified Data.Map as M
import qualified Data.Set as S
import Data.Either
import qualified Data.Attoparsec.ByteString.Lazy as A
import Annex.Common
import Logs.PreferredContent.Raw
import qualified Annex.Branch
@ -39,13 +34,15 @@ import Logs.UUIDBased
import Utility.Matcher
import Annex.FileMatcher
import Annex.UUID
import Types.Group
import Types.Remote (RemoteConfig)
import Logs.Group
import Logs.Remote
import Types.StandardGroups
import Limit
import qualified Data.Map as M
import qualified Data.Set as S
import qualified Data.Attoparsec.ByteString.Lazy as A
{- Checks if a file is preferred content (or required content) for the
- specified repository (or the current repository if none is specified). -}
isPreferredContent :: LiveUpdate -> Maybe UUID -> AssumeNotPresent -> Maybe Key -> AssociatedFile -> Bool -> Annex Bool
@ -99,7 +96,8 @@ preferredRequiredMapsLoad' matcherf mktokens = do
groupmap <- groupMap
configmap <- remoteConfigMap
let genmap l gm =
let mk u = makeMatcher groupmap configmap gm u matcherf mktokens
let mk u = makeMatcher groupmap configmap
gm u matcherf mktokens (Right (unknownMatcher u))
in simpleMap
. parseLogOldWithUUID (\u -> mk u . decodeBS <$> A.takeByteString)
<$> Annex.Branch.get l
@ -115,46 +113,11 @@ preferredRequiredMapsLoad' matcherf mktokens = do
combiner (Left a) (Right _) = Left a
combiner (Right _) (Left b) = Left b
{- This intentionally never fails, even on unparsable expressions,
{- Parsing preferred content expressions intentionally never fails,
- because the configuration is shared among repositories and newer
- versions of git-annex may add new features. -}
makeMatcher
:: GroupMap
-> M.Map UUID RemoteConfig
-> M.Map Group PreferredContentExpression
-> UUID
-> (Matcher (MatchFiles Annex) -> Matcher (MatchFiles Annex))
-> (PreferredContentData -> [ParseToken (MatchFiles Annex)])
-> PreferredContentExpression
-> Either String (Matcher (MatchFiles Annex))
makeMatcher groupmap configmap groupwantedmap u matcherf mktokens = go True True
where
go expandstandard expandgroupwanted expr
| null (lefts tokens) = Right $ matcherf $ generate $ rights tokens
| otherwise = Left $ unwords $ lefts tokens
where
tokens = preferredContentParser (mktokens pcd) expr
pcd = PCD
{ matchStandard = matchstandard
, matchGroupWanted = matchgroupwanted
, getGroupMap = pure groupmap
, configMap = configmap
, repoUUID = Just u
}
matchstandard
| expandstandard = maybe (Right $ unknownMatcher u) (go False False)
(standardPreferredContent <$> getStandardGroup mygroups)
| otherwise = Right $ unknownMatcher u
matchgroupwanted
| expandgroupwanted = maybe (Right $ unknownMatcher u) (go True False)
(groupwanted mygroups)
| otherwise = Right $ unknownMatcher u
mygroups = fromMaybe S.empty (u `M.lookup` groupsByUUID groupmap)
groupwanted s = case M.elems $ M.filterWithKey (\k _ -> S.member k s) groupwantedmap of
[pc] -> Just pc
_ -> Nothing
{- When a preferred content expression cannot be parsed, but is already
- versions of git-annex may add new features.
-
- When a preferred content expression cannot be parsed, but is already
- in the log (eg, put there by a newer version of git-annex),
- the fallback behavior is to match only files that are currently present.
-
@ -165,22 +128,6 @@ unknownMatcher u = generate [present]
where
present = Operation $ limitPresent (Just u)
{- Checks if an expression can be parsed, if not returns Just error -}
checkPreferredContentExpression :: PreferredContentExpression -> Maybe String
checkPreferredContentExpression expr =
case parsedToMatcher (MatcherDesc mempty) tokens of
Left e -> Just e
Right _ -> Nothing
where
tokens = preferredContentParser (preferredContentTokens pcd) expr
pcd = PCD
{ matchStandard = Right matchAll
, matchGroupWanted = Right matchAll
, getGroupMap = pure emptyGroupMap
, configMap = M.empty
, repoUUID = Nothing
}
{- Puts a UUID in a standard group, and sets its preferred content to use
- the standard expression for that group (unless preferred content is
- already set). -}