{-# 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)
{-# INLINABLE 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
{-# INLINABLE (*>) #-}
(<*) :: 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
{-# INLINABLE (<*) #-}
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
{-# INLINABLE unless #-}
instance Applicative Maybe where
{-# INLINABLE pure #-}
pure :: forall a. a -> Maybe a
pure = a -> Maybe a
forall a. a -> Maybe a
Just
{-# INLINABLE (<*>) #-}
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
{-# INLINABLE pure #-}
pure :: forall a. a -> Either a a
pure = a -> Either a a
forall a a. a -> Either a a
Right
{-# INLINABLE (<*>) #-}
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
{-# INLINABLE pure #-}
pure :: forall a. a -> [a]
pure a
x = [a
x]
{-# INLINABLE (<*>) #-}
[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
{-# INLINABLE pure #-}
pure :: forall a. a -> Identity a
pure = a -> Identity a
forall a. a -> Identity a
Identity
{-# INLINABLE (<*>) #-}
(<*>) :: 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
{-# INLINABLE 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
{-# INLINABLE (<*>) #-}
<*> :: 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)