add more alerts

Nearly all long-running actions now display an alert.

Assistant/Threads/SanityChecker.hs

@@ -13,6 +13,7 @@ import Assistant.Common
 import Assistant.DaemonStatus
 import Assistant.ThreadedMonad
 import Assistant.Changes
+import Assistant.Alert
 import Assistant.TransferQueue
 import qualified Git.LsFiles
 import Utility.ThreadScheduler
@@ -25,29 +26,34 @@ thisThread = "SanityChecker"
 
 {- This thread wakes up occasionally to make sure the tree is in good shape. -}
 sanityCheckerThread :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO ()
-sanityCheckerThread st status transferqueue changechan = forever $ do
-	waitForNextCheck status
+sanityCheckerThread st dstatus transferqueue changechan = forever $ do
+	waitForNextCheck dstatus
 
 	debug thisThread ["starting sanity check"]
 
-	modifyDaemonStatus_ status $ \s -> s
-		{ sanityCheckRunning = True }
-
-	now <- getPOSIXTime -- before check started
-	catchIO (check st status transferqueue changechan)
-		(runThreadState st . warning . show)
-
-	modifyDaemonStatus_ status $ \s -> s
-		{ sanityCheckRunning = False
-		, lastSanityCheck = Just now
-		}
+	alertWhile dstatus alert go
 	
 	debug thisThread ["sanity check complete"]
+	where
+		go = do
+			modifyDaemonStatus_ dstatus $ \s -> s
+				{ sanityCheckRunning = True }
+
+			now <- getPOSIXTime -- before check started
+			catchIO (check st dstatus transferqueue changechan)
+				(runThreadState st . warning . show)
+
+			modifyDaemonStatus_ dstatus $ \s -> s
+				{ sanityCheckRunning = False
+				, lastSanityCheck = Just now
+				}
+		alert = activityAlert (Just "Running daily sanity check")
+			"to make sure I've not missed anything."
 
 {- Only run one check per day, from the time of the last check. -}
 waitForNextCheck :: DaemonStatusHandle -> IO ()
-waitForNextCheck status = do
-	v <- lastSanityCheck <$> getDaemonStatus status
+waitForNextCheck dstatus = do
+	v <- lastSanityCheck <$> getDaemonStatus dstatus
 	now <- getPOSIXTime
 	threadDelaySeconds $ Seconds $ calcdelay now v
 	where
@@ -64,10 +70,8 @@ oneDay = 24 * 60 * 60
  - running potentially expensive parts of this check, since remaining in it
  - will block the watcher. -}
 check :: ThreadState -> DaemonStatusHandle -> TransferQueue -> ChangeChan -> IO () 
-check st status transferqueue changechan = do
-	g <- runThreadState st $ do
-		showSideAction "Running daily check"
-		fromRepo id
+check st dstatus transferqueue changechan = do
+	g <- runThreadState st $ fromRepo id
 	-- Find old unstaged symlinks, and add them to git.
 	unstaged <- Git.LsFiles.notInRepo False ["."] g
 	now <- getPOSIXTime
@@ -81,9 +85,20 @@ check st status transferqueue changechan = do
 	where
 		toonew timestamp now = now < (realToFrac (timestamp + slop) :: POSIXTime)
 		slop = fromIntegral tenMinutes
-		insanity m = runThreadState st $ warning m
+		insanity msg = do
+			runThreadState st $ warning msg
+			void $ addAlert dstatus $ Alert
+			        { alertClass = Warning
+			        , alertHeader = Just "Fixed a problem"
+			        , alertMessage = StringAlert $ unwords
+					[ "The daily sanity check found and fixed a problem:"
+					, msg
+					, "If these problems persist, consider filing a bug report."
+					]
+			        , alertBlockDisplay = True
+		        }
 		addsymlink file s = do
 			insanity $ "found unstaged symlink: " ++ file
-			Watcher.runHandler thisThread st status
+			Watcher.runHandler thisThread st dstatus
 				transferqueue changechan
 				Watcher.onAddSymlink file s