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:
parent
4e765327ca
commit
4dbdc2b666
29 changed files with 299 additions and 280 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue