lifted Assistant.Sync into Assistant monad
lots of nice cleanups
This commit is contained in:
parent
1948202b32
commit
5d57b28a34
9 changed files with 88 additions and 117 deletions
|
@ -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.
|
||||
-
|
||||
|
|
|
@ -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]
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue