aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Annex.hs13
-rw-r--r--Annex/FileMatcher.hs17
-rw-r--r--Assistant/Threads/Watcher.hs7
-rw-r--r--Limit.hs46
-rw-r--r--Logs.hs4
-rw-r--r--Logs/PreferredContent.hs18
-rw-r--r--Types/FileMatcher.hs21
-rw-r--r--Types/Limit.hs20
8 files changed, 72 insertions, 74 deletions
diff --git a/Annex.hs b/Annex.hs
index 78329b5df..f00276e2f 100644
--- a/Annex.hs
+++ b/Annex.hs
@@ -10,7 +10,6 @@
module Annex (
Annex,
AnnexState(..),
- PreferredContentMap,
new,
run,
eval,
@@ -62,7 +61,6 @@ import Types.LockPool
import Types.MetaData
import Types.DesktopNotify
import Types.CleanupActions
-import qualified Utility.Matcher
import qualified Data.Map as M
import qualified Data.Set as S
import Utility.Quvi (QuviVersion)
@@ -81,9 +79,6 @@ newtype Annex a = Annex { runAnnex :: ReaderT (MVar AnnexState) IO a }
Applicative
)
-type Matcher a = Either [Utility.Matcher.Token a] (Utility.Matcher.Matcher a)
-type PreferredContentMap = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> MatchInfo -> Annex Bool))
-
-- internal state storage
data AnnexState = AnnexState
{ repo :: Git.Repo
@@ -104,9 +99,10 @@ data AnnexState = AnnexState
, forcebackend :: Maybe String
, globalnumcopies :: Maybe NumCopies
, forcenumcopies :: Maybe NumCopies
- , limit :: Matcher (MatchInfo -> Annex Bool)
+ , limit :: ExpandableMatcher Annex
, uuidmap :: Maybe UUIDMap
- , preferredcontentmap :: Maybe PreferredContentMap
+ , preferredcontentmap :: Maybe (FileMatcherMap Annex)
+ , requiredcontentmap :: Maybe (FileMatcherMap Annex)
, shared :: Maybe SharedRepository
, forcetrust :: TrustMap
, trustmap :: Maybe TrustMap
@@ -146,9 +142,10 @@ newState c r = AnnexState
, forcebackend = Nothing
, globalnumcopies = Nothing
, forcenumcopies = Nothing
- , limit = Left []
+ , limit = BuildingMatcher []
, uuidmap = Nothing
, preferredcontentmap = Nothing
+ , requiredcontentmap = Nothing
, shared = Nothing
, forcetrust = M.empty
, trustmap = Nothing
diff --git a/Annex/FileMatcher.hs b/Annex/FileMatcher.hs
index ae1bbb77b..da6a5e0e9 100644
--- a/Annex/FileMatcher.hs
+++ b/Annex/FileMatcher.hs
@@ -13,7 +13,6 @@ import Common.Annex
import Limit
import Utility.Matcher
import Types.Group
-import Types.Limit
import Logs.Group
import Logs.Remote
import Annex.UUID
@@ -25,12 +24,10 @@ import Types.Remote (RemoteConfig)
import Data.Either
import qualified Data.Set as S
-type FileMatcher = Matcher MatchFiles
-
-checkFileMatcher :: FileMatcher -> FilePath -> Annex Bool
+checkFileMatcher :: (FileMatcher Annex) -> FilePath -> Annex Bool
checkFileMatcher matcher file = checkMatcher matcher Nothing (Just file) S.empty True
-checkMatcher :: FileMatcher -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool
+checkMatcher :: (FileMatcher Annex) -> Maybe Key -> AssociatedFile -> AssumeNotPresent -> Bool -> Annex Bool
checkMatcher matcher mkey afile notpresent def
| isEmpty matcher = return def
| otherwise = case (mkey, afile) of
@@ -48,15 +45,15 @@ fileMatchInfo file = do
, relFile = file
}
-matchAll :: FileMatcher
+matchAll :: FileMatcher Annex
matchAll = generate []
-parsedToMatcher :: [Either String (Token MatchFiles)] -> Either String FileMatcher
+parsedToMatcher :: [Either String (Token (MatchFiles Annex))] -> Either String (FileMatcher Annex)
parsedToMatcher parsed = case partitionEithers parsed of
([], vs) -> Right $ generate vs
(es, _) -> Left $ unwords $ map ("Parse failure: " ++) es
-exprParser :: FileMatcher -> FileMatcher -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token MatchFiles)]
+exprParser :: FileMatcher Annex -> FileMatcher Annex -> GroupMap -> M.Map UUID RemoteConfig -> Maybe UUID -> String -> [Either String (Token (MatchFiles Annex))]
exprParser matchstandard matchgroupwanted groupmap configmap mu expr =
map parse $ tokenizeMatcher expr
where
@@ -69,7 +66,7 @@ exprParser matchstandard matchgroupwanted groupmap configmap mu expr =
preferreddir = fromMaybe "public" $
M.lookup "preferreddir" =<< (`M.lookup` configmap) =<< mu
-parseToken :: FileMatcher -> FileMatcher -> MkLimit -> MkLimit -> GroupMap -> String -> Either String (Token MatchFiles)
+parseToken :: FileMatcher Annex -> FileMatcher Annex -> MkLimit Annex -> MkLimit Annex -> GroupMap -> String -> Either String (Token (MatchFiles Annex))
parseToken matchstandard matchgroupwanted checkpresent checkpreferreddir groupmap t
| t `elem` tokens = Right $ token t
| t == "standard" = call matchstandard
@@ -106,7 +103,7 @@ tokenizeMatcher = filter (not . null ) . concatMap splitparens . words
{- Generates a matcher for files large enough (or meeting other criteria)
- to be added to the annex, rather than directly to git. -}
-largeFilesMatcher :: Annex FileMatcher
+largeFilesMatcher :: Annex (FileMatcher Annex)
largeFilesMatcher = go =<< annexLargeFiles <$> Annex.getGitConfig
where
go Nothing = return matchAll
diff --git a/Assistant/Threads/Watcher.hs b/Assistant/Threads/Watcher.hs
index 8a8e8faf0..97ccf083e 100644
--- a/Assistant/Threads/Watcher.hs
+++ b/Assistant/Threads/Watcher.hs
@@ -35,6 +35,7 @@ import Annex.CatFile
import Annex.CheckIgnore
import Annex.Link
import Annex.FileMatcher
+import Types.FileMatcher
import Annex.ReplaceFile
import Git.Types
import Config
@@ -196,7 +197,7 @@ runHandler handler file filestatus = void $ do
| otherwise = f
{- Small files are added to git as-is, while large ones go into the annex. -}
-add :: FileMatcher -> FilePath -> Assistant (Maybe Change)
+add :: FileMatcher Annex -> FilePath -> Assistant (Maybe Change)
add bigfilematcher file = ifM (liftAnnex $ checkFileMatcher bigfilematcher file)
( pendingAddChange file
, do
@@ -205,7 +206,7 @@ add bigfilematcher file = ifM (liftAnnex $ checkFileMatcher bigfilematcher file)
madeChange file AddFileChange
)
-onAdd :: FileMatcher -> Handler
+onAdd :: FileMatcher Annex -> Handler
onAdd matcher file filestatus
| maybe False isRegularFile filestatus =
unlessIgnored file $
@@ -218,7 +219,7 @@ shouldRestage ds = scanComplete ds || forceRestage ds
{- In direct mode, add events are received for both new files, and
- modified existing files.
-}
-onAddDirect :: Bool -> FileMatcher -> Handler
+onAddDirect :: Bool -> FileMatcher Annex -> Handler
onAddDirect symlinkssupported matcher file fs = do
v <- liftAnnex $ catKeyFile file
case (v, fs) of
diff --git a/Limit.hs b/Limit.hs
index 7654842e1..b46ff1a06 100644
--- a/Limit.hs
+++ b/Limit.hs
@@ -20,7 +20,6 @@ import Types.TrustLevel
import Types.Key
import Types.Group
import Types.FileMatcher
-import Types.Limit
import Types.MetaData
import Logs.MetaData
import Logs.Group
@@ -45,21 +44,20 @@ getMatcher :: Annex (MatchInfo -> Annex Bool)
getMatcher = Utility.Matcher.matchM <$> getMatcher'
getMatcher' :: Annex (Utility.Matcher.Matcher (MatchInfo -> Annex Bool))
-getMatcher' = do
- m <- Annex.getState Annex.limit
- case m of
- Right r -> return r
- Left l -> do
- let matcher = Utility.Matcher.generate (reverse l)
- Annex.changeState $ \s ->
- s { Annex.limit = Right matcher }
- return matcher
+getMatcher' = go =<< Annex.getState Annex.limit
+ where
+ go (CompleteMatcher matcher) = return matcher
+ go (BuildingMatcher l) = do
+ let matcher = Utility.Matcher.generate (reverse l)
+ Annex.changeState $ \s ->
+ s { Annex.limit = CompleteMatcher matcher }
+ return matcher
{- Adds something to the limit list, which is built up reversed. -}
add :: Utility.Matcher.Token (MatchInfo -> Annex Bool) -> Annex ()
add l = Annex.changeState $ \s -> s { Annex.limit = prepend $ Annex.limit s }
where
- prepend (Left ls) = Left $ l:ls
+ prepend (BuildingMatcher ls) = BuildingMatcher $ l:ls
prepend _ = error "internal"
{- Adds a new token. -}
@@ -67,21 +65,21 @@ addToken :: String -> Annex ()
addToken = add . Utility.Matcher.token
{- Adds a new limit. -}
-addLimit :: Either String MatchFiles -> Annex ()
+addLimit :: Either String (MatchFiles Annex) -> Annex ()
addLimit = either error (\l -> add $ Utility.Matcher.Operation $ l S.empty)
{- Add a limit to skip files that do not match the glob. -}
addInclude :: String -> Annex ()
addInclude = addLimit . limitInclude
-limitInclude :: MkLimit
+limitInclude :: MkLimit Annex
limitInclude glob = Right $ const $ return . matchGlobFile glob
{- Add a limit to skip files that match the glob. -}
addExclude :: String -> Annex ()
addExclude = addLimit . limitExclude
-limitExclude :: MkLimit
+limitExclude :: MkLimit Annex
limitExclude glob = Right $ const $ return . not . matchGlobFile glob
matchGlobFile :: String -> (MatchInfo -> Bool)
@@ -119,10 +117,10 @@ addIn s = addLimit =<< mk
else inAnnex key
{- Limit to content that is currently present on a uuid. -}
-limitPresent :: Maybe UUID -> MkLimit
+limitPresent :: Maybe UUID -> MkLimit Annex
limitPresent u _ = Right $ matchPresent u
-matchPresent :: Maybe UUID -> MatchFiles
+matchPresent :: Maybe UUID -> MatchFiles Annex
matchPresent u _ = checkKey $ \key -> do
hereu <- getUUID
if u == Just hereu || isNothing u
@@ -132,7 +130,7 @@ matchPresent u _ = checkKey $ \key -> do
return $ maybe False (`elem` us) u
{- Limit to content that is in a directory, anywhere in the repository tree -}
-limitInDir :: FilePath -> MkLimit
+limitInDir :: FilePath -> MkLimit Annex
limitInDir dir = const $ Right $ const go
where
go (MatchingFile fi) = return $ elem dir $ splitPath $ takeDirectory $ matchFile fi
@@ -143,7 +141,7 @@ limitInDir dir = const $ Right $ const go
addCopies :: String -> Annex ()
addCopies = addLimit . limitCopies
-limitCopies :: MkLimit
+limitCopies :: MkLimit Annex
limitCopies want = case split ":" want of
[v, n] -> case parsetrustspec v of
Just checker -> go n $ checktrust checker
@@ -169,7 +167,7 @@ limitCopies want = case split ":" want of
addLackingCopies :: Bool -> String -> Annex ()
addLackingCopies approx = addLimit . limitLackingCopies approx
-limitLackingCopies :: Bool -> MkLimit
+limitLackingCopies :: Bool -> MkLimit Annex
limitLackingCopies approx want = case readish want of
Just needed -> Right $ \notpresent mi -> flip checkKey mi $
handle mi needed notpresent
@@ -191,7 +189,7 @@ limitLackingCopies approx want = case readish want of
- This has a nice optimisation: When a file exists,
- its key is obviously not unused.
-}
-limitUnused :: MatchFiles
+limitUnused :: MatchFiles Annex
limitUnused _ (MatchingFile _) = return False
limitUnused _ (MatchingKey k) = S.member k <$> unusedKeys
@@ -202,7 +200,7 @@ addInAllGroup groupname = do
m <- groupMap
addLimit $ limitInAllGroup m groupname
-limitInAllGroup :: GroupMap -> MkLimit
+limitInAllGroup :: GroupMap -> MkLimit Annex
limitInAllGroup m groupname
| S.null want = Right $ const $ const $ return True
| otherwise = Right $ \notpresent -> checkKey $ check notpresent
@@ -219,7 +217,7 @@ limitInAllGroup m groupname
addInBackend :: String -> Annex ()
addInBackend = addLimit . limitInBackend
-limitInBackend :: MkLimit
+limitInBackend :: MkLimit Annex
limitInBackend name = Right $ const $ checkKey check
where
check key = pure $ keyBackendName key == name
@@ -231,7 +229,7 @@ addLargerThan = addLimit . limitSize (>)
addSmallerThan :: String -> Annex ()
addSmallerThan = addLimit . limitSize (<)
-limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit
+limitSize :: (Maybe Integer -> Maybe Integer -> Bool) -> MkLimit Annex
limitSize vs s = case readSize dataUnits s of
Nothing -> Left "bad size"
Just sz -> Right $ go sz
@@ -249,7 +247,7 @@ limitSize vs s = case readSize dataUnits s of
addMetaData :: String -> Annex ()
addMetaData = addLimit . limitMetaData
-limitMetaData :: MkLimit
+limitMetaData :: MkLimit Annex
limitMetaData s = case parseMetaData s of
Left e -> Left e
Right (f, v) ->
diff --git a/Logs.hs b/Logs.hs
index 2a2fc430e..c9d58157a 100644
--- a/Logs.hs
+++ b/Logs.hs
@@ -35,6 +35,7 @@ topLevelUUIDBasedLogs =
, trustLog
, groupLog
, preferredContentLog
+ , requiredContentLog
, scheduleLog
]
@@ -70,6 +71,9 @@ groupLog = "group.log"
preferredContentLog :: FilePath
preferredContentLog = "preferred-content.log"
+requiredContentLog :: FilePath
+requiredContentLog = "required-content.log"
+
groupPreferredContentLog :: FilePath
groupPreferredContentLog = "group-preferred-content.log"
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index 5580c062d..480ac2e6d 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -28,14 +28,14 @@ import qualified Annex.Branch
import qualified Annex
import Logs
import Logs.UUIDBased
-import qualified Utility.Matcher
+import Utility.Matcher hiding (tokens)
import Annex.FileMatcher
import Annex.UUID
-import Types.Limit
import Types.Group
import Types.Remote (RemoteConfig)
import Logs.Group
import Logs.Remote
+import Types.FileMatcher
import Types.StandardGroups
import Limit
@@ -50,12 +50,12 @@ isPreferredContent mu notpresent mkey afile def = do
Just matcher -> checkMatcher matcher mkey afile notpresent def
{- The map is cached for speed. -}
-preferredContentMap :: Annex Annex.PreferredContentMap
+preferredContentMap :: Annex (FileMatcherMap Annex)
preferredContentMap = maybe preferredContentMapLoad return
=<< Annex.getState Annex.preferredcontentmap
{- Loads the map, updating the cache. -}
-preferredContentMapLoad :: Annex Annex.PreferredContentMap
+preferredContentMapLoad :: Annex (FileMatcherMap Annex)
preferredContentMapLoad = do
groupmap <- groupMap
configmap <- readRemoteLog
@@ -75,11 +75,11 @@ makeMatcher
-> M.Map Group PreferredContentExpression
-> UUID
-> PreferredContentExpression
- -> FileMatcher
+ -> FileMatcher Annex
makeMatcher groupmap configmap groupwantedmap u = go True True
where
go expandstandard expandgroupwanted expr
- | null (lefts tokens) = Utility.Matcher.generate $ rights tokens
+ | null (lefts tokens) = generate $ rights tokens
| otherwise = unknownMatcher u
where
tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr
@@ -102,10 +102,10 @@ makeMatcher groupmap configmap groupwantedmap u = go True True
-
- This avoid unwanted/expensive changes to the content, until the problem
- is resolved. -}
-unknownMatcher :: UUID -> FileMatcher
-unknownMatcher u = Utility.Matcher.generate [present]
+unknownMatcher :: UUID -> FileMatcher Annex
+unknownMatcher u = generate [present]
where
- present = Utility.Matcher.Operation $ matchPresent (Just u)
+ present = Operation $ matchPresent (Just u)
{- Checks if an expression can be parsed, if not returns Just error -}
checkPreferredContentExpression :: PreferredContentExpression -> Maybe String
diff --git a/Types/FileMatcher.hs b/Types/FileMatcher.hs
index e2d4eadc1..03a86a38c 100644
--- a/Types/FileMatcher.hs
+++ b/Types/FileMatcher.hs
@@ -7,7 +7,12 @@
module Types.FileMatcher where
+import Types.UUID (UUID)
import Types.Key (Key)
+import Utility.Matcher (Matcher, Token)
+
+import qualified Data.Map as M
+import qualified Data.Set as S
data MatchInfo
= MatchingFile FileInfo
@@ -17,3 +22,19 @@ data FileInfo = FileInfo
{ relFile :: FilePath -- may be relative to cwd
, matchFile :: FilePath -- filepath to match on; may be relative to top
}
+
+type FileMatcherMap a = M.Map UUID (Utility.Matcher.Matcher (S.Set UUID -> MatchInfo -> a Bool))
+
+type MkLimit a = String -> Either String (MatchFiles a)
+
+type AssumeNotPresent = S.Set UUID
+
+type MatchFiles a = AssumeNotPresent -> MatchInfo -> a Bool
+
+type FileMatcher a = Matcher (MatchFiles a)
+
+-- This is a matcher that can have tokens added to it while it's being
+-- built, and once complete is compiled to an unchangable matcher.
+data ExpandableMatcher a
+ = BuildingMatcher [Token (MatchInfo -> a Bool)]
+ | CompleteMatcher (Matcher (MatchInfo -> a Bool))
diff --git a/Types/Limit.hs b/Types/Limit.hs
deleted file mode 100644
index 2b009a758..000000000
--- a/Types/Limit.hs
+++ /dev/null
@@ -1,20 +0,0 @@
-{- types for limits
- -
- - Copyright 2013 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-{-# LANGUAGE CPP #-}
-
-module Types.Limit where
-
-import Common.Annex
-import Types.FileMatcher
-
-import qualified Data.Set as S
-
-type MkLimit = String -> Either String MatchFiles
-
-type AssumeNotPresent = S.Set UUID
-type MatchFiles = AssumeNotPresent -> MatchInfo -> Annex Bool
generated by cgit v1.2.3 (git 2.39.1) at 2024-06-10 15:04:52 +0000