diff options
Diffstat (limited to 'Assistant/Threads/SanityChecker.hs')
| -rw-r--r-- | Assistant/Threads/SanityChecker.hs | 57 |
1 files changed, 36 insertions, 21 deletions
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index 5e27246a0..69610c2a7 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/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 |