From e31277d38aa5d9b07395d05a6f1646b5eb3d48c2 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sat, 28 Jul 2012 18:47:24 -0400 Subject: send notifications when the TransferQueue is changed The fun part was making it move things from TransferQueue to currentTransfers entirely atomically. Which will avoid inconsistent display if the WebApp renders the current status at just the wrong time. STM to the rescue! --- Assistant/DaemonStatus.hs | 18 +++++++++++++++++- 1 file changed, 17 insertions(+), 1 deletion(-) (limited to 'Assistant/DaemonStatus.hs') diff --git a/Assistant/DaemonStatus.hs b/Assistant/DaemonStatus.hs index 52165138e..3610c2fda 100644 --- a/Assistant/DaemonStatus.hs +++ b/Assistant/DaemonStatus.hs @@ -36,6 +36,7 @@ data DaemonStatus = DaemonStatus -- Ordered list of remotes to talk to. , knownRemotes :: [Remote] -- Clients can use this to wait on changes to the DaemonStatus + -- and other related things like the TransferQueue. , notificationBroadcaster :: NotificationBroadcaster } @@ -72,6 +73,12 @@ modifyDaemonStatus handle a = do sendNotification nb return b +{- Can be used to send a notification that the daemon status, or other + - associated thing, like the TransferQueue, has changed. -} +notifyDaemonStatusChange :: DaemonStatusHandle -> IO () +notifyDaemonStatusChange handle = sendNotification + =<< notificationBroadcaster <$> atomically (readTMVar handle) + {- Updates the cached ordered list of remotes from the list in Annex - state. -} updateKnownRemotes :: DaemonStatusHandle -> Annex () @@ -164,7 +171,16 @@ afterLastDaemonRun timestamp status = maybe False (< t) (lastRunning status) tenMinutes :: Int tenMinutes = 10 * 60 -{- Mutates the transfer map. -} +{- Mutates the transfer map. Runs in STM so that the transfer map can + - be modified in the same transaction that modifies the transfer queue. + - Note that this does not send a notification of the change; that's left + - to the caller. -} +adjustTransfersSTM :: DaemonStatusHandle -> (TransferMap -> TransferMap) -> STM () +adjustTransfersSTM dstatus a = do + s <- takeTMVar dstatus + putTMVar dstatus $ s { currentTransfers = a (currentTransfers s) } + +{- Variant that does send notifications. -} adjustTransfers :: DaemonStatusHandle -> (TransferMap -> TransferMap) -> IO () adjustTransfers dstatus a = modifyDaemonStatus_ dstatus $ \s -> s { currentTransfers = a (currentTransfers s) } -- cgit v1.2.3