lift alertWhile

Assistant/Threads/Committer.hs

@@ -58,8 +58,7 @@ commitThread = NamedThread "Committer" $ do
 							, show (length readychanges)
 							, "changes"
 							]
-						dstatus <- getAssistant daemonStatusHandle
-						void $ alertWhile dstatus commitAlert <~>
+						void $ alertWhile commitAlert $
 							liftAnnex commitStaged
 						recordCommit <<~ commitChan
 					else refill readychanges
@@ -177,21 +176,19 @@ handleAdds delayadd cs = returnWhen (null incomplete) $ do
 
 	add :: Change -> Assistant (Maybe Change)
 	add change@(InProcessAddChange { keySource = ks }) = do
-		dstatus <- getAssistant daemonStatusHandle
-		alertWhile' dstatus (addFileAlert $ keyFilename ks) <~> add' change ks
-	add _ = return Nothing
-
-	add' change ks = liftM ret $ catchMaybeIO <~> do
-		sanitycheck ks $ do
-			key <- liftAnnex $ do
-				showStart "add" $ keyFilename ks
-				Command.Add.ingest ks
-			done (finishedChange change) (keyFilename ks) key
+		alertWhile' (addFileAlert $ keyFilename ks) $
+			liftM ret $ catchMaybeIO <~> do
+				sanitycheck ks $ do
+					key <- liftAnnex $ do
+						showStart "add" $ keyFilename ks
+						Command.Add.ingest ks
+					done (finishedChange change) (keyFilename ks) key
 	  where
 		{- Add errors tend to be transient and will be automatically
 		 - dealt with, so don't pass to the alert code. -}
 		ret (Just j@(Just _)) = (True, j)
 		ret _ = (True, Nothing)
+	add _ = return Nothing
 
 	done _ _ Nothing = do
 		liftAnnex showEndFail

Assistant/Threads/Pusher.hs

@@ -31,9 +31,8 @@ pushRetryThread = NamedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do
 	topush <- liftIO $ getFailedPushesBefore pushmap (fromIntegral halfhour)
 	unless (null topush) $ do
 		debug ["retrying", show (length topush), "failed pushes"]
-		now <- liftIO $ getCurrentTime
-		dstatus <- getAssistant daemonStatusHandle
-		void $ alertWhile dstatus (pushRetryAlert topush) <~>
+		void $ alertWhile (pushRetryAlert topush) $ do
+			now <- liftIO $ getCurrentTime
 			pushToRemotes now True topush
 	where
 		halfhour = 1800
@@ -48,10 +47,9 @@ pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do
 	if shouldPush commits
 		then do
 			remotes <- filter pushable . syncRemotes <$> daemonStatus
-			unless (null remotes) $ do
-				now <- liftIO $ getCurrentTime
-				dstatus <- getAssistant daemonStatusHandle
-				void $ alertWhile dstatus (pushAlert remotes) <~>
+			unless (null remotes) $
+				void $ alertWhile (pushAlert remotes) $ do
+					now <- liftIO $ getCurrentTime
 					pushToRemotes now True remotes
 		else do
 			debug ["delaying push of", show (length commits), "commits"]

Assistant/Threads/SanityChecker.hs

@@ -24,10 +24,7 @@ sanityCheckerThread = NamedThread "SanityChecker" $ forever $ do
 	waitForNextCheck
 
 	debug ["starting sanity check"]
-
-	dstatus <- getAssistant daemonStatusHandle
-	void $ alertWhile dstatus sanityCheckAlert <~> go
-	
+	void $ alertWhile sanityCheckAlert go
 	debug ["sanity check complete"]
   where
 	go = do

Assistant/Threads/TransferScanner.hs

@@ -100,10 +100,10 @@ failedTransferScan r = do
 expensiveScan :: [Remote] -> Assistant ()
 expensiveScan rs = unless onlyweb $ do
 	debug ["starting scan of", show visiblers]
-	dstatus <- getAssistant daemonStatusHandle
-	void $ alertWhile dstatus (scanAlert visiblers) <~> do
+	void $ alertWhile (scanAlert visiblers) $ do
 		g <- liftAnnex gitRepo
 		(files, cleanup) <- liftIO $ LsFiles.inRepo [] g
+		dstatus <- getAssistant daemonStatusHandle
 		forM_ files $ \f -> do
 			ts <- liftAnnex $
 				ifAnnexed f (findtransfers dstatus f) (return [])

Assistant/Threads/Watcher.hs

@@ -75,8 +75,7 @@ watchThread = NamedThread "Watcher" $ do
 startupScan :: IO a -> Assistant a
 startupScan scanner = do
 	liftAnnex $ showAction "scanning"
-	dstatus <- getAssistant daemonStatusHandle
-	alertWhile' dstatus startupScanAlert <~> do
+	alertWhile' startupScanAlert $ do
 		r <- liftIO $ scanner
 
 		-- Notice any files that were deleted before
@@ -85,6 +84,7 @@ startupScan scanner = do
 			inRepo $ Git.Command.run "add" [Param "--update"]
 			showAction "started"
 		
+		dstatus <- getAssistant daemonStatusHandle
 		liftIO $ modifyDaemonStatus_ dstatus $
 			\s -> s { scanComplete = True }