wire git repair into webapp

Assistant/WebApp/Repair.hs

@@ -10,7 +10,17 @@
 module Assistant.WebApp.Repair where
 
 import Assistant.WebApp.Common
+import Assistant.WebApp.Utility
+import Assistant.WebApp.RepoList
 import Remote (prettyUUID)
+import Command.Repair (repairAnnexBranch)
+import Git.Repair (runRepairOf)
+import Logs.FsckResults
+import Annex.UUID
+import Utility.Batch
+import Config.Files
+
+import Control.Concurrent.Async
 
 getRepairRepositoryR :: UUID -> Handler Html
 getRepairRepositoryR = postRepairRepositoryR
@@ -20,7 +30,51 @@ postRepairRepositoryR u = page "Repair repository" Nothing $ do
 	$(widgetFile "control/repairrepository")
 
 getRepairRepositoryRunR :: UUID -> Handler Html
-getRepairRepositoryRunR = postRepairRepositoryR
+getRepairRepositoryRunR = postRepairRepositoryRunR
 postRepairRepositoryRunR :: UUID -> Handler Html
-postRepairRepositoryRunR u = page "Repair repository" Nothing $ do
-	$(widgetFile "control/repairrepository/run")
+postRepairRepositoryRunR u = do
+	-- Stop the watcher from running while running repairs.
+	changeSyncable Nothing False
+
+	fsckthread <- liftAssistant $ runRepair u
+
+	-- Start the watcher running again. This also triggers it to do a
+	-- startup scan, which is especially important if the git repo
+	-- repair removed files from the index file. Those files will be
+	-- seen as new, and re-added to the repository.
+	changeSyncable Nothing True
+
+	liftAnnex $ writeFsckResults u Nothing
+
+	page "Repair repository" Nothing $ do
+		let repolist = repoListDisplay $
+			mainRepoSelector { nudgeAddMore = True }
+		$(widgetFile "control/repairrepository/done")
+
+runRepair :: UUID -> Assistant ()
+runRepair u = do
+	fsckresults <- liftAnnex (readFsckResults u)
+	myu <- liftAnnex getUUID
+	if u == myu
+		then localrepair fsckresults
+		else remoterepair fsckresults
+  where
+  	localrepair fsckresults = do
+		-- This intentionally runs the repair inside the Annex
+		-- monad, which is not stricktly necessary, but keeps
+		-- other threads that might be trying to use the Annex
+		-- from running until it completes.
+		needfsck <- liftAnnex $ do
+			(ok, stillmissing, modifiedbranches) <- inRepo $
+				runRepairOf fsckresults True
+			repairAnnexBranch stillmissing modifiedbranches
+			return (not ok)
+		when needfsck $
+			backgroundfsck [ Param "--fast" ]
+
+	remoterepair fsckresults = do
+		error "TODO: remote repair"
+	
+	backgroundfsck params = liftIO $ void $ async $ do
+		program <- readProgramFile
+		batchCommand program (Param "fsck" : params)