factor out firstM and anyM

Control.Monad.Loops has these, but has no Debian package yet.
This commit is contained in:
Joey Hess 2011-08-28 15:46:49 -04:00
parent b26ee162f3
commit 999d5df90b
2 changed files with 24 additions and 11 deletions

View file

@ -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

View file

@ -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