improve live update starting

In an expression like "balanced=foo and exclude=bar", avoid it starting
a live update when the overall expression doesn't match.

Annex/FileMatcher.hs

@@ -42,6 +42,7 @@ import Git.FilePath
 import Types.Remote (RemoteConfig)
 import Types.ProposedAccepted
 import Annex.CheckAttr
+import Annex.RepoSize.LiveUpdate
 import qualified Git.Config
 #ifdef WITH_MAGICMIME
 import Annex.Magic
@@ -88,13 +89,16 @@ checkMatcher matcher mkey afile lu notpresent notconfigured d
 	go mi = checkMatcher' matcher mi lu notpresent
 
 checkMatcher' :: FileMatcher Annex -> MatchInfo -> LiveUpdate -> AssumeNotPresent -> Annex Bool
-checkMatcher' (matcher, (MatcherDesc matcherdesc)) mi lu notpresent = do
-	(matches, desc) <- runWriterT $ matchMrun' matcher $ \op ->
-		matchAction op lu notpresent mi
-	explain (mkActionItem mi) $ UnquotedString <$>
-		describeMatchResult matchDesc desc
-			((if matches then "matches " else "does not match ") ++ matcherdesc ++ ": ")
-	return matches
+checkMatcher' (matcher, (MatcherDesc matcherdesc)) mi lu notpresent =
+	checkLiveUpdate lu go
+  where
+	go = do
+		(matches, desc) <- runWriterT $ matchMrun' matcher $ \op ->
+			matchAction op lu notpresent mi
+		explain (mkActionItem mi) $ UnquotedString <$>
+			describeMatchResult matchDesc desc
+				((if matches then "matches " else "does not match ") ++ matcherdesc ++ ": ")
+		return matches
 
 fileMatchInfo :: RawFilePath -> Maybe Key -> Annex MatchInfo
 fileMatchInfo file mkey = do

Annex/RepoSize/LiveUpdate.hs

@@ -63,30 +63,36 @@ prepareLiveUpdate :: Maybe UUID -> Key -> SizeChange -> Annex LiveUpdate
 prepareLiveUpdate mu k sc = do
 	h <- Db.getRepoSizeHandle
 	u <- maybe getUUID pure mu
+	needv <- liftIO newEmptyMVar
 	startv <- liftIO newEmptyMVar
+	readyv <- liftIO newEmptyMVar
 	donev <- liftIO newEmptyMVar
 	finishv <- liftIO newEmptyMVar
-	void $ liftIO $ forkIO $ waitstart startv donev finishv h u
-	return (LiveUpdate startv donev finishv)
+	void $ liftIO $ forkIO $ waitstart startv readyv donev finishv h u
+	return (LiveUpdate needv startv readyv donev finishv)
   where
-	{- Wait for startLiveUpdate, or for the LiveUpdate to get garbage
-	 - collected in the case where it is never going to start. -}
-	waitstart startv donev finishv h u = tryNonAsync (takeMVar startv) >>= \case
-		Right _ -> do
-			{- Deferring updating the database until here
-			 - avoids overhead except in cases where preferred
-			 - content expressions need live updates. -}
-			Db.startingLiveSizeChange h u k sc
-			waitdone donev finishv h u
-		Left _ -> noop
+	{- Wait for checkLiveUpdate to request a start, or for the
+	 - LiveUpdate to get garbage collected in the case where
+	 - it is not needed. -}
+	waitstart startv readyv donev finishv h u =
+		tryNonAsync (takeMVar startv) >>= \case
+			Right () -> do
+				{- Deferring updating the database until
+				 - here avoids overhead except in cases
+				 - where preferred content expressions
+				 - need live updates. -}
+				Db.startingLiveSizeChange h u k sc
+				putMVar readyv ()
+				waitdone donev finishv h u
+			Left _ -> noop
 	
-	{- Wait for finishedLiveUpdate to be called, or for the LiveUpdate to
-	 - get garbage collected in the case where the change didn't
+	{- Wait for finishedLiveUpdate to be called, or for the LiveUpdate
+	 - to get garbage collected in the case where the change didn't
 	 - actually happen. -}
 	waitdone donev finishv h u = tryNonAsync (takeMVar donev) >>= \case
 		-- TODO need to update RepoSize db
 		-- in same transaction as Db.finishedLiveSizeChange
-		Right (u', k', sc')
+		Right (Just (u', k', sc'))
 			| u' == u && k' == k && sc' == sc -> do
 				done h u
 				putMVar finishv ()
@@ -94,19 +100,37 @@ prepareLiveUpdate mu k sc = do
 			-- causes fanout and so this is called with
 			-- other UUIDs.
 			| otherwise -> waitdone donev finishv h u
+		Right Nothing -> done h u
 		Left _ -> done h u
 	done h u = Db.finishedLiveSizeChange h u k sc
 
 -- Called when a preferred content check indicates that a live update is
--- needed. Can be called more than once.
-startLiveUpdate :: LiveUpdate -> Annex ()
-startLiveUpdate (LiveUpdate startv _donev _finishv) = 
-	liftIO $ void $ tryPutMVar startv ()
-startLiveUpdate NoLiveUpdate = noop
+-- needed. Can be called more than once on the same LiveUpdate.
+needLiveUpdate :: LiveUpdate -> Annex ()
+needLiveUpdate NoLiveUpdate = noop
+needLiveUpdate lu = liftIO $ void $ tryPutMVar (liveUpdateNeeded lu) ()
+
+-- needLiveUpdate has to be called inside this to take effect. If the
+-- action calls needLiveUpdate and then returns True, the live update is
+-- started. If the action calls needLiveUpdate and then returns False,
+-- the live update is not started.
+--
+-- This can be called more than once on the same LiveUpdate. It will
+-- only start it once.
+checkLiveUpdate :: LiveUpdate -> Annex Bool -> Annex Bool
+checkLiveUpdate NoLiveUpdate a = a
+checkLiveUpdate lu a = do
+	r <- a
+	needed <- liftIO $ isJust <$> tryTakeMVar (liveUpdateNeeded lu)
+	when (r && needed) $ do
+		liftIO $ void $ tryPutMVar (liveUpdateStart lu) ()
+		liftIO $ void $ readMVar (liveUpdateReady lu)
+	return r
 
 finishedLiveUpdate :: LiveUpdate -> UUID -> Key -> SizeChange -> IO ()
-finishedLiveUpdate (LiveUpdate _startv donev finishv) u k sc = do
-	tryNonAsync (putMVar donev (u, k, sc)) >>= \case
-		Right () -> void $ tryNonAsync $ readMVar finishv
-		Left _ -> noop
 finishedLiveUpdate NoLiveUpdate _ _ _ = noop
+finishedLiveUpdate lu u k sc = do
+	tryNonAsync (putMVar (liveUpdateDone lu) (Just (u, k, sc))) >>= \case
+		Right () -> void $
+			tryNonAsync $ readMVar $ liveUpdateFinish lu
+		Left _ -> noop

Limit.hs

@@ -672,7 +672,7 @@ limitFullyBalanced''' filtercandidates termname mu getgroupmap g n want = Right
 					u `elem` picker candidates key n
 				_ -> False
 		when wanted $
-			startLiveUpdate lu
+			needLiveUpdate lu
 		return wanted
 	, matchNeedsFileName = False
 	, matchNeedsFileContent = False

Types/RepoSize.hs

@@ -31,7 +31,13 @@ newtype MaxSize = MaxSize { fromMaxSize :: Integer }
 -- the changes to its size into account. If NoLiveUpdate is used, it
 -- prevents that.
 data LiveUpdate
-	= LiveUpdate (MVar ()) (MVar (UUID, Key, SizeChange)) (MVar ())
+	= LiveUpdate
+		{ liveUpdateNeeded :: MVar ()
+		, liveUpdateStart :: MVar ()
+		, liveUpdateReady :: MVar ()
+		, liveUpdateDone :: MVar (Maybe (UUID, Key, SizeChange))
+		, liveUpdateFinish :: MVar ()
+		}
 	| NoLiveUpdate
 
 data SizeChange = AddingKey | RemovingKey

doc/todo/git-annex_proxies.mdwn

@@ -145,20 +145,6 @@ Planned schedule of work:
 
 * Still implementing LiveUpdate. Check for TODO XXX markers
 
-* In an expression like "balanced=foo and exclude=bar",
-  it will start a live update even if the overall expression doesn't
-  match. That is suboptimal, but also this will probably be a rare case,
-  it doesn't really make sense to to that. What will happen in that case
-  is the repo will temporarily be treated as having that key going
-  into it, even when it is not. As soon as the LiveUpdate gets GCed,
-  that resolves. Until then, other keys may not match that usually would,
-  if the repo would have been filled up by that key.
-
-  What could be done in this case is, after checking preferred content,
-  when it's not preferred content, call stopLiveUpdate immediately,
-  rather than relying on GC.
-  That would also help with the next problem...
-
 * In the case where a copy to a remote fails (due eg to annex.diskreserve),
   the LiveUpdate thread can not get a chance to catch its exception when
   the LiveUpdate is gced, before git-annex exits. In this case, the