aboutsummaryrefslogtreecommitdiff
path: root/Assistant/Threads/Pusher.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-03-10 18:42:28 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-03-10 18:42:28 -0400
commitd2a8d2dfd783541e682cad15ec70ae277a036635 (patch)
tree6e8e69907f7aaa2c45e851467141ed9dd33a9cd1 /Assistant/Threads/Pusher.hs
parent2a6fc46baf66d19da150dd5bfb91c3dd9e33e244 (diff)
avoid ugly alert caused by trying to push to unavailable removable drive
Diffstat (limited to 'Assistant/Threads/Pusher.hs')
-rw-r--r--Assistant/Threads/Pusher.hs15
1 files changed, 12 insertions, 3 deletions
diff --git a/Assistant/Threads/Pusher.hs b/Assistant/Threads/Pusher.hs
index 8a695316e..d87aa8d3b 100644
--- a/Assistant/Threads/Pusher.hs
+++ b/Assistant/Threads/Pusher.hs
@@ -38,13 +38,22 @@ pushThread = namedThread "Pusher" $ runEvery (Seconds 2) <~> do
commits <- getCommits
-- Now see if now's a good time to push.
if shouldPush commits
- then void $ pushToRemotes True
- =<< filter (not . Remote.readonly) . syncGitRemotes
- <$> getDaemonStatus
+ then void $ pushToRemotes True =<< pushTargets
else do
debug ["delaying push of", show (length commits), "commits"]
refillCommits commits
+{- We want to avoid pushing to remotes that are marked readonly.
+ -
+ - Also, avoid pushing to local remotes we can easily tell are not available,
+ - to avoid ugly messages when a removable drive is not attached.
+ -}
+pushTargets :: Assistant [Remote]
+pushTargets = liftIO . filterM available =<< candidates <$> getDaemonStatus
+ where
+ candidates = filter (not . Remote.readonly) . syncGitRemotes
+ available = maybe (return True) doesDirectoryExist . Remote.localpath
+
{- Decide if now is a good time to push to remotes.
-
- Current strategy: Immediately push all commits. The commit machinery