move DaemonStatus manipulation out of the Annex monad to IO

I've convinced myself that nothing in DaemonStatus can deadlock,
as it always keepts the TMVar full. That was the only reason it was in the
Annex monad.
This commit is contained in:
Joey Hess 2012-07-28 18:02:11 -04:00
parent a17fde22fa
commit 3cc1885793
9 changed files with 49 additions and 60 deletions

View file

@ -26,32 +26,28 @@ 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 st status
waitForNextCheck status
debug thisThread ["starting sanity check"]
runThreadState st $
modifyDaemonStatus_ status $ \s -> s
{ sanityCheckRunning = True }
modifyDaemonStatus_ status $ \s -> s
{ sanityCheckRunning = True }
now <- getPOSIXTime -- before check started
catchIO (check st status transferqueue changechan)
(runThreadState st . warning . show)
runThreadState st $ do
modifyDaemonStatus_ status $ \s -> s
{ sanityCheckRunning = False
, lastSanityCheck = Just now
}
modifyDaemonStatus_ status $ \s -> s
{ sanityCheckRunning = False
, lastSanityCheck = Just now
}
debug thisThread ["sanity check complete"]
{- Only run one check per day, from the time of the last check. -}
waitForNextCheck :: ThreadState -> DaemonStatusHandle -> IO ()
waitForNextCheck st status = do
v <- runThreadState st $
lastSanityCheck <$> getDaemonStatus status
waitForNextCheck :: DaemonStatusHandle -> IO ()
waitForNextCheck status = do
v <- lastSanityCheck <$> getDaemonStatus status
now <- getPOSIXTime
threadDelaySeconds $ Seconds $ calcdelay now v
where