factor out firstM and anyM
Control.Monad.Loops has these, but has no Debian package yet.
This commit is contained in:
parent
b26ee162f3
commit
999d5df90b
2 changed files with 24 additions and 11 deletions
|
@ -24,6 +24,7 @@ import Config
|
||||||
import PresenceLog
|
import PresenceLog
|
||||||
import LocationLog
|
import LocationLog
|
||||||
import Locations
|
import Locations
|
||||||
|
import Utility
|
||||||
import qualified Utility.Url as Url
|
import qualified Utility.Url as Url
|
||||||
|
|
||||||
type URLString = String
|
type URLString = String
|
||||||
|
@ -91,11 +92,7 @@ downloadKey key file = get =<< getUrls key
|
||||||
get [] = do
|
get [] = do
|
||||||
warning "no known url"
|
warning "no known url"
|
||||||
return False
|
return False
|
||||||
get a = iter a
|
get urls = anyM (`Url.download` file) urls
|
||||||
iter [] = return False
|
|
||||||
iter (url:urls) = do
|
|
||||||
ok <- Url.download url file
|
|
||||||
if ok then return ok else iter urls
|
|
||||||
|
|
||||||
uploadKey :: Key -> Annex Bool
|
uploadKey :: Key -> Annex Bool
|
||||||
uploadKey _ = do
|
uploadKey _ = do
|
||||||
|
|
28
Utility.hs
28
Utility.hs
|
@ -16,7 +16,9 @@ module Utility (
|
||||||
dirContents,
|
dirContents,
|
||||||
myHomeDir,
|
myHomeDir,
|
||||||
catchBool,
|
catchBool,
|
||||||
inPath
|
inPath,
|
||||||
|
firstM,
|
||||||
|
anyM
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import IO (bracket)
|
import IO (bracket)
|
||||||
|
@ -29,6 +31,8 @@ import System.FilePath
|
||||||
import System.Directory
|
import System.Directory
|
||||||
import Foreign (complement)
|
import Foreign (complement)
|
||||||
import Utility.Path
|
import Utility.Path
|
||||||
|
import Data.Maybe
|
||||||
|
import Control.Monad (liftM)
|
||||||
|
|
||||||
{- A version of hgetContents that is not lazy. Ensures file is
|
{- A version of hgetContents that is not lazy. Ensures file is
|
||||||
- all read before it gets closed. -}
|
- all read before it gets closed. -}
|
||||||
|
@ -96,11 +100,23 @@ myHomeDir = do
|
||||||
catchBool :: IO Bool -> IO Bool
|
catchBool :: IO Bool -> IO Bool
|
||||||
catchBool = flip catch (const $ return False)
|
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. -}
|
{- Checks if a command is available in PATH. -}
|
||||||
inPath :: String -> IO Bool
|
inPath :: String -> IO Bool
|
||||||
inPath command = search =<< getSearchPath
|
inPath command = getSearchPath >>= anyM indir
|
||||||
where
|
where
|
||||||
search [] = return False
|
indir d = doesFileExist $ d </> command
|
||||||
search (d:ds) = do
|
|
||||||
e <- doesFileExist $ d </> command
|
|
||||||
if e then return True else search ds
|
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue