factor out untilTrue

Remote/Git.hs

@@ -200,10 +200,7 @@ copyFromRemote r key file
 	| Git.repoIsHttp r = liftIO $ downloadurls $ keyUrls r key
 	| otherwise = error "copying from non-ssh, non-http repo not supported"
 	where
-		downloadurls [] = return False
+		downloadurls us = untilTrue us $ \u -> Url.download u file
-		downloadurls (u:us) = do
-			ok <- Url.download u file
-			if ok then return ok else downloadurls us
 
 {- Tries to copy a key's content to a remote's annex. -}
 copyToRemote :: Git.Repo -> Key -> Annex Bool

Remote/Rsync.hs

@@ -97,16 +97,6 @@ rsyncUrlDirs o k = map use annexHashes
 	where
 		use h = rsyncUrl o </> h k </> rsyncEscape o (keyFile k)
 
-withRsyncUrl :: RsyncOpts -> Key -> (FilePath -> Annex Bool) -> Annex Bool
-withRsyncUrl o k a = go $ rsyncUrls o k
-	where
-		go [] = return False
-		go (u:us) = do
-			ok <- a u
-			if ok
-				then return ok
-				else go us
-
 store :: RsyncOpts -> Key -> Annex Bool
 store o k = rsyncSend o k =<< inRepo (gitAnnexLocation k)
 
@@ -117,7 +107,8 @@ storeEncrypted o (cipher, enck) k = withTmp enck $ \tmp -> do
 	rsyncSend o enck tmp
 
 retrieve :: RsyncOpts -> Key -> FilePath -> Annex Bool
-retrieve o k f = withRsyncUrl o k $ \u -> rsyncRemote o
+retrieve o k f = untilTrue (rsyncUrls o k) $ \u ->
+	rsyncRemote o
 		-- use inplace when retrieving to support resuming
 		[ Param "--inplace"
 		, Param u
@@ -134,9 +125,8 @@ retrieveEncrypted o (cipher, enck) f = withTmp enck $ \tmp -> do
 		else return res
 
 remove :: RsyncOpts -> Key -> Annex Bool
-remove o k = any (== True) <$> sequence (map go (rsyncUrlDirs o k))
+remove o k = untilTrue (rsyncUrlDirs o k) $ \d ->
-	where
+	withRsyncScratchDir $ \tmp -> liftIO $ do
-		go d = withRsyncScratchDir $ \tmp -> liftIO $ do
 		{- Send an empty directory to rysnc as the
 		 - parent directory of the file to remove. -}
 		let dummy = tmp </> keyFile k
@@ -155,7 +145,7 @@ checkPresent r o k = do
 	-- to connect, and the file not being present.
 	Right <$> check
 	where
- 		check = withRsyncUrl o k $ \u ->
+ 		check = untilTrue (rsyncUrls o k) $ \u ->
 			liftIO $ boolSystem "sh" [Param "-c", Param (cmd u)]
 		cmd u = "rsync --quiet " ++ shellEscape u ++ " 2>/dev/null"
 

Remote/Web.hs

@@ -71,8 +71,6 @@ checkKey key = do
 		then return $ Right False
 		else return . Right =<< checkKey' us
 checkKey' :: [URLString] -> Annex Bool
-checkKey' [] = return False
+checkKey' us = untilTrue us $ \u -> do
-checkKey' (u:us) = do
 	showAction $ "checking " ++ u
-	e <- liftIO $ Url.exists u
+	liftIO $ Url.exists u
-	if e then return e else checkKey' us

Utility/Conditional.hs

@@ -9,6 +9,12 @@ module Utility.Conditional where
 
 import Control.Monad (when, unless)
 
+untilTrue :: Monad m => [v] -> (v -> m Bool) -> m Bool
+untilTrue [] _ = return False
+untilTrue (v:vs) a = do
+	ok <- a v
+	if ok then return ok else untilTrue vs a
+
 whenM :: Monad m => m Bool -> m () -> m ()
 whenM c a = c >>= flip when a