{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-deprecations #-}

module Plutarch.Internal.Newtype {-# DEPRECATED "Use the new mechanism instead" #-} (PlutusTypeNewtype) where

import Data.Kind (Type)
import Generics.SOP qualified as SOP
import Plutarch.Internal.Generic (PCode, PGeneric, gpfrom, gpto)
import Plutarch.Internal.PlutusType (
  DerivedPInner,
  PlutusTypeStrat,
  PlutusTypeStratConstraint,
  derivedPCon,
  derivedPMatch,
 )
import Plutarch.Internal.Term (S)

data PlutusTypeNewtype

class (PGeneric a, PCode a ~ '[ '[GetPNewtype a]]) => Helper (a :: S -> Type)
instance (PGeneric a, PCode a ~ '[ '[GetPNewtype a]]) => Helper (a :: S -> Type)

instance PlutusTypeStrat PlutusTypeNewtype where
  type PlutusTypeStratConstraint PlutusTypeNewtype = Helper
  type DerivedPInner PlutusTypeNewtype a = GetPNewtype a
  derivedPCon :: forall (a :: S -> Type) (s :: S).
(DerivePlutusType a,
 (DPTStrat a :: Type) ~ (PlutusTypeNewtype :: Type)) =>
a s -> Term s (DerivedPInner PlutusTypeNewtype a)
derivedPCon a s
x = case a s
-> SOP
     @(S -> Type)
     (Term s)
     (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type])))
forall (a :: S -> Type) (s :: S).
PGeneric a =>
a s -> SOP @(S -> Type) (Term s) (PCode a)
gpfrom a s
x of
    SOP.SOP (SOP.Z (Term s x
x SOP.:* NP @(S -> Type) (Term s) xs
SOP.Nil)) -> Term s x
Term s (DerivedPInner PlutusTypeNewtype a)
x
    SOP.SOP (SOP.S NS @[S -> Type] (NP @(S -> Type) (Term s)) xs
x) -> case NS @[S -> Type] (NP @(S -> Type) (Term s)) xs
x of {}
  derivedPMatch :: forall (a :: S -> Type) (s :: S) (b :: S -> Type).
(DerivePlutusType a,
 (DPTStrat a :: Type) ~ (PlutusTypeNewtype :: Type)) =>
Term s (DerivedPInner PlutusTypeNewtype a)
-> (a s -> Term s b) -> Term s b
derivedPMatch Term s (DerivedPInner PlutusTypeNewtype a)
x a s -> Term s b
f = a s -> Term s b
f (SOP
  @(S -> Type)
  (Term s)
  (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type])))
-> a s
forall (a :: S -> Type) (s :: S).
PGeneric a =>
SOP @(S -> Type) (Term s) (PCode a) -> a s
gpto (SOP
   @(S -> Type)
   (Term s)
   (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type])))
 -> a s)
-> SOP
     @(S -> Type)
     (Term s)
     (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type])))
-> a s
forall a b. (a -> b) -> a -> b
$ NS
  @[S -> Type]
  (NP @(S -> Type) (Term s))
  (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type])))
-> SOP
     @(S -> Type)
     (Term s)
     (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type])))
forall k (f :: k -> Type) (xss :: [[k]]).
NS @[k] (NP @k f) xss -> SOP @k f xss
SOP.SOP (NS
   @[S -> Type]
   (NP @(S -> Type) (Term s))
   (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type])))
 -> SOP
      @(S -> Type)
      (Term s)
      (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type]))))
-> NS
     @[S -> Type]
     (NP @(S -> Type) (Term s))
     (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type])))
-> SOP
     @(S -> Type)
     (Term s)
     (ToPType2 (ToSumCode (Rep (a (Any @S))) ('[] @[Type])))
forall a b. (a -> b) -> a -> b
$ NP
  @(S -> Type)
  (Term s)
  ((':) @(S -> Type) (PInner a) ('[] @(S -> Type)))
-> NS
     @[S -> Type]
     (NP @(S -> Type) (Term s))
     ((':)
        @[S -> Type]
        ((':) @(S -> Type) (PInner a) ('[] @(S -> Type)))
        ('[] @[S -> Type]))
forall {k} (a :: k -> Type) (x :: k) (xs :: [k]).
a x -> NS @k a ((':) @k x xs)
SOP.Z (NP
   @(S -> Type)
   (Term s)
   ((':) @(S -> Type) (PInner a) ('[] @(S -> Type)))
 -> NS
      @[S -> Type]
      (NP @(S -> Type) (Term s))
      ((':)
         @[S -> Type]
         ((':) @(S -> Type) (PInner a) ('[] @(S -> Type)))
         ('[] @[S -> Type])))
-> NP
     @(S -> Type)
     (Term s)
     ((':) @(S -> Type) (PInner a) ('[] @(S -> Type)))
-> NS
     @[S -> Type]
     (NP @(S -> Type) (Term s))
     ((':)
        @[S -> Type]
        ((':) @(S -> Type) (PInner a) ('[] @(S -> Type)))
        ('[] @[S -> Type]))
forall a b. (a -> b) -> a -> b
$ Term s (DerivedPInner PlutusTypeNewtype a)
x Term s (DerivedPInner PlutusTypeNewtype a)
-> NP @(S -> Type) (Term s) ('[] @(S -> Type))
-> NP
     @(S -> Type)
     (Term s)
     ((':)
        @(S -> Type)
        (DerivedPInner PlutusTypeNewtype a)
        ('[] @(S -> Type)))
forall {k} (a :: k -> Type) (x :: k) (xs :: [k]).
a x -> NP @k a xs -> NP @k a ((':) @k x xs)
SOP.:* NP @(S -> Type) (Term s) ('[] @(S -> Type))
forall {k} (a :: k -> Type). NP @k a ('[] @k)
SOP.Nil)

type family GetPNewtype' (a :: [[S -> Type]]) :: S -> Type where
  GetPNewtype' '[ '[a]] = a

type family GetPNewtype (a :: S -> Type) :: S -> Type where
  GetPNewtype a = GetPNewtype' (PCode a)