diff --git a/src/Applicative.hs b/src/Applicative.hs index fe2cbed97..063ba4abc 100644 --- a/src/Applicative.hs +++ b/src/Applicative.hs @@ -5,9 +5,16 @@ module Applicative ( orAlt, orEmpty, eitherA, + guarded, + guardedA, + purer, + liftAA2, + (<<*>>), ) where -import Data.Bool (Bool) +import Data.Bool (Bool, bool) +import Data.Function ((.)) +import Data.Functor (Functor) import Data.Either (Either(..)) import Data.Monoid (Monoid(..)) import Control.Applicative @@ -20,3 +27,19 @@ orEmpty b a = if b then pure a else empty eitherA :: (Alternative f) => f a -> f b -> f (Either a b) eitherA a b = (Left <$> a) <|> (Right <$> b) + +guarded :: (Alternative f) => (a -> Bool) -> a -> f a +guarded p x = bool empty (pure x) (p x) + +guardedA :: (Functor f, Alternative t) => (a -> f Bool) -> a -> f (t a) +guardedA p x = bool empty (pure x) <$> p x + +purer :: (Applicative f, Applicative g) => a -> f (g a) +purer = pure . pure + +liftAA2 :: (Applicative f, Applicative g) => (a -> b -> c) -> f (g a) -> f (g b) -> f (g c) +liftAA2 = liftA2 . liftA2 + +(<<*>>) :: (Applicative f, Applicative g) => f (g (a -> b)) -> f (g a) -> f (g b) +(<<*>>) = liftA2 (<*>) + diff --git a/src/Functor.hs b/src/Functor.hs index 87d6bf349..03bbf01fe 100644 --- a/src/Functor.hs +++ b/src/Functor.hs @@ -29,6 +29,9 @@ infixl 4 $> ($>) :: Functor f => f a -> b -> f b ($>) = flip (<$) +(<<$>>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b) +(<<$>>) = fmap . fmap + void :: Functor f => f a -> f () void x = () <$ x #endif