{-# 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)
{-# INLINABLE 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
{-# INLINABLE (*>) #-}

-- | 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
{-# INLINABLE (<*) #-}

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