optimize monadic ||

(||) used applicative style runs both conditions rather than short
circuiting. Add an orM that properly short-circuits.

4 files changed, 15 insertions, 9 deletions

diff --git a/Command/Find.hs b/Command/Find.hs
index 33f512e39..f5bd2734b 100644
--- a/Command/Find.hs
+++ b/Command/Find.hs
@@ -42,7 +42,7 @@ start :: Maybe Utility.Format.Format -> FilePath -> (Key, Backend) -> CommandSta
 start format file (key, _) = do
 	-- only files inAnnex are shown, unless the user has requested
 	-- others via a limit
-	whenM (liftM2 (||) limited (inAnnex key)) $
+	whenM (orM limited (inAnnex key)) $
 		unlessM (showFullJSON vars) $
 			case format of
 				Nothing -> liftIO $ putStrLn file
diff --git a/Utility/Matcher.hs b/Utility/Matcher.hs
index 01500a211..71e1e17f4 100644
--- a/Utility/Matcher.hs
+++ b/Utility/Matcher.hs
@@ -25,7 +25,7 @@ module Utility.Matcher (
 	matchesAny
 ) where
 
-import Control.Monad
+import Common
 
 {- A Token can be an Operation of an arbitrary type, or one of a few
  - predefined peices of syntax. -}
@@ -87,8 +87,8 @@ matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool
 matchM m v = go m
 	where
 		go MAny = return True
-		go (MAnd m1 m2) = liftM2 (&&) (go m1) (go m2)
-		go (MOr m1 m2) =  liftM2 (||) (go m1) (go m2)
+		go (MAnd m1 m2) = andM (go m1) (go m2)
+		go (MOr m1 m2) =  orM  (go m1) (go m2)
 		go (MNot m1) = liftM not (go m1)
 		go (MOp o) = o v
 
diff --git a/Utility/Monad.hs b/Utility/Monad.hs
index 23c0c4c19..5cc243290 100644
--- a/Utility/Monad.hs
+++ b/Utility/Monad.hs
@@ -8,7 +8,7 @@
 module Utility.Monad where
 
 import Data.Maybe
-import Control.Monad (liftM)
+import Control.Monad (liftM, liftM2)
 
 {- Return the first value from a list, if any, satisfying the given
  - predicate -}
@@ -31,6 +31,16 @@ ifM cond (thenclause, elseclause) = do
 	c <- cond
 	if c then thenclause else elseclause
 
+{- monadic ||
+ -
+ - Compare with (||) <$> ma <*> mb, which always runs both ma and mb. -}
+orM :: Monad m => m Bool -> m Bool -> m Bool
+orM ma mb = ifM ma ( return True , mb )
+
+{- monadic &&  (for completeness) -}
+andM :: Monad m => m Bool -> m Bool -> m Bool
+andM  = liftM2 (&&)
+
 {- Runs an action, passing its value to an observer before returning it. -}
 observe :: Monad m => (a -> m b) -> m a -> m a
 observe observer a = do
diff --git a/Utility/Url.hs b/Utility/Url.hs
index 8a8d732a3..86d66d83b 100644
--- a/Utility/Url.hs
+++ b/Utility/Url.hs
@@ -9,7 +9,6 @@ module Utility.Url (
 	URLString,
 	check,
 	exists,
-	canDownload,
 	download,
 	get
 ) where
@@ -44,9 +43,6 @@ exists url =
 	where
 		size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders
 
-canDownload :: IO Bool
-canDownload = (||) <$> inPath "wget" <*> inPath "curl"
-
 {- Used to download large files, such as the contents of keys.
  -
  - Uses wget or curl program for its progress bar. (Wget has a better one,