lifted Assistant.Sync into Assistant monad

lots of nice cleanups
This commit is contained in:
Joey Hess 2012-10-29 16:22:14 -04:00
parent 1948202b32
commit 5d57b28a34
9 changed files with 88 additions and 117 deletions

View file

@ -159,11 +159,7 @@ handleMount :: FilePath -> Assistant ()
handleMount dir = do
debug ["detected mount of", dir]
rs <- filter (Git.repoIsLocal . Remote.repo) <$> remotesUnder dir
d <- getAssistant id
liftIO $
reconnectRemotes (threadName d) (threadState d)
(daemonStatusHandle d) (scanRemoteMap d)
(Just $ pushNotifier d) rs
reconnectRemotes True rs
{- Finds remotes located underneath the mount point.
-

View file

@ -123,11 +123,7 @@ listenWicdConnections client callback =
#endif
handleConnection :: Assistant ()
handleConnection = do
d <- getAssistant id
liftIO . reconnectRemotes (threadName d) (threadState d)
(daemonStatusHandle d) (scanRemoteMap d) (Just $ pushNotifier d)
=<< networkRemotes
handleConnection = reconnectRemotes True =<< networkRemotes
{- Finds network remotes. -}
networkRemotes :: Assistant [Remote]

View file

@ -32,11 +32,9 @@ pushRetryThread = NamedThread "PushRetrier" $ runEvery (Seconds halfhour) <~> do
unless (null topush) $ do
debug ["retrying", show (length topush), "failed pushes"]
now <- liftIO $ getCurrentTime
st <- getAssistant threadState
pushnotifier <- getAssistant pushNotifier
dstatus <- getAssistant daemonStatusHandle
void $ liftIO $ alertWhile dstatus (pushRetryAlert topush) $
pushToRemotes thisThread now st (Just pushnotifier) (Just pushmap) topush
void $ alertWhile dstatus (pushRetryAlert topush) <~>
pushToRemotes now True topush
where
halfhour = 1800
@ -52,12 +50,9 @@ pushThread = NamedThread "Pusher" $ runEvery (Seconds 2) <~> do
remotes <- filter pushable . syncRemotes <$> daemonStatus
unless (null remotes) $ do
now <- liftIO $ getCurrentTime
st <- getAssistant threadState
pushmap <- getAssistant failedPushMap
pushnotifier <- getAssistant pushNotifier
dstatus <- getAssistant daemonStatusHandle
void $ liftIO $ alertWhile dstatus (pushAlert remotes) $
pushToRemotes thisThread now st (Just pushnotifier) (Just pushmap) remotes
void $ alertWhile dstatus (pushAlert remotes) <~>
pushToRemotes now True remotes
else do
debug ["delaying push of", show (length commits), "commits"]
flip refillCommits commits <<~ commitChan