summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2011-08-28 15:46:49 -0400
committerGravatar Joey Hess <joey@kitenet.net>2011-08-28 15:46:49 -0400
commit999d5df90b013a7cc8a390c940785118400faf8a (patch)
tree82b9e2ab8c00e32f88c5878b06b1301413b51e53
parentb26ee162f33858aa4ef82fbe3d56eecc00590755 (diff)
factor out firstM and anyM
Control.Monad.Loops has these, but has no Debian package yet.
-rw-r--r--Remote/Web.hs7
-rw-r--r--Utility.hs28
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