diff options
Diffstat (limited to 'Assistant/Threads')
-rw-r--r-- | Assistant/Threads/SanityChecker.hs | 21 |
1 files changed, 10 insertions, 11 deletions
diff --git a/Assistant/Threads/SanityChecker.hs b/Assistant/Threads/SanityChecker.hs index b3aa9ddfd..d8ffa41f4 100644 --- a/Assistant/Threads/SanityChecker.hs +++ b/Assistant/Threads/SanityChecker.hs @@ -25,15 +25,22 @@ import Utility.NotificationBroadcaster import Config import qualified Git import qualified Utility.Lsof as Lsof +import Utility.HumanTime import Data.Time.Clock.POSIX {- This thread runs once at startup, and most other threads wait for it - to finish. (However, the webapp thread does not, to prevent the UI - being nonresponsive.) -} -sanityCheckerStartupThread :: NamedThread -sanityCheckerStartupThread = namedThreadUnchecked "SanityCheckerStartup" $ - startupCheck +sanityCheckerStartupThread :: Maybe Duration -> NamedThread +sanityCheckerStartupThread startupdelay = namedThreadUnchecked "SanityCheckerStartup" $ do + checkStaleGitLocks + + liftIO $ maybe noop (threadDelaySeconds . Seconds . fromIntegral . durationSeconds) startupdelay + + {- Notify other threads that the startup sanity check is done. -} + status <- getDaemonStatus + liftIO $ sendNotification $ startupSanityCheckNotifier status {- This thread wakes up hourly for inxepensive frequent sanity checks. -} sanityCheckerHourlyThread :: NamedThread @@ -80,14 +87,6 @@ waitForNextCheck = do oneDay - truncate (now - lastcheck) | otherwise = oneDay -startupCheck :: Assistant () -startupCheck = do - checkStaleGitLocks - - {- Notify other threads that the startup sanity check is done. -} - status <- getDaemonStatus - liftIO $ sendNotification $ startupSanityCheckNotifier status - {- It's important to stay out of the Annex monad as much as possible while - running potentially expensive parts of this check, since remaining in it - will block the watcher. -} |