{-# 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)

{- HLINT ignore -}

infixl 4 <*>, <*, *>

-- | Plutus Tx version of 'Control.Applicative.Applicative'.
class (Functor f) => Applicative f where
  {-# MINIMAL pure, (<*>) #-}

  -- | Plutus Tx version of 'Control.Applicative.pure'.
  pure :: a -> f a

  -- | Plutus Tx version of '(Control.Applicative.<*>)'.
  (<*>) :: f (a -> b) -> f a -> f b

-- | Plutus Tx version of 'Control.Applicative.liftA2'.
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 #-}

-- | Plutus Tx version of '(Control.Applicative.*>)'.
(*>) :: (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 (*>) #-}

-- | Plutus Tx version of '(Control.Applicative.<*)'.
(<*) :: (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 (<*) #-}

-- | Plutus Tx version of 'Control.Monad.unless'.
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)