module Agda.Utils.Applicative
       ( (?*>)
       , (?$>)
       , foldA
       , foldMapA
       , forA
       )
       where

import Control.Applicative
import Data.Monoid ( Alt(..) )
import Data.Traversable ( for )

-- | Better name for 'for'.
forA :: (Traversable t, Applicative f) => t a -> (a -> f b) -> f (t b)
forA :: forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
forA = t a -> (a -> f b) -> f (t b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for

-- | Guard: return the action @f@ only if the boolean is @True@
(?*>) :: Alternative f => Bool -> f a -> f a
Bool
b ?*> :: forall (f :: * -> *) a. Alternative f => Bool -> f a -> f a
?*> f a
f = if Bool
b then f a
f else f a
forall (f :: * -> *) a. Alternative f => f a
empty

-- | Guard: return the value @a@ only if the boolean is @True@
(?$>) :: Alternative f => Bool -> a -> f a
Bool
b ?$> :: forall (f :: * -> *) a. Alternative f => Bool -> a -> f a
?$> a
a = Bool
b Bool -> f a -> f a
forall (f :: * -> *) a. Alternative f => Bool -> f a -> f a
?*> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a

-- | Branch over a 'Foldable' collection of values.
foldA :: (Alternative f, Foldable t) => t a -> f a
foldA :: forall (f :: * -> *) (t :: * -> *) a.
(Alternative f, Foldable t) =>
t a -> f a
foldA = (a -> f a) -> t a -> f a
forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
foldMapA a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Branch over a 'Foldable' collection of values using the supplied
--   action.
foldMapA :: (Alternative f, Foldable t) => (a -> f b) -> t a -> f b
foldMapA :: forall (f :: * -> *) (t :: * -> *) a b.
(Alternative f, Foldable t) =>
(a -> f b) -> t a -> f b
foldMapA a -> f b
f = Alt f b -> f b
forall {k} (f :: k -> *) (a :: k). Alt f a -> f a
getAlt (Alt f b -> f b) -> (t a -> Alt f b) -> t a -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Alt f b) -> t a -> Alt f b
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (f b -> Alt f b
forall {k} (f :: k -> *) (a :: k). f a -> Alt f a
Alt (f b -> Alt f b) -> (a -> f b) -> a -> Alt f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> f b
f)