reorg matcher types; no non-type code changes

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

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

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

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) ->

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"
 

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

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))

Types/Limit.hs

@@ -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