Assistant monad, stage 2.5

Converted several threads to run in the monad.

Added a lot of useful combinators for working with the monad.

Now the monad includes the name of the thread.

Some debugging messages are disabled pending converting other threads.
This commit is contained in:
Joey Hess 2012-10-29 02:21:04 -04:00
parent 4e765327ca
commit 4dbdc2b666
29 changed files with 299 additions and 280 deletions

View file

@ -9,28 +9,21 @@ module Assistant.Threads.DaemonStatus where
import Assistant.Common
import Assistant.DaemonStatus
import Assistant.ThreadedMonad
import Utility.ThreadScheduler
import Utility.NotificationBroadcaster
thisThread :: ThreadName
thisThread = "DaemonStatus"
{- This writes the daemon status to disk, when it changes, but no more
- frequently than once every ten minutes.
-}
daemonStatusThread :: ThreadState -> DaemonStatusHandle -> NamedThread
daemonStatusThread st dstatus = thread $ do
notifier <- newNotificationHandle
=<< changeNotifier <$> getDaemonStatus dstatus
daemonStatusThread :: NamedThread
daemonStatusThread = NamedThread "DaemonStatus" $ do
notifier <- liftIO . newNotificationHandle
=<< changeNotifier <$> daemonStatus
checkpoint
runEvery (Seconds tenMinutes) $ do
waitNotification notifier
runEvery (Seconds tenMinutes) <~> do
liftIO $ waitNotification notifier
checkpoint
where
thread = NamedThread thisThread
checkpoint = do
status <- getDaemonStatus dstatus
file <- runThreadState st $ fromRepo gitAnnexDaemonStatusFile
writeDaemonStatusFile file status
where
checkpoint = do
file <- liftAnnex $ fromRepo gitAnnexDaemonStatusFile
liftIO . writeDaemonStatusFile file =<< daemonStatus