{-# LANGUAGE InstanceSigs #-}
module PlutusTx.Applicative where
import Control.Applicative (Const (..))
import Data.Coerce (coerce)
import Data.Functor.Identity (Identity (..))
import PlutusTx.Base
import PlutusTx.Bool (Bool)
import PlutusTx.Either (Either (..))
import PlutusTx.Functor
import PlutusTx.List qualified as List
import PlutusTx.Maybe (Maybe (..))
import PlutusTx.Monoid (Monoid (..), mappend)
infixl 4 <*>, <*, *>
class (Functor f) => Applicative f where
{-# MINIMAL pure, (<*>) #-}
pure :: a -> f a
(<*>) :: f (a -> b) -> f a -> f b
liftA2 :: (Applicative f) => (a -> b -> c) -> f a -> f b -> f c
liftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> c
f f a
x = f (b -> c) -> f b -> f c
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>) ((a -> b -> c) -> f a -> f (b -> c)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b -> c
f f a
x)
{-# INLINEABLE liftA2 #-}
(*>) :: (Applicative f) => f a -> f b -> f b
f a
a1 *> :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> f b
a2 = (b -> b
forall a. a -> a
id (b -> b) -> f a -> f (b -> b)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ f a
a1) f (b -> b) -> f b -> f b
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f b
a2
{-# INLINEABLE (*>) #-}
(<*) :: (Applicative f) => f a -> f b -> f a
<* :: forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
(<*) = (a -> b -> a) -> f a -> f b -> f a
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 a -> b -> a
forall a b. a -> b -> a
const
{-# INLINEABLE (<*) #-}
unless :: (Applicative f) => Bool -> f () -> f ()
unless :: forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
p f ()
s = if Bool
p then () -> f ()
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () else f ()
s
{-# INLINEABLE unless #-}
instance Applicative Maybe where
{-# INLINEABLE pure #-}
pure :: forall a. a -> Maybe a
pure = a -> Maybe a
forall a. a -> Maybe a
Just
{-# INLINEABLE (<*>) #-}
Maybe (a -> b)
Nothing <*> :: forall a b. Maybe (a -> b) -> Maybe a -> Maybe b
<*> Maybe a
_ = Maybe b
forall a. Maybe a
Nothing
Maybe (a -> b)
_ <*> Maybe a
Nothing = Maybe b
forall a. Maybe a
Nothing
Just a -> b
f <*> Just a
x = b -> Maybe b
forall a. a -> Maybe a
Just (a -> b
f a
x)
instance Applicative (Either a) where
{-# INLINEABLE pure #-}
pure :: forall a. a -> Either a a
pure = a -> Either a a
forall a a. a -> Either a a
Right
{-# INLINEABLE (<*>) #-}
Left a
e <*> :: forall a b. Either a (a -> b) -> Either a a -> Either a b
<*> Either a a
_ = a -> Either a b
forall a b. a -> Either a b
Left a
e
Right a -> b
f <*> Either a a
r = (a -> b) -> Either a a -> Either a b
forall a b. (a -> b) -> Either a a -> Either a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Either a a
r
instance Applicative [] where
{-# INLINEABLE pure #-}
pure :: forall a. a -> [a]
pure a
x = [a
x]
{-# INLINEABLE (<*>) #-}
[a -> b]
fs <*> :: forall a b. [a -> b] -> [a] -> [b]
<*> [a]
xs = ((a -> b) -> [b]) -> [a -> b] -> [b]
forall a b. (a -> [b]) -> [a] -> [b]
List.concatMap (\a -> b
f -> (a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
List.map a -> b
f [a]
xs) [a -> b]
fs
instance Applicative Identity where
{-# INLINEABLE pure #-}
pure :: forall a. a -> Identity a
pure = a -> Identity a
forall a. a -> Identity a
Identity
{-# INLINEABLE (<*>) #-}
(<*>) :: forall a b. Identity (a -> b) -> Identity a -> Identity b
<*> :: forall a b. Identity (a -> b) -> Identity a -> Identity b
(<*>) = ((a -> b) -> a -> b)
-> Identity (a -> b) -> Identity a -> Identity b
forall a b. Coercible a b => a -> b
coerce ((a -> b) -> a -> b
forall a. a -> a
id :: (a -> b) -> a -> b)
instance (Monoid m) => Applicative (Const m) where
{-# INLINEABLE pure #-}
pure :: forall a. a -> Const m a
pure a
_ = m -> Const m a
forall {k} a (b :: k). a -> Const a b
Const m
forall a. Monoid a => a
mempty
{-# INLINEABLE (<*>) #-}
<*> :: forall a b. Const m (a -> b) -> Const m a -> Const m b
(<*>) = (m -> m -> m) -> Const m (a -> b) -> Const m a -> Const m b
forall a b. Coercible a b => a -> b
coerce (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend :: m -> m -> m)