diff options
Diffstat (limited to 'Assistant/Pushes.hs')
| -rw-r--r-- | Assistant/Pushes.hs | 21 |
1 files changed, 9 insertions, 12 deletions
diff --git a/Assistant/Pushes.hs b/Assistant/Pushes.hs index 7b4de450f..61891ea28 100644 --- a/Assistant/Pushes.hs +++ b/Assistant/Pushes.hs @@ -17,24 +17,21 @@ import qualified Data.Map as M {- Blocks until there are failed pushes. - Returns Remotes whose pushes failed a given time duration or more ago. - (This may be an empty list.) -} -getFailedPushesBefore :: NominalDiffTime -> Assistant [Remote] -getFailedPushesBefore duration = do - v <- getAssistant failedPushMap - liftIO $ do - m <- atomically $ readTMVar v - now <- getCurrentTime - return $ M.keys $ M.filter (not . toorecent now) m +getFailedPushesBefore :: NominalDiffTime -> FailedPushMap -> Assistant [Remote] +getFailedPushesBefore duration v = liftIO $ do + m <- atomically $ readTMVar v + now <- getCurrentTime + return $ M.keys $ M.filter (not . toorecent now) m where toorecent now time = now `diffUTCTime` time < duration {- Modifies the map. -} -changeFailedPushMap :: (PushMap -> PushMap) -> Assistant () -changeFailedPushMap a = do - v <- getAssistant failedPushMap - liftIO $ atomically $ store v . a . fromMaybe M.empty =<< tryTakeTMVar v +changeFailedPushMap :: FailedPushMap -> (PushMap -> PushMap) -> Assistant () +changeFailedPushMap v f = liftIO $ atomically $ + store . f . fromMaybe M.empty =<< tryTakeTMVar v where {- tryTakeTMVar empties the TMVar; refill it only if - the modified map is not itself empty -} - store v m + store m | m == M.empty = noop | otherwise = putTMVar v $! m |