split and lift Assistant.Pushes

1 files changed, 22 insertions, 41 deletions

diff --git a/Assistant/Pushes.hs b/Assistant/Pushes.hs
index 49772d56a..122d46d21 100644
--- a/Assistant/Pushes.hs
+++ b/Assistant/Pushes.hs
@@ -7,7 +7,8 @@
 
 module Assistant.Pushes where
 
-import Common.Annex
+import Assistant.Common
+import Assistant.Types.Pushes
 import Utility.TSet
 
 import Control.Concurrent.STM
@@ -15,59 +16,39 @@ import Control.Concurrent.MSampleVar
 import Data.Time.Clock
 import qualified Data.Map as M
 
-{- Track the most recent push failure for each remote. -}
-type PushMap = M.Map Remote UTCTime
-type FailedPushMap = TMVar PushMap
-
-{- The TSet is recent, successful pushes that other remotes should be
- - notified about.
- -
- - The MSampleVar is written to when the PushNotifier thread should be
- - restarted for some reason.
- -}
-data PushNotifier = PushNotifier (TSet UUID) (MSampleVar ())
-
-{- The TMVar starts empty, and is left empty when there are no
- - failed pushes. This way we can block until there are some failed pushes.
- -}
-newFailedPushMap :: IO FailedPushMap
-newFailedPushMap = atomically newEmptyTMVar
-
 {- 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 :: FailedPushMap -> NominalDiffTime -> IO [Remote]
-getFailedPushesBefore v duration = do
-	m <- atomically $ readTMVar v
-	now <- getCurrentTime
-	return $ M.keys $ M.filter (not . toorecent now) m
+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
 	where
 		toorecent now time = now `diffUTCTime` time < duration
 
 {- Modifies the map. -}
-changeFailedPushMap :: FailedPushMap -> (PushMap -> PushMap) -> IO ()
-changeFailedPushMap v a = atomically $
-	store . a . fromMaybe M.empty =<< tryTakeTMVar v
+changeFailedPushMap :: (PushMap -> PushMap) -> Assistant ()
+changeFailedPushMap a = do
+	v <- getAssistant failedPushMap
+	liftIO $ atomically $ store v . a . fromMaybe M.empty =<< tryTakeTMVar v
 	where
  		{- tryTakeTMVar empties the TMVar; refill it only if
 		 - the modified map is not itself empty -}
-		store m
+		store v m
 			| m == M.empty = noop
 			| otherwise = putTMVar v $! m
 
-newPushNotifier :: IO PushNotifier
-newPushNotifier = PushNotifier
-	<$> newTSet
-	<*> newEmptySV
-
-notifyPush :: [UUID] -> PushNotifier -> IO ()
-notifyPush us (PushNotifier s _) = putTSet s us
+notifyPush :: [UUID] -> Assistant ()
+notifyPush us = flip putTSet us <<~ (pushNotifierSuccesses . pushNotifier)
 
-waitPush :: PushNotifier -> IO [UUID]
-waitPush (PushNotifier s _) = getTSet s
+waitPush :: Assistant [UUID]
+waitPush = getTSet <<~ (pushNotifierSuccesses . pushNotifier)
 
-notifyRestart :: PushNotifier -> IO ()
-notifyRestart (PushNotifier _ sv) = writeSV sv ()
+notifyRestart :: Assistant ()
+notifyRestart = flip writeSV () <<~ (pushNotifierWaiter . pushNotifier)
 
-waitRestart :: PushNotifier -> IO ()
-waitRestart (PushNotifier _ sv) = readSV sv
+waitRestart :: Assistant ()
+waitRestart = readSV <<~ (pushNotifierWaiter . pushNotifier)