{-# LANGUAGE UndecidableInstances #-}

module Plutarch.Repr.Derive (DerivePLiftableAsRepr (DerivePLiftableAsRepr)) where

import Data.Kind (Type)
import GHC.Exts (Any)
import GHC.Generics (Generic)
import Generics.SOP (Code, SOP)
import Generics.SOP qualified as SOP
import Plutarch.Internal.Lift (
  AsHaskell,
  LiftError,
  PLiftable,
  PlutusRepr,
  haskToRepr,
  plutToRepr,
  punsafeCoercePLifted,
  reprToHask,
  reprToPlut,
 )
import Plutarch.Internal.PlutusType (DeriveFakePlutusType (DeriveFakePlutusType), PInner, PlutusType)
import Plutarch.Internal.Term (S)
import Plutarch.Repr.Internal (StructAsHaskell, UnTermStruct')

{- |
This is @PLiftable@ derivation helper for user-defined datatypes like Data/SOP encoded types.
Please consult example below.

@@
data PBobData (a :: S -> Type) (s :: S)
  = PBobData (Term s (PAsData a)) (Term s (PAsData PBool))
  deriving stock (Generic)
  deriving anyclass (SOP.Generic)
  deriving PlutusType via (DeriveAsDataRec (PBobData a)) -- SOP encoding works as well.

deriving via
  DerivePLiftableAsRepr (PBobData a) (Bob (AsHaskell a))
  instance
    PLiftable (PAsData a) => PLiftable (PBobData a)
@@

 @since WIP
-}
newtype DerivePLiftableAsRepr (wrapper :: S -> Type) (h :: Type) (s :: S)
  = DerivePLiftableAsRepr (wrapper s)
  deriving stock ((forall x.
 DerivePLiftableAsRepr wrapper h s
 -> Rep (DerivePLiftableAsRepr wrapper h s) x)
-> (forall x.
    Rep (DerivePLiftableAsRepr wrapper h s) x
    -> DerivePLiftableAsRepr wrapper h s)
-> Generic (DerivePLiftableAsRepr wrapper h s)
forall x.
Rep (DerivePLiftableAsRepr wrapper h s) x
-> DerivePLiftableAsRepr wrapper h s
forall x.
DerivePLiftableAsRepr wrapper h s
-> Rep (DerivePLiftableAsRepr wrapper h s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (wrapper :: S -> Type) h (s :: S) x.
Rep (DerivePLiftableAsRepr wrapper h s) x
-> DerivePLiftableAsRepr wrapper h s
forall (wrapper :: S -> Type) h (s :: S) x.
DerivePLiftableAsRepr wrapper h s
-> Rep (DerivePLiftableAsRepr wrapper h s) x
$cfrom :: forall (wrapper :: S -> Type) h (s :: S) x.
DerivePLiftableAsRepr wrapper h s
-> Rep (DerivePLiftableAsRepr wrapper h s) x
from :: forall x.
DerivePLiftableAsRepr wrapper h s
-> Rep (DerivePLiftableAsRepr wrapper h s) x
$cto :: forall (wrapper :: S -> Type) h (s :: S) x.
Rep (DerivePLiftableAsRepr wrapper h s) x
-> DerivePLiftableAsRepr wrapper h s
to :: forall x.
Rep (DerivePLiftableAsRepr wrapper h s) x
-> DerivePLiftableAsRepr wrapper h s
Generic)
  deriving anyclass (All
  @[Type] (SListI @Type) (Code (DerivePLiftableAsRepr wrapper h s))
All
  @[Type]
  (SListI @Type)
  (Code (DerivePLiftableAsRepr wrapper h s)) =>
(DerivePLiftableAsRepr wrapper h s
 -> Rep (DerivePLiftableAsRepr wrapper h s))
-> (Rep (DerivePLiftableAsRepr wrapper h s)
    -> DerivePLiftableAsRepr wrapper h s)
-> Generic (DerivePLiftableAsRepr wrapper h s)
Rep (DerivePLiftableAsRepr wrapper h s)
-> DerivePLiftableAsRepr wrapper h s
DerivePLiftableAsRepr wrapper h s
-> Rep (DerivePLiftableAsRepr wrapper h s)
forall a.
All @[Type] (SListI @Type) (Code a) =>
(a -> Rep a) -> (Rep a -> a) -> Generic a
forall (wrapper :: S -> Type) h (s :: S).
All
  @[Type] (SListI @Type) (Code (DerivePLiftableAsRepr wrapper h s))
forall (wrapper :: S -> Type) h (s :: S).
Rep (DerivePLiftableAsRepr wrapper h s)
-> DerivePLiftableAsRepr wrapper h s
forall (wrapper :: S -> Type) h (s :: S).
DerivePLiftableAsRepr wrapper h s
-> Rep (DerivePLiftableAsRepr wrapper h s)
$cfrom :: forall (wrapper :: S -> Type) h (s :: S).
DerivePLiftableAsRepr wrapper h s
-> Rep (DerivePLiftableAsRepr wrapper h s)
from :: DerivePLiftableAsRepr wrapper h s
-> Rep (DerivePLiftableAsRepr wrapper h s)
$cto :: forall (wrapper :: S -> Type) h (s :: S).
Rep (DerivePLiftableAsRepr wrapper h s)
-> DerivePLiftableAsRepr wrapper h s
to :: Rep (DerivePLiftableAsRepr wrapper h s)
-> DerivePLiftableAsRepr wrapper h s
SOP.Generic)
  deriving ((forall (s :: S).
 DerivePLiftableAsRepr wrapper h s
 -> Term s (PInner (DerivePLiftableAsRepr wrapper h)))
-> (forall (s :: S) (b :: S -> Type).
    Term s (PInner (DerivePLiftableAsRepr wrapper h))
    -> (DerivePLiftableAsRepr wrapper h s -> Term s b) -> Term s b)
-> PlutusType (DerivePLiftableAsRepr wrapper h)
forall (s :: S).
DerivePLiftableAsRepr wrapper h s
-> Term s (PInner (DerivePLiftableAsRepr wrapper h))
forall (s :: S) (b :: S -> Type).
Term s (PInner (DerivePLiftableAsRepr wrapper h))
-> (DerivePLiftableAsRepr wrapper h s -> Term s b) -> Term s b
forall (a :: S -> Type).
(forall (s :: S). a s -> Term s (PInner a))
-> (forall (s :: S) (b :: S -> Type).
    Term s (PInner a) -> (a s -> Term s b) -> Term s b)
-> PlutusType a
forall (wrapper :: S -> Type) h (s :: S).
DerivePLiftableAsRepr wrapper h s
-> Term s (PInner (DerivePLiftableAsRepr wrapper h))
forall (wrapper :: S -> Type) h (s :: S) (b :: S -> Type).
Term s (PInner (DerivePLiftableAsRepr wrapper h))
-> (DerivePLiftableAsRepr wrapper h s -> Term s b) -> Term s b
$cpcon' :: forall (wrapper :: S -> Type) h (s :: S).
DerivePLiftableAsRepr wrapper h s
-> Term s (PInner (DerivePLiftableAsRepr wrapper h))
pcon' :: forall (s :: S).
DerivePLiftableAsRepr wrapper h s
-> Term s (PInner (DerivePLiftableAsRepr wrapper h))
$cpmatch' :: forall (wrapper :: S -> Type) h (s :: S) (b :: S -> Type).
Term s (PInner (DerivePLiftableAsRepr wrapper h))
-> (DerivePLiftableAsRepr wrapper h s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: S -> Type).
Term s (PInner (DerivePLiftableAsRepr wrapper h))
-> (DerivePLiftableAsRepr wrapper h s -> Term s b) -> Term s b
PlutusType) via (DeriveFakePlutusType (DerivePLiftableAsRepr wrapper h))

-- | @since WIP
instance
  forall wrapper h (struct' :: [[Type]]) (struct :: [[S -> Type]]) (hstruct :: [[Type]]).
  ( PLiftable (PInner wrapper)
  , SOP.Generic (wrapper Any)
  , SOP.Generic h
  , hstruct ~ Code h
  , struct' ~ Code (wrapper Any)
  , struct ~ UnTermStruct' struct'
  , hstruct ~ StructAsHaskell struct
  , AsHaskell (PInner wrapper) ~ SOP SOP.I hstruct
  ) =>
  PLiftable (DerivePLiftableAsRepr wrapper h)
  where
  type AsHaskell (DerivePLiftableAsRepr wrapper h) = h
  type PlutusRepr (DerivePLiftableAsRepr wrapper h) = PlutusRepr (PInner wrapper)
  haskToRepr :: h -> PlutusRepr (PInner wrapper)
  haskToRepr :: h -> PlutusRepr (PInner wrapper)
haskToRepr h
x = forall (a :: S -> Type). PLiftable a => AsHaskell a -> PlutusRepr a
haskToRepr @(PInner wrapper) (AsHaskell (PInner wrapper) -> PlutusRepr (PInner wrapper))
-> AsHaskell (PInner wrapper) -> PlutusRepr (PInner wrapper)
forall a b. (a -> b) -> a -> b
$ h -> Rep h
forall a. Generic a => a -> Rep a
SOP.from h
x
  reprToHask :: PlutusRepr (PInner wrapper) -> Either LiftError h
  reprToHask :: PlutusRepr (PInner wrapper) -> Either LiftError h
reprToHask PlutusRepr (PInner wrapper)
x = Rep h -> h
forall a. Generic a => Rep a -> a
SOP.to (Rep h -> h) -> Either LiftError (Rep h) -> Either LiftError h
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (a :: S -> Type).
PLiftable a =>
PlutusRepr a -> Either LiftError (AsHaskell a)
reprToHask @(PInner wrapper) PlutusRepr (PInner wrapper)
x
  reprToPlut :: forall (s :: S).
PlutusRepr (DerivePLiftableAsRepr wrapper h)
-> PLifted s (DerivePLiftableAsRepr wrapper h)
reprToPlut PlutusRepr (DerivePLiftableAsRepr wrapper h)
x = PLifted s (PInner wrapper)
-> PLifted s (DerivePLiftableAsRepr wrapper h)
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
PLifted s a -> PLifted s b
punsafeCoercePLifted (PLifted s (PInner wrapper)
 -> PLifted s (DerivePLiftableAsRepr wrapper h))
-> PLifted s (PInner wrapper)
-> PLifted s (DerivePLiftableAsRepr wrapper h)
forall a b. (a -> b) -> a -> b
$ forall (a :: S -> Type) (s :: S).
PLiftable a =>
PlutusRepr a -> PLifted s a
reprToPlut @(PInner wrapper) PlutusRepr (PInner wrapper)
PlutusRepr (DerivePLiftableAsRepr wrapper h)
x
  plutToRepr :: (forall (s :: S). PLifted s (DerivePLiftableAsRepr wrapper h))
-> Either LiftError (PlutusRepr (DerivePLiftableAsRepr wrapper h))
plutToRepr forall (s :: S). PLifted s (DerivePLiftableAsRepr wrapper h)
x = forall (a :: S -> Type).
PLiftable a =>
(forall (s :: S). PLifted s a) -> Either LiftError (PlutusRepr a)
plutToRepr @(PInner wrapper) ((forall (s :: S). PLifted s (PInner wrapper))
 -> Either LiftError (PlutusRepr (PInner wrapper)))
-> (forall (s :: S). PLifted s (PInner wrapper))
-> Either LiftError (PlutusRepr (PInner wrapper))
forall a b. (a -> b) -> a -> b
$ PLifted s (DerivePLiftableAsRepr wrapper h)
-> PLifted s (PInner wrapper)
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
PLifted s a -> PLifted s b
punsafeCoercePLifted PLifted s (DerivePLiftableAsRepr wrapper h)
forall (s :: S). PLifted s (DerivePLiftableAsRepr wrapper h)
x