optimize monadic ||

(||) used applicative style runs both conditions rather than short
circuiting. Add an orM that properly short-circuits.
This commit is contained in:
Joey Hess 2012-03-16 12:28:17 -04:00
parent b06336fa3a
commit 771052a85e
4 changed files with 15 additions and 9 deletions

View file

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

View file

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

View file

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

View file

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