module Plutarch.Extra.Identity (
  PIdentity (..),
) where

import Plutarch.Extra.Applicative (PApplicative (ppure), PApply (pliftA2))
import Plutarch.Extra.Bind (PBind ((#>>=)))
import Plutarch.Extra.Boring (PBoring (pboring))
import Plutarch.Extra.Comonad (
  PComonad (pextract),
  PExtend (pextend),
 )
import Plutarch.Extra.Functor (PFunctor (PSubcategory, pfmap), Plut)
import Plutarch.Extra.TermCont (pmatchC)
import Plutarch.Num (PNum)

{- | Just a value of type @a@.

 @since 1.0.0
-}
newtype PIdentity (a :: S -> Type) (s :: S)
  = PIdentity (Term s a)
  deriving stock
    ( -- | @since 1.0.0
      forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: PType) (s :: S) x.
Rep (PIdentity a s) x -> PIdentity a s
forall (a :: PType) (s :: S) x.
PIdentity a s -> Rep (PIdentity a s) x
$cto :: forall (a :: PType) (s :: S) x.
Rep (PIdentity a s) x -> PIdentity a s
$cfrom :: forall (a :: PType) (s :: S) x.
PIdentity a s -> Rep (PIdentity a s) x
Generic
    )
  deriving anyclass
    ( -- | @since 1.0.0
      forall (a :: PType).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: PType).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
forall (a :: PType) (s :: S).
PIdentity a s -> Term s (PInner (PIdentity a))
forall (a :: PType) (s :: S) (b :: PType).
Term s (PInner (PIdentity a))
-> (PIdentity a s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: PType).
Term s (PInner (PIdentity a))
-> (PIdentity a s -> Term s b) -> Term s b
$cpmatch' :: forall (a :: PType) (s :: S) (b :: PType).
Term s (PInner (PIdentity a))
-> (PIdentity a s -> Term s b) -> Term s b
pcon' :: forall (s :: S). PIdentity a s -> Term s (PInner (PIdentity a))
$cpcon' :: forall (a :: PType) (s :: S).
PIdentity a s -> Term s (PInner (PIdentity a))
PlutusType
    )

-- | @since 1.4.0
instance DerivePlutusType (PIdentity a) where
  type DPTStrat _ = PlutusTypeNewtype

-- | @since 1.0.0
deriving anyclass instance (PIsData a) => (PIsData (PIdentity a))

-- | @since 1.0.0
deriving anyclass instance (PEq a) => PEq (PIdentity a)

-- | @since 1.4.0
deriving anyclass instance (POrd a) => PPartialOrd (PIdentity a)

-- | @since 1.0.0
deriving anyclass instance (POrd a) => POrd (PIdentity a)

-- | @since 1.0.0
deriving anyclass instance (PIntegral a) => PIntegral (PIdentity a)

-- | @since 1.4.0
deriving anyclass instance (PNum a) => PNum (PIdentity a)

-- | @since 1.0.0
deriving anyclass instance (PShow a) => PShow (PIdentity a)

-- | @since 3.1.0
instance PFunctor PIdentity where
  type PSubcategory PIdentity = Plut
  pfmap :: forall (a :: PType) (b :: PType) (s :: S).
(PSubcategory PIdentity a, PSubcategory PIdentity b) =>
Term s ((a :--> b) :--> (PIdentity a :--> PIdentity b))
pfmap = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
    forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (a :--> b)
f Term s (PIdentity a)
t -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
      PIdentity Term s a
t' <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC Term s (PIdentity a)
t
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: PType) (s :: S). Term s a -> PIdentity a s
PIdentity forall a b. (a -> b) -> a -> b
$ Term s (a :--> b)
f forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s a
t'

-- | @since 1.0.0
instance PExtend PIdentity where
  pextend :: forall (a :: PType) (b :: PType) (s :: S).
(PSubcategory PIdentity a, PSubcategory PIdentity b) =>
Term s ((PIdentity a :--> b) :--> (PIdentity a :--> PIdentity b))
pextend = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PIdentity a :--> b)
f Term s (PIdentity a)
t -> forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: PType) (s :: S). Term s a -> PIdentity a s
PIdentity forall a b. (a -> b) -> a -> b
$ Term s (PIdentity a :--> b)
f forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s (PIdentity a)
t

-- | @since 1.0.0
instance PComonad PIdentity where
  pextract :: forall (a :: PType) (s :: S).
PSubcategory PIdentity a =>
Term s (PIdentity a :--> a)
pextract = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
    forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (PIdentity a)
t -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
      PIdentity Term s a
t' <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC Term s (PIdentity a)
t
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure Term s a
t'

-- | @since 1.0.0
instance PApply PIdentity where
  pliftA2 :: forall (a :: PType) (b :: PType) (c :: PType) (s :: S).
(PSubcategory PIdentity a, PSubcategory PIdentity b,
 PSubcategory PIdentity c) =>
Term
  s
  ((a :--> (b :--> c))
   :--> (PIdentity a :--> (PIdentity b :--> PIdentity c)))
pliftA2 = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$
    forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ \Term s (a :--> (b :--> c))
f Term s (PIdentity a)
xs Term s (PIdentity b)
ys -> forall (a :: PType) (s :: S). TermCont s (Term s a) -> Term s a
unTermCont forall a b. (a -> b) -> a -> b
$ do
      PIdentity Term s a
tx <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC Term s (PIdentity a)
xs
      PIdentity Term s b
ty <- forall {r :: PType} (a :: PType) (s :: S).
PlutusType a =>
Term s a -> TermCont s (a s)
pmatchC Term s (PIdentity b)
ys
      forall (f :: Type -> Type) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: PType) (s :: S). Term s a -> PIdentity a s
PIdentity forall a b. (a -> b) -> a -> b
$ Term s (a :--> (b :--> c))
f forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s a
tx forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s b
ty

-- | @since 1.0.0
instance PApplicative PIdentity where
  ppure :: forall (a :: PType) (s :: S).
PSubcategory PIdentity a =>
Term s (a :--> PIdentity a)
ppure = forall (a :: PType) (s :: S).
HasCallStack =>
ClosedTerm a -> Term s a
phoistAcyclic forall a b. (a -> b) -> a -> b
$ forall a (b :: PType) (s :: S) (c :: PType).
(PLamN a b s, HasCallStack) =>
(Term s c -> a) -> Term s (c :--> b)
plam forall a b. (a -> b) -> a -> b
$ forall (a :: PType) (s :: S). PlutusType a => a s -> Term s a
pcon forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: PType) (s :: S). Term s a -> PIdentity a s
PIdentity

-- | @since 1.2.0
instance (PBoring a) => PBoring (PIdentity a) where
  pboring :: forall (s :: S). Term s (PIdentity a)
pboring = forall (f :: PType -> PType) (a :: PType) (s :: S).
(PApplicative f, PSubcategory f a) =>
Term s (a :--> f a)
ppure forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# forall (a :: PType) (s :: S). PBoring a => Term s a
pboring

-- | @since 3.0.1
instance PBind PIdentity where
  {-# INLINEABLE (#>>=) #-}
  Term s (PIdentity a)
xs #>>= :: forall (a :: PType) (b :: PType) (s :: S).
(PSubcategory PIdentity a, PSubcategory PIdentity b) =>
Term s (PIdentity a)
-> Term s (a :--> PIdentity b) -> Term s (PIdentity b)
#>>= Term s (a :--> PIdentity b)
f = forall (a :: PType) (s :: S) (b :: PType).
PlutusType a =>
Term s a -> (a s -> Term s b) -> Term s b
pmatch Term s (PIdentity a)
xs forall a b. (a -> b) -> a -> b
$ \case
    PIdentity Term s a
x -> Term s (a :--> PIdentity b)
f forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s a
x