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 start format file (key, _) = do
-- only files inAnnex are shown, unless the user has requested -- only files inAnnex are shown, unless the user has requested
-- others via a limit -- others via a limit
whenM (liftM2 (||) limited (inAnnex key)) $ whenM (orM limited (inAnnex key)) $
unlessM (showFullJSON vars) $ unlessM (showFullJSON vars) $
case format of case format of
Nothing -> liftIO $ putStrLn file Nothing -> liftIO $ putStrLn file

View file

@ -25,7 +25,7 @@ module Utility.Matcher (
matchesAny matchesAny
) where ) where
import Control.Monad import Common
{- A Token can be an Operation of an arbitrary type, or one of a few {- A Token can be an Operation of an arbitrary type, or one of a few
- predefined peices of syntax. -} - predefined peices of syntax. -}
@ -87,8 +87,8 @@ matchM :: Monad m => Matcher (v -> m Bool) -> v -> m Bool
matchM m v = go m matchM m v = go m
where where
go MAny = return True go MAny = return True
go (MAnd m1 m2) = liftM2 (&&) (go m1) (go m2) go (MAnd m1 m2) = andM (go m1) (go m2)
go (MOr m1 m2) = liftM2 (||) (go m1) (go m2) go (MOr m1 m2) = orM (go m1) (go m2)
go (MNot m1) = liftM not (go m1) go (MNot m1) = liftM not (go m1)
go (MOp o) = o v go (MOp o) = o v

View file

@ -8,7 +8,7 @@
module Utility.Monad where module Utility.Monad where
import Data.Maybe import Data.Maybe
import Control.Monad (liftM) import Control.Monad (liftM, liftM2)
{- Return the first value from a list, if any, satisfying the given {- Return the first value from a list, if any, satisfying the given
- predicate -} - predicate -}
@ -31,6 +31,16 @@ ifM cond (thenclause, elseclause) = do
c <- cond c <- cond
if c then thenclause else elseclause 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. -} {- Runs an action, passing its value to an observer before returning it. -}
observe :: Monad m => (a -> m b) -> m a -> m a observe :: Monad m => (a -> m b) -> m a -> m a
observe observer a = do observe observer a = do

View file

@ -9,7 +9,6 @@ module Utility.Url (
URLString, URLString,
check, check,
exists, exists,
canDownload,
download, download,
get get
) where ) where
@ -44,9 +43,6 @@ exists url =
where where
size = liftM Prelude.read . lookupHeader HdrContentLength . rspHeaders 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. {- 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, - Uses wget or curl program for its progress bar. (Wget has a better one,