From 999d5df90b013a7cc8a390c940785118400faf8a Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 28 Aug 2011 15:46:49 -0400
Subject: factor out firstM and anyM

Control.Monad.Loops has these, but has no Debian package yet.
---
 Remote/Web.hs |  7 ++-----
 Utility.hs    | 28 ++++++++++++++++++++++------
 2 files changed, 24 insertions(+), 11 deletions(-)

diff --git a/Remote/Web.hs b/Remote/Web.hs
index 0e4b75767..3695bb1ab 100644
--- a/Remote/Web.hs
+++ b/Remote/Web.hs
@@ -24,6 +24,7 @@ import Config
 import PresenceLog
 import LocationLog
 import Locations
+import Utility
 import qualified Utility.Url as Url
 
 type URLString = String
@@ -91,11 +92,7 @@ downloadKey key file = get =<< getUrls key
 		get [] = do
 			warning "no known url"
 			return False
-		get a = iter a
-		iter [] = return False
-		iter (url:urls) = do
-			ok <- Url.download url file
-			if ok then return ok else iter urls
+		get urls = anyM (`Url.download` file) urls
 
 uploadKey :: Key -> Annex Bool
 uploadKey _ = do
diff --git a/Utility.hs b/Utility.hs
index 451b1b44f..ce1736348 100644
--- a/Utility.hs
+++ b/Utility.hs
@@ -16,7 +16,9 @@ module Utility (
 	dirContents,
 	myHomeDir,
 	catchBool,
-	inPath
+	inPath,
+	firstM,
+	anyM
 ) where
 
 import IO (bracket)
@@ -29,6 +31,8 @@ import System.FilePath
 import System.Directory
 import Foreign (complement)
 import Utility.Path
+import Data.Maybe
+import Control.Monad (liftM)
 
 {- A version of hgetContents that is not lazy. Ensures file is 
  - all read before it gets closed. -}
@@ -96,11 +100,23 @@ myHomeDir = do
 catchBool :: IO Bool -> IO Bool
 catchBool = flip catch (const $ return False)
 
+{- Return the first value from a list, if any, satisfying the given
+ - predicate -}
+firstM :: (Monad m) => (a -> m Bool) -> [a] -> m (Maybe a)
+firstM _ [] = return Nothing
+firstM p (x:xs) = do
+	q <- p x
+	if q
+		then return (Just x)
+		else firstM p xs
+
+{- Returns true if any value in the list satisfies the preducate,
+ - stopping once one is found. -}
+anyM :: (Monad m) => (a -> m Bool) -> [a] -> m Bool
+anyM p = liftM isJust . firstM p
+
 {- Checks if a command is available in PATH. -}
 inPath :: String -> IO Bool
-inPath command = search =<< getSearchPath
+inPath command = getSearchPath >>= anyM indir
 	where
-		search [] = return False
-		search (d:ds) = do
-			e <- doesFileExist $ d </> command
-			if e then return True else search ds
+		indir d = doesFileExist $ d </> command
-- 
cgit v1.2.3