{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
-- Because of the weird way the PlutusType derivation mechanisms work, we lose
-- the PlutusType constraint. Kind of annoying, but we can't convince GHC
-- otherwise.
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

module Plutarch.Internal.Lift (
  -- * Type class
  PLiftable (..),

  -- * Functions
  pconstant,
  plift,

  -- * Derivation

  -- ** Via-helpers
  DeriveBuiltinPLiftable (..),
  DeriveDataPLiftable (..),
  DeriveNewtypePLiftable (..),

  -- ** Manual instance helpers
  unsafeToUni,
  fromPlutarchUni,
  toPlutarchUni,
  fromPlutarchReprClosed,
  toPlutarchReprClosed,
  PLifted (PLifted),
  mkPLifted,
  getPLifted,
  PLiftedClosed (..),
  LiftError (..),
) where

import Data.Coerce (Coercible, coerce)
import Data.Kind (Type)
import Data.Text (Text)
import Data.Text qualified as Text
import GHC.Generics (Generic)
import {-# SOURCE #-} Plutarch.Builtin (PData)
import Plutarch.Internal.Evaluate (EvalError, evalScriptHuge)
import Plutarch.Internal.Newtype (PlutusTypeNewtype)
import Plutarch.Internal.Other (POpaque, popaque)
import Plutarch.Internal.PlutusType (DPTStrat, DerivePlutusType, PlutusType)
import Plutarch.Internal.Term (
  Config (Tracing),
  LogLevel (LogInfo),
  S,
  Term,
  TracingMode (DoTracing),
  compile,
  punsafeConstantInternal,
 )
import Plutarch.Script (Script (Script))
import Plutarch.TryFrom (PSubtype)
import Plutarch.Unsafe (punsafeCoerce)
import PlutusCore qualified as PLC
import PlutusCore.Builtin (BuiltinError, readKnownConstant)
import PlutusTx qualified as PTx
import Universe (Includes)
import UntypedPlutusCore qualified as UPLC

{- | Used with 'fromPlutarch' methods to give additional information about why
evaluating a Plutarch term into a Haskell value went wrong.

@since WIP
-}
data LiftError
  = -- | Evaluation failed for some reason.
    CouldNotEvaluate EvalError
  | -- | We tried to use a builtin not part of the Plutus universe.
    TypeError BuiltinError
  | -- | Compiling the term into a script failed.
    CouldNotCompile Text
  | -- | @Data@ encoding was invalid for our type
    CouldNotDecodeData
  deriving stock
    ( -- | @since WIP
      LiftError -> LiftError -> Bool
(LiftError -> LiftError -> Bool)
-> (LiftError -> LiftError -> Bool) -> Eq LiftError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LiftError -> LiftError -> Bool
== :: LiftError -> LiftError -> Bool
$c/= :: LiftError -> LiftError -> Bool
/= :: LiftError -> LiftError -> Bool
Eq
    , -- | @since WIP
      Int -> LiftError -> ShowS
[LiftError] -> ShowS
LiftError -> String
(Int -> LiftError -> ShowS)
-> (LiftError -> String)
-> ([LiftError] -> ShowS)
-> Show LiftError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LiftError -> ShowS
showsPrec :: Int -> LiftError -> ShowS
$cshow :: LiftError -> String
show :: LiftError -> String
$cshowList :: [LiftError] -> ShowS
showList :: [LiftError] -> ShowS
Show
    )

{- | Indicates that the given Plutarch type has an equivalent in Haskell (and
Plutus by extension), and we have the ability to move between them.

= Important note

Calling methods of 'PLiftable' directly should rarely, if ever, be a
thing you do, unless defining your own instances without @via@-deriving
helpers (below). Prefer using 'pconstant' and 'plift', as these handle
some of the oddities required without you having to think about them.

You should rarely, if ever, need to define 'PLiftable' instances by hand.
Whenever possible, prefer using 'DeriveBuiltinPLiftable',
'DeriveDataPLiftable', and `DeriveNewtypePLiftable` as they have fewer
complexities and caveats. See their documentation for when to use them.

If you do want to define the methods yourself, there's a few key factors to
keep in mind:

1. You still shouldn't write every method by hand, there are helpers
   @fromPlutarch*@ and @toPlutarch*@ to cover common cases like types
   in Plutus universe or Scott encoding
2. If defining 'toPlutarchRepr' and 'fromPlutarchRepr' you will need to define
   an associated 'PlutusRepr' type, this is a Hasekll level type that is included
   in the Plutus default universe.
3. If defining 'toPlutarch' and 'fromPlutarch' for Scott encoded type you need to
   set @'PlutusRepr' PMyType = 'PLiftedClosed' PMyType@
4. When choosing a type for 'AsHaskell', /any/ value of that type /must/ be
   representable in Plutarch. If you have internal invariants to maintain on
   the Haskell side, make sure you do so with great care.

= Laws

1. @'fromPlutarchRepr' '.' 'toPlutarchRepr'@ @=@ @'Just'@
2. @'fmap' 'toPlutarchRepr' '.' 'fromPlutarchRepr'@ @=@ @'Just'@
3. @'fromPlutarch' '.' 'toPlutarch'@ @=@ @'Right'@
4. @'fmap' 'toPlutarch' '.' 'fromPlutarch'@ @=@ @'Right'@

Any derivations via 'DeriveBuiltinPLiftable', 'DeriveDataPLiftable', and
'DeriveNewtypePLiftable' automatically follow these laws.

@since WIP
-}
class PlutusType a => PLiftable (a :: S -> Type) where
  type AsHaskell a :: Type

  -- Implementation note: we need this second repr type because builtin
  -- containers like 'PBuiltinList' and 'PBuiltinPair' are not actually
  -- polymorphic. They can only hold types that are in 'DefaultUni'.
  -- Thus to convert e.g. a list to plutarch we first need to convert
  -- list elements to something that is in Plutus universe before it can
  -- be processed further
  type PlutusRepr a :: Type

  toPlutarchRepr :: AsHaskell a -> PlutusRepr a
  toPlutarch :: AsHaskell a -> PLifted s a
  fromPlutarchRepr :: PlutusRepr a -> Maybe (AsHaskell a)
  fromPlutarch :: (forall s. PLifted s a) -> Either LiftError (AsHaskell a)

{- | Valid definition for 'toPlutarchRepr' if 'PlutusRepr' is Scott encoded

@since WIP
-}
toPlutarchReprClosed ::
  forall (a :: S -> Type).
  (PLiftable a, PlutusRepr a ~ PLiftedClosed a) =>
  AsHaskell a ->
  PlutusRepr a
toPlutarchReprClosed :: forall (a :: S -> Type).
(PLiftable a,
 (PlutusRepr a :: Type) ~ (PLiftedClosed a :: Type)) =>
AsHaskell a -> PlutusRepr a
toPlutarchReprClosed AsHaskell a
p = (forall (s :: S). PLifted @(S -> Type) s a) -> PLiftedClosed a
forall (a :: S -> Type).
(forall (s :: S). PLifted @(S -> Type) s a) -> PLiftedClosed a
PLiftedClosed ((forall (s :: S). PLifted @(S -> Type) s a) -> PLiftedClosed a)
-> (forall (s :: S). PLifted @(S -> Type) s a) -> PLiftedClosed a
forall a b. (a -> b) -> a -> b
$ forall (a :: S -> Type) (s :: S).
PLiftable a =>
AsHaskell a -> PLifted @(S -> Type) s a
toPlutarch @a AsHaskell a
p

{- | Valid definition for 'fromPlutarchRepr' if 'PlutusRepr' is Scott encoded

@since WIP
-}
fromPlutarchReprClosed ::
  forall (a :: S -> Type).
  (PLiftable a, PlutusRepr a ~ PLiftedClosed a) =>
  PlutusRepr a ->
  Maybe (AsHaskell a)
fromPlutarchReprClosed :: forall (a :: S -> Type).
(PLiftable a,
 (PlutusRepr a :: Type) ~ (PLiftedClosed a :: Type)) =>
PlutusRepr a -> Maybe (AsHaskell a)
fromPlutarchReprClosed (PLiftedClosed forall (s :: S). PLifted @(S -> Type) s a
t) = (LiftError -> Maybe (AsHaskell a))
-> (AsHaskell a -> Maybe (AsHaskell a))
-> Either LiftError (AsHaskell a)
-> Maybe (AsHaskell a)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe (AsHaskell a) -> LiftError -> Maybe (AsHaskell a)
forall a b. a -> b -> a
const Maybe (AsHaskell a)
forall a. Maybe a
Nothing) AsHaskell a -> Maybe (AsHaskell a)
forall a. a -> Maybe a
Just (Either LiftError (AsHaskell a) -> Maybe (AsHaskell a))
-> Either LiftError (AsHaskell a) -> Maybe (AsHaskell a)
forall a b. (a -> b) -> a -> b
$ forall (a :: S -> Type).
PLiftable a =>
(forall (s :: S). PLifted @(S -> Type) s a)
-> Either LiftError (AsHaskell a)
fromPlutarch @a PLifted @(S -> Type) s a
forall (s :: S). PLifted @(S -> Type) s a
t

{- | Valid definition for 'toPlutarch' if 'PlutusRepr' is in Plutus universe

@since WIP
-}
toPlutarchUni ::
  forall (a :: S -> Type) (s :: S).
  (PLiftable a, PLC.DefaultUni `Includes` PlutusRepr a) =>
  AsHaskell a ->
  PLifted s a
toPlutarchUni :: forall (a :: S -> Type) (s :: S).
(PLiftable a, Includes @Type DefaultUni (PlutusRepr a)) =>
AsHaskell a -> PLifted @(S -> Type) s a
toPlutarchUni AsHaskell a
p =
  Term s POpaque -> PLifted @(S -> Type) s a
forall {k} (s :: S) (a :: k). Term s POpaque -> PLifted @k s a
PLifted (Term s POpaque -> PLifted @(S -> Type) s a)
-> Term s POpaque -> PLifted @(S -> Type) s a
forall a b. (a -> b) -> a -> b
$ Term s (Any @(S -> Type)) -> Term s POpaque
forall (s :: S) (a :: S -> Type). Term s a -> Term s POpaque
popaque (Term s (Any @(S -> Type)) -> Term s POpaque)
-> Term s (Any @(S -> Type)) -> Term s POpaque
forall a b. (a -> b) -> a -> b
$ Term s (Any @(S -> Type)) -> Term s (Any @(S -> Type))
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
Term s a -> Term s b
punsafeCoerce (Term s (Any @(S -> Type)) -> Term s (Any @(S -> Type)))
-> Term s (Any @(S -> Type)) -> Term s (Any @(S -> Type))
forall a b. (a -> b) -> a -> b
$ Some @Type (ValueOf DefaultUni) -> Term s (Any @(S -> Type))
forall (s :: S) (a :: S -> Type).
Some @Type (ValueOf DefaultUni) -> Term s a
punsafeConstantInternal (Some @Type (ValueOf DefaultUni) -> Term s (Any @(S -> Type)))
-> Some @Type (ValueOf DefaultUni) -> Term s (Any @(S -> Type))
forall a b. (a -> b) -> a -> b
$ PlutusRepr a -> Some @Type (ValueOf DefaultUni)
forall a (uni :: Type -> Type).
Contains @Type uni a =>
a -> Some @Type (ValueOf uni)
PLC.someValue (PlutusRepr a -> Some @Type (ValueOf DefaultUni))
-> PlutusRepr a -> Some @Type (ValueOf DefaultUni)
forall a b. (a -> b) -> a -> b
$ forall (a :: S -> Type). PLiftable a => AsHaskell a -> PlutusRepr a
toPlutarchRepr @a AsHaskell a
p

unsafeToUni ::
  forall (h :: Type) (a :: S -> Type) (s :: S).
  PLC.DefaultUni `Includes` h =>
  h ->
  PLifted s a
unsafeToUni :: forall h (a :: S -> Type) (s :: S).
Includes @Type DefaultUni h =>
h -> PLifted @(S -> Type) s a
unsafeToUni h
x = Term s POpaque -> PLifted @(S -> Type) s a
forall {k} (s :: S) (a :: k). Term s POpaque -> PLifted @k s a
PLifted (Term s POpaque -> PLifted @(S -> Type) s a)
-> Term s POpaque -> PLifted @(S -> Type) s a
forall a b. (a -> b) -> a -> b
$ Term s (Any @(S -> Type)) -> Term s POpaque
forall (s :: S) (a :: S -> Type). Term s a -> Term s POpaque
popaque (Term s (Any @(S -> Type)) -> Term s POpaque)
-> Term s (Any @(S -> Type)) -> Term s POpaque
forall a b. (a -> b) -> a -> b
$ Term s (Any @(S -> Type)) -> Term s (Any @(S -> Type))
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
Term s a -> Term s b
punsafeCoerce (Term s (Any @(S -> Type)) -> Term s (Any @(S -> Type)))
-> Term s (Any @(S -> Type)) -> Term s (Any @(S -> Type))
forall a b. (a -> b) -> a -> b
$ Some @Type (ValueOf DefaultUni) -> Term s (Any @(S -> Type))
forall (s :: S) (a :: S -> Type).
Some @Type (ValueOf DefaultUni) -> Term s a
punsafeConstantInternal (Some @Type (ValueOf DefaultUni) -> Term s (Any @(S -> Type)))
-> Some @Type (ValueOf DefaultUni) -> Term s (Any @(S -> Type))
forall a b. (a -> b) -> a -> b
$ h -> Some @Type (ValueOf DefaultUni)
forall a (uni :: Type -> Type).
Contains @Type uni a =>
a -> Some @Type (ValueOf uni)
PLC.someValue h
x

{- | Valid definition for 'fromPlutarch' if 'PlutusRepr' is in Plutus universe

@since WIP
-}
fromPlutarchUni ::
  forall (a :: S -> Type).
  (PLiftable a, PLC.DefaultUni `Includes` PlutusRepr a) =>
  (forall s. PLifted s a) ->
  Either LiftError (AsHaskell a)
fromPlutarchUni :: forall (a :: S -> Type).
(PLiftable a, Includes @Type DefaultUni (PlutusRepr a)) =>
(forall (s :: S). PLifted @(S -> Type) s a)
-> Either LiftError (AsHaskell a)
fromPlutarchUni forall (s :: S). PLifted @(S -> Type) s a
t =
  case Config -> ClosedTerm POpaque -> Either Text Script
forall (a :: S -> Type).
Config -> ClosedTerm a -> Either Text Script
compile (LogLevel -> TracingMode -> Config
Tracing LogLevel
LogInfo TracingMode
DoTracing) (ClosedTerm POpaque -> Either Text Script)
-> ClosedTerm POpaque -> Either Text Script
forall a b. (a -> b) -> a -> b
$ PLifted @(S -> Type) s a -> Term s POpaque
forall {k} (s :: S) (a :: k). PLifted @k s a -> Term s POpaque
unPLifted PLifted @(S -> Type) s a
forall (s :: S). PLifted @(S -> Type) s a
t of
    Left Text
err -> LiftError -> Either LiftError (AsHaskell a)
forall a b. a -> Either a b
Left (LiftError -> Either LiftError (AsHaskell a))
-> (Text -> LiftError) -> Text -> Either LiftError (AsHaskell a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LiftError
CouldNotCompile (Text -> Either LiftError (AsHaskell a))
-> Text -> Either LiftError (AsHaskell a)
forall a b. (a -> b) -> a -> b
$ Text
err
    Right Script
compiled -> case Script -> (Either EvalError Script, ExBudget, [Text])
evalScriptHuge Script
compiled of
      (Either EvalError Script
evaluated, ExBudget
_, [Text]
_) -> case Either EvalError Script
evaluated of
        Left EvalError
err -> LiftError -> Either LiftError (AsHaskell a)
forall a b. a -> Either a b
Left (LiftError -> Either LiftError (AsHaskell a))
-> (EvalError -> LiftError)
-> EvalError
-> Either LiftError (AsHaskell a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvalError -> LiftError
CouldNotEvaluate (EvalError -> Either LiftError (AsHaskell a))
-> EvalError -> Either LiftError (AsHaskell a)
forall a b. (a -> b) -> a -> b
$ EvalError
err
        Right (Script (UPLC.Program ()
_ Version
_ Term DeBruijn DefaultUni DefaultFun ()
term)) -> case Term DeBruijn DefaultUni DefaultFun () -> ReadKnownM (PlutusRepr a)
forall val a. KnownBuiltinType val a => val -> ReadKnownM a
readKnownConstant Term DeBruijn DefaultUni DefaultFun ()
term of
          Left BuiltinError
err -> LiftError -> Either LiftError (AsHaskell a)
forall a b. a -> Either a b
Left (LiftError -> Either LiftError (AsHaskell a))
-> (BuiltinError -> LiftError)
-> BuiltinError
-> Either LiftError (AsHaskell a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinError -> LiftError
TypeError (BuiltinError -> Either LiftError (AsHaskell a))
-> BuiltinError -> Either LiftError (AsHaskell a)
forall a b. (a -> b) -> a -> b
$ BuiltinError
err
          Right PlutusRepr a
res -> Either LiftError (AsHaskell a)
-> (AsHaskell a -> Either LiftError (AsHaskell a))
-> Maybe (AsHaskell a)
-> Either LiftError (AsHaskell a)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LiftError -> Either LiftError (AsHaskell a)
forall a b. a -> Either a b
Left LiftError
CouldNotDecodeData) AsHaskell a -> Either LiftError (AsHaskell a)
forall a b. b -> Either a b
Right (Maybe (AsHaskell a) -> Either LiftError (AsHaskell a))
-> Maybe (AsHaskell a) -> Either LiftError (AsHaskell a)
forall a b. (a -> b) -> a -> b
$ forall (a :: S -> Type).
PLiftable a =>
PlutusRepr a -> Maybe (AsHaskell a)
fromPlutarchRepr @a PlutusRepr a
res

{- | Given a Haskell-level representation of a Plutarch term, transform it into
its equivalent term.

@since WIP
-}
pconstant ::
  forall (a :: S -> Type) (s :: S).
  PLiftable a =>
  AsHaskell a ->
  Term s a
pconstant :: forall (a :: S -> Type) (s :: S).
PLiftable a =>
AsHaskell a -> Term s a
pconstant = PLifted @(S -> Type) s a -> Term s a
forall (s :: S) (a :: S -> Type).
PLifted @(S -> Type) s a -> Term s a
getPLifted (PLifted @(S -> Type) s a -> Term s a)
-> (AsHaskell a -> PLifted @(S -> Type) s a)
-> AsHaskell a
-> Term s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: S -> Type) (s :: S).
PLiftable a =>
AsHaskell a -> PLifted @(S -> Type) s a
toPlutarch @a

{- | Given a closed Plutarch term, compile and evaluate it, then produce the
corresponding Haskell value. If compilation or evaluation fails somehow, this
will call 'error': if you need to \'trap\' these outcomes and handle them
differently somehow, use 'fromPlutarch'.

@since WIP
-}
plift ::
  forall (a :: S -> Type).
  PLiftable a =>
  (forall (s :: S). Term s a) ->
  AsHaskell a
plift :: forall (a :: S -> Type).
PLiftable a =>
(forall (s :: S). Term s a) -> AsHaskell a
plift forall (s :: S). Term s a
t = case forall (a :: S -> Type).
PLiftable a =>
(forall (s :: S). PLifted @(S -> Type) s a)
-> Either LiftError (AsHaskell a)
fromPlutarch @a ((forall (s :: S). PLifted @(S -> Type) s a)
 -> Either LiftError (AsHaskell a))
-> (forall (s :: S). PLifted @(S -> Type) s a)
-> Either LiftError (AsHaskell a)
forall a b. (a -> b) -> a -> b
$ Term s a -> PLifted @(S -> Type) s a
forall (s :: S) (a :: S -> Type).
Term s a -> PLifted @(S -> Type) s a
mkPLifted Term s a
forall (s :: S). Term s a
t of
  Left LiftError
err ->
    String -> AsHaskell a
forall a. HasCallStack => String -> a
error (String -> AsHaskell a) -> String -> AsHaskell a
forall a b. (a -> b) -> a -> b
$
      String
"plift failed: "
        String -> ShowS
forall a. Semigroup a => a -> a -> a
<> ( case LiftError
err of
              CouldNotEvaluate EvalError
evalErr -> String
"term errored: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> EvalError -> String
forall a. Show a => a -> String
show EvalError
evalErr
              TypeError BuiltinError
builtinError -> String
"incorrect type: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> BuiltinError -> String
forall a. Show a => a -> String
show BuiltinError
builtinError
              CouldNotCompile Text
compErr -> String
"could not compile: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
compErr
              LiftError
CouldNotDecodeData -> String
"Data value is not a valid encoding for this type"
           )
  Right AsHaskell a
res -> AsHaskell a
res

{- | @via@-deriving helper, indicating that @a@ has a Haskell-level equivalent
@h@ that is directly part of the Plutus default universe (instead of by way
of a @Data@ encoding).

@since WIP
-}
newtype DeriveBuiltinPLiftable (a :: S -> Type) (h :: Type) (s :: S)
  = DeriveBuiltinPLiftable (a s)
  deriving stock ((forall x.
 DeriveBuiltinPLiftable a h s
 -> Rep (DeriveBuiltinPLiftable a h s) x)
-> (forall x.
    Rep (DeriveBuiltinPLiftable a h s) x
    -> DeriveBuiltinPLiftable a h s)
-> Generic (DeriveBuiltinPLiftable a h s)
forall x.
Rep (DeriveBuiltinPLiftable a h s) x
-> DeriveBuiltinPLiftable a h s
forall x.
DeriveBuiltinPLiftable a h s
-> Rep (DeriveBuiltinPLiftable a h s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: S -> Type) h (s :: S) x.
Rep (DeriveBuiltinPLiftable a h s) x
-> DeriveBuiltinPLiftable a h s
forall (a :: S -> Type) h (s :: S) x.
DeriveBuiltinPLiftable a h s
-> Rep (DeriveBuiltinPLiftable a h s) x
$cfrom :: forall (a :: S -> Type) h (s :: S) x.
DeriveBuiltinPLiftable a h s
-> Rep (DeriveBuiltinPLiftable a h s) x
from :: forall x.
DeriveBuiltinPLiftable a h s
-> Rep (DeriveBuiltinPLiftable a h s) x
$cto :: forall (a :: S -> Type) h (s :: S) x.
Rep (DeriveBuiltinPLiftable a h s) x
-> DeriveBuiltinPLiftable a h s
to :: forall x.
Rep (DeriveBuiltinPLiftable a h s) x
-> DeriveBuiltinPLiftable a h s
Generic)
  deriving anyclass ((forall (s :: S).
 DeriveBuiltinPLiftable a h s
 -> Term s (PInner (DeriveBuiltinPLiftable a h)))
-> (forall (s :: S) (b :: S -> Type).
    Term s (PInner (DeriveBuiltinPLiftable a h))
    -> (DeriveBuiltinPLiftable a h s -> Term s b) -> Term s b)
-> PlutusType (DeriveBuiltinPLiftable a h)
forall (s :: S).
DeriveBuiltinPLiftable a h s
-> Term s (PInner (DeriveBuiltinPLiftable a h))
forall (s :: S) (b :: S -> Type).
Term s (PInner (DeriveBuiltinPLiftable a h))
-> (DeriveBuiltinPLiftable a 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 (a :: S -> Type) h (s :: S).
DeriveBuiltinPLiftable a h s
-> Term s (PInner (DeriveBuiltinPLiftable a h))
forall (a :: S -> Type) h (s :: S) (b :: S -> Type).
Term s (PInner (DeriveBuiltinPLiftable a h))
-> (DeriveBuiltinPLiftable a h s -> Term s b) -> Term s b
$cpcon' :: forall (a :: S -> Type) h (s :: S).
DeriveBuiltinPLiftable a h s
-> Term s (PInner (DeriveBuiltinPLiftable a h))
pcon' :: forall (s :: S).
DeriveBuiltinPLiftable a h s
-> Term s (PInner (DeriveBuiltinPLiftable a h))
$cpmatch' :: forall (a :: S -> Type) h (s :: S) (b :: S -> Type).
Term s (PInner (DeriveBuiltinPLiftable a h))
-> (DeriveBuiltinPLiftable a h s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: S -> Type).
Term s (PInner (DeriveBuiltinPLiftable a h))
-> (DeriveBuiltinPLiftable a h s -> Term s b) -> Term s b
PlutusType)

-- | @since WIP
instance DerivePlutusType (DeriveBuiltinPLiftable a h) where
  type DPTStrat _ = PlutusTypeNewtype

-- | @since WIP
instance
  ( PlutusType a
  , PLC.DefaultUni `Includes` h
  ) =>
  PLiftable (DeriveBuiltinPLiftable a h)
  where
  type AsHaskell (DeriveBuiltinPLiftable a h) = h
  type PlutusRepr (DeriveBuiltinPLiftable a h) = h

  {-# INLINEABLE toPlutarchRepr #-}
  toPlutarchRepr :: AsHaskell (DeriveBuiltinPLiftable a h)
-> PlutusRepr (DeriveBuiltinPLiftable a h)
toPlutarchRepr = AsHaskell (DeriveBuiltinPLiftable a h)
-> AsHaskell (DeriveBuiltinPLiftable a h)
AsHaskell (DeriveBuiltinPLiftable a h)
-> PlutusRepr (DeriveBuiltinPLiftable a h)
forall a. a -> a
id

  {-# INLINEABLE toPlutarch #-}
  toPlutarch :: forall (s :: S).
AsHaskell (DeriveBuiltinPLiftable a h)
-> PLifted @(S -> Type) s (DeriveBuiltinPLiftable a h)
toPlutarch = AsHaskell (DeriveBuiltinPLiftable a h)
-> PLifted @(S -> Type) s (DeriveBuiltinPLiftable a h)
forall (a :: S -> Type) (s :: S).
(PLiftable a, Includes @Type DefaultUni (PlutusRepr a)) =>
AsHaskell a -> PLifted @(S -> Type) s a
toPlutarchUni

  {-# INLINEABLE fromPlutarchRepr #-}
  fromPlutarchRepr :: PlutusRepr (DeriveBuiltinPLiftable a h)
-> Maybe (AsHaskell (DeriveBuiltinPLiftable a h))
fromPlutarchRepr = PlutusRepr (DeriveBuiltinPLiftable a h)
-> Maybe (AsHaskell (DeriveBuiltinPLiftable a h))
PlutusRepr (DeriveBuiltinPLiftable a h)
-> Maybe (PlutusRepr (DeriveBuiltinPLiftable a h))
forall a. a -> Maybe a
Just

  {-# INLINEABLE fromPlutarch #-}
  fromPlutarch :: (forall (s :: S).
 PLifted @(S -> Type) s (DeriveBuiltinPLiftable a h))
-> Either LiftError (AsHaskell (DeriveBuiltinPLiftable a h))
fromPlutarch = (forall (s :: S).
 PLifted @(S -> Type) s (DeriveBuiltinPLiftable a h))
-> Either LiftError (AsHaskell (DeriveBuiltinPLiftable a h))
forall (a :: S -> Type).
(PLiftable a, Includes @Type DefaultUni (PlutusRepr a)) =>
(forall (s :: S). PLifted @(S -> Type) s a)
-> Either LiftError (AsHaskell a)
fromPlutarchUni

{- | @via@-deriving helper, indicating that @a@ has a Haskell-level equivalent
@h@ by way of its @Data@ encoding, rather than by @h@ being directly part of
the Plutus default universe.

@since WIP
-}
newtype DeriveDataPLiftable (a :: S -> Type) (h :: Type) (s :: S)
  = DeriveDataPLiftable (a s)
  deriving stock ((forall x.
 DeriveDataPLiftable a h s -> Rep (DeriveDataPLiftable a h s) x)
-> (forall x.
    Rep (DeriveDataPLiftable a h s) x -> DeriveDataPLiftable a h s)
-> Generic (DeriveDataPLiftable a h s)
forall x.
Rep (DeriveDataPLiftable a h s) x -> DeriveDataPLiftable a h s
forall x.
DeriveDataPLiftable a h s -> Rep (DeriveDataPLiftable a h s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (a :: S -> Type) h (s :: S) x.
Rep (DeriveDataPLiftable a h s) x -> DeriveDataPLiftable a h s
forall (a :: S -> Type) h (s :: S) x.
DeriveDataPLiftable a h s -> Rep (DeriveDataPLiftable a h s) x
$cfrom :: forall (a :: S -> Type) h (s :: S) x.
DeriveDataPLiftable a h s -> Rep (DeriveDataPLiftable a h s) x
from :: forall x.
DeriveDataPLiftable a h s -> Rep (DeriveDataPLiftable a h s) x
$cto :: forall (a :: S -> Type) h (s :: S) x.
Rep (DeriveDataPLiftable a h s) x -> DeriveDataPLiftable a h s
to :: forall x.
Rep (DeriveDataPLiftable a h s) x -> DeriveDataPLiftable a h s
Generic)
  deriving anyclass ((forall (s :: S).
 DeriveDataPLiftable a h s
 -> Term s (PInner (DeriveDataPLiftable a h)))
-> (forall (s :: S) (b :: S -> Type).
    Term s (PInner (DeriveDataPLiftable a h))
    -> (DeriveDataPLiftable a h s -> Term s b) -> Term s b)
-> PlutusType (DeriveDataPLiftable a h)
forall (s :: S).
DeriveDataPLiftable a h s
-> Term s (PInner (DeriveDataPLiftable a h))
forall (s :: S) (b :: S -> Type).
Term s (PInner (DeriveDataPLiftable a h))
-> (DeriveDataPLiftable a 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 (a :: S -> Type) h (s :: S).
DeriveDataPLiftable a h s
-> Term s (PInner (DeriveDataPLiftable a h))
forall (a :: S -> Type) h (s :: S) (b :: S -> Type).
Term s (PInner (DeriveDataPLiftable a h))
-> (DeriveDataPLiftable a h s -> Term s b) -> Term s b
$cpcon' :: forall (a :: S -> Type) h (s :: S).
DeriveDataPLiftable a h s
-> Term s (PInner (DeriveDataPLiftable a h))
pcon' :: forall (s :: S).
DeriveDataPLiftable a h s
-> Term s (PInner (DeriveDataPLiftable a h))
$cpmatch' :: forall (a :: S -> Type) h (s :: S) (b :: S -> Type).
Term s (PInner (DeriveDataPLiftable a h))
-> (DeriveDataPLiftable a h s -> Term s b) -> Term s b
pmatch' :: forall (s :: S) (b :: S -> Type).
Term s (PInner (DeriveDataPLiftable a h))
-> (DeriveDataPLiftable a h s -> Term s b) -> Term s b
PlutusType)

-- | @since WIP
instance DerivePlutusType (DeriveDataPLiftable a h) where
  type DPTStrat _ = PlutusTypeNewtype

-- | @since WIP
instance
  ( PlutusType a
  , PSubtype PData a
  , PTx.ToData h
  , PTx.FromData h
  ) =>
  PLiftable (DeriveDataPLiftable a h)
  where
  type AsHaskell (DeriveDataPLiftable a h) = h
  type PlutusRepr (DeriveDataPLiftable a h) = PTx.Data

  {-# INLINEABLE toPlutarchRepr #-}
  toPlutarchRepr :: AsHaskell (DeriveDataPLiftable a h)
-> PlutusRepr (DeriveDataPLiftable a h)
toPlutarchRepr = AsHaskell (DeriveDataPLiftable a h) -> Data
AsHaskell (DeriveDataPLiftable a h)
-> PlutusRepr (DeriveDataPLiftable a h)
forall a. ToData a => a -> Data
PTx.toData

  {-# INLINEABLE toPlutarch #-}
  toPlutarch :: forall (s :: S).
AsHaskell (DeriveDataPLiftable a h)
-> PLifted @(S -> Type) s (DeriveDataPLiftable a h)
toPlutarch = AsHaskell (DeriveDataPLiftable a h)
-> PLifted @(S -> Type) s (DeriveDataPLiftable a h)
forall (a :: S -> Type) (s :: S).
(PLiftable a, Includes @Type DefaultUni (PlutusRepr a)) =>
AsHaskell a -> PLifted @(S -> Type) s a
toPlutarchUni

  {-# INLINEABLE fromPlutarchRepr #-}
  fromPlutarchRepr :: PlutusRepr (DeriveDataPLiftable a h)
-> Maybe (AsHaskell (DeriveDataPLiftable a h))
fromPlutarchRepr = Data -> Maybe (AsHaskell (DeriveDataPLiftable a h))
PlutusRepr (DeriveDataPLiftable a h)
-> Maybe (AsHaskell (DeriveDataPLiftable a h))
forall a. FromData a => Data -> Maybe a
PTx.fromData

  {-# INLINEABLE fromPlutarch #-}
  fromPlutarch :: (forall (s :: S). PLifted @(S -> Type) s (DeriveDataPLiftable a h))
-> Either LiftError (AsHaskell (DeriveDataPLiftable a h))
fromPlutarch = (forall (s :: S). PLifted @(S -> Type) s (DeriveDataPLiftable a h))
-> Either LiftError (AsHaskell (DeriveDataPLiftable a h))
forall (a :: S -> Type).
(PLiftable a, Includes @Type DefaultUni (PlutusRepr a)) =>
(forall (s :: S). PLifted @(S -> Type) s a)
-> Either LiftError (AsHaskell a)
fromPlutarchUni

{- | @via@-deriving helper, indicating that @wrapper@ has a Haskell-level equivalent
@h@ by way of encoding of @inner@. It requires that @AsHaskell inner@ has the same
Haskell representation as @h@

@since WIP
-}
newtype DeriveNewtypePLiftable (wrapper :: S -> Type) (inner :: S -> Type) (h :: Type) (s :: S)
  = DeriveNewtypePLiftable (wrapper s)
  deriving stock ((forall x.
 DeriveNewtypePLiftable wrapper inner h s
 -> Rep (DeriveNewtypePLiftable wrapper inner h s) x)
-> (forall x.
    Rep (DeriveNewtypePLiftable wrapper inner h s) x
    -> DeriveNewtypePLiftable wrapper inner h s)
-> Generic (DeriveNewtypePLiftable wrapper inner h s)
forall x.
Rep (DeriveNewtypePLiftable wrapper inner h s) x
-> DeriveNewtypePLiftable wrapper inner h s
forall x.
DeriveNewtypePLiftable wrapper inner h s
-> Rep (DeriveNewtypePLiftable wrapper inner h s) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (wrapper :: S -> Type) (inner :: S -> Type) h (s :: S) x.
Rep (DeriveNewtypePLiftable wrapper inner h s) x
-> DeriveNewtypePLiftable wrapper inner h s
forall (wrapper :: S -> Type) (inner :: S -> Type) h (s :: S) x.
DeriveNewtypePLiftable wrapper inner h s
-> Rep (DeriveNewtypePLiftable wrapper inner h s) x
$cfrom :: forall (wrapper :: S -> Type) (inner :: S -> Type) h (s :: S) x.
DeriveNewtypePLiftable wrapper inner h s
-> Rep (DeriveNewtypePLiftable wrapper inner h s) x
from :: forall x.
DeriveNewtypePLiftable wrapper inner h s
-> Rep (DeriveNewtypePLiftable wrapper inner h s) x
$cto :: forall (wrapper :: S -> Type) (inner :: S -> Type) h (s :: S) x.
Rep (DeriveNewtypePLiftable wrapper inner h s) x
-> DeriveNewtypePLiftable wrapper inner h s
to :: forall x.
Rep (DeriveNewtypePLiftable wrapper inner h s) x
-> DeriveNewtypePLiftable wrapper inner h s
Generic)
  deriving anyclass ((forall (s :: S).
 DeriveNewtypePLiftable wrapper inner h s
 -> Term s (PInner (DeriveNewtypePLiftable wrapper inner h)))
-> (forall (s :: S) (b :: S -> Type).
    Term s (PInner (DeriveNewtypePLiftable wrapper inner h))
    -> (DeriveNewtypePLiftable wrapper inner h s -> Term s b)
    -> Term s b)
-> PlutusType (DeriveNewtypePLiftable wrapper inner h)
forall (s :: S).
DeriveNewtypePLiftable wrapper inner h s
-> Term s (PInner (DeriveNewtypePLiftable wrapper inner h))
forall (s :: S) (b :: S -> Type).
Term s (PInner (DeriveNewtypePLiftable wrapper inner h))
-> (DeriveNewtypePLiftable wrapper inner 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) (inner :: S -> Type) h (s :: S).
DeriveNewtypePLiftable wrapper inner h s
-> Term s (PInner (DeriveNewtypePLiftable wrapper inner h))
forall (wrapper :: S -> Type) (inner :: S -> Type) h (s :: S)
       (b :: S -> Type).
Term s (PInner (DeriveNewtypePLiftable wrapper inner h))
-> (DeriveNewtypePLiftable wrapper inner h s -> Term s b)
-> Term s b
$cpcon' :: forall (wrapper :: S -> Type) (inner :: S -> Type) h (s :: S).
DeriveNewtypePLiftable wrapper inner h s
-> Term s (PInner (DeriveNewtypePLiftable wrapper inner h))
pcon' :: forall (s :: S).
DeriveNewtypePLiftable wrapper inner h s
-> Term s (PInner (DeriveNewtypePLiftable wrapper inner h))
$cpmatch' :: forall (wrapper :: S -> Type) (inner :: S -> Type) h (s :: S)
       (b :: S -> Type).
Term s (PInner (DeriveNewtypePLiftable wrapper inner h))
-> (DeriveNewtypePLiftable wrapper inner h s -> Term s b)
-> Term s b
pmatch' :: forall (s :: S) (b :: S -> Type).
Term s (PInner (DeriveNewtypePLiftable wrapper inner h))
-> (DeriveNewtypePLiftable wrapper inner h s -> Term s b)
-> Term s b
PlutusType)

-- | @since WIP
instance DerivePlutusType (DeriveNewtypePLiftable w i h) where
  type DPTStrat _ = PlutusTypeNewtype

-- | @since WIP
instance (PLiftable inner, Coercible (AsHaskell inner) h) => PLiftable (DeriveNewtypePLiftable wrapper inner h) where
  type AsHaskell (DeriveNewtypePLiftable wrapper inner h) = h
  type PlutusRepr (DeriveNewtypePLiftable wrapper inner h) = PlutusRepr inner

  {-# INLINEABLE toPlutarchRepr #-}
  toPlutarchRepr :: AsHaskell (DeriveNewtypePLiftable wrapper inner h)
-> PlutusRepr (DeriveNewtypePLiftable wrapper inner h)
toPlutarchRepr = forall (a :: S -> Type). PLiftable a => AsHaskell a -> PlutusRepr a
toPlutarchRepr @inner (AsHaskell inner -> PlutusRepr inner)
-> (h -> AsHaskell inner) -> h -> PlutusRepr inner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible @Type a b => a -> b
forall a b. Coercible @Type a b => a -> b
coerce @h @(AsHaskell inner)

  {-# INLINEABLE toPlutarch #-}
  toPlutarch :: forall (s :: S).
AsHaskell (DeriveNewtypePLiftable wrapper inner h)
-> PLifted @(S -> Type) s (DeriveNewtypePLiftable wrapper inner h)
toPlutarch = PLifted @(S -> Type) s inner
-> PLifted @(S -> Type) s (DeriveNewtypePLiftable wrapper inner h)
forall {k} {k} (s :: S) (a :: k) (b :: k).
PLifted @k s a -> PLifted @k s b
punsafeCoercePLifted (PLifted @(S -> Type) s inner
 -> PLifted @(S -> Type) s (DeriveNewtypePLiftable wrapper inner h))
-> (h -> PLifted @(S -> Type) s inner)
-> h
-> PLifted @(S -> Type) s (DeriveNewtypePLiftable wrapper inner h)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: S -> Type) (s :: S).
PLiftable a =>
AsHaskell a -> PLifted @(S -> Type) s a
toPlutarch @inner (AsHaskell inner -> PLifted @(S -> Type) s inner)
-> (h -> AsHaskell inner) -> h -> PLifted @(S -> Type) s inner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. Coercible @Type a b => a -> b
forall a b. Coercible @Type a b => a -> b
coerce @h @(AsHaskell inner)

  {-# INLINEABLE fromPlutarchRepr #-}
  fromPlutarchRepr :: PlutusRepr (DeriveNewtypePLiftable wrapper inner h)
-> Maybe (AsHaskell (DeriveNewtypePLiftable wrapper inner h))
fromPlutarchRepr = Maybe (AsHaskell inner)
-> Maybe (AsHaskell (DeriveNewtypePLiftable wrapper inner h))
forall a b. Coercible @Type a b => a -> b
coerce (Maybe (AsHaskell inner)
 -> Maybe (AsHaskell (DeriveNewtypePLiftable wrapper inner h)))
-> (PlutusRepr inner -> Maybe (AsHaskell inner))
-> PlutusRepr inner
-> Maybe (AsHaskell (DeriveNewtypePLiftable wrapper inner h))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: S -> Type).
PLiftable a =>
PlutusRepr a -> Maybe (AsHaskell a)
fromPlutarchRepr @inner

  {-# INLINEABLE fromPlutarch #-}
  fromPlutarch :: (forall (s :: S).
 PLifted @(S -> Type) s (DeriveNewtypePLiftable wrapper inner h))
-> Either
     LiftError (AsHaskell (DeriveNewtypePLiftable wrapper inner h))
fromPlutarch forall (s :: S).
PLifted @(S -> Type) s (DeriveNewtypePLiftable wrapper inner h)
p = Either LiftError (AsHaskell inner)
-> Either
     LiftError (AsHaskell (DeriveNewtypePLiftable wrapper inner h))
forall a b. Coercible @Type a b => a -> b
coerce (Either LiftError (AsHaskell inner)
 -> Either
      LiftError (AsHaskell (DeriveNewtypePLiftable wrapper inner h)))
-> ((forall (s :: S). PLifted @(S -> Type) s inner)
    -> Either LiftError (AsHaskell inner))
-> (forall (s :: S). PLifted @(S -> Type) s inner)
-> Either
     LiftError (AsHaskell (DeriveNewtypePLiftable wrapper inner h))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (a :: S -> Type).
PLiftable a =>
(forall (s :: S). PLifted @(S -> Type) s a)
-> Either LiftError (AsHaskell a)
fromPlutarch @inner ((forall (s :: S). PLifted @(S -> Type) s inner)
 -> Either
      LiftError (AsHaskell (DeriveNewtypePLiftable wrapper inner h)))
-> (forall (s :: S). PLifted @(S -> Type) s inner)
-> Either
     LiftError (AsHaskell (DeriveNewtypePLiftable wrapper inner h))
forall a b. (a -> b) -> a -> b
$ PLifted @(S -> Type) s (DeriveNewtypePLiftable wrapper inner h)
-> PLifted @(S -> Type) s inner
forall {k} {k} (s :: S) (a :: k) (b :: k).
PLifted @k s a -> PLifted @k s b
punsafeCoercePLifted PLifted @(S -> Type) s (DeriveNewtypePLiftable wrapper inner h)
forall (s :: S).
PLifted @(S -> Type) s (DeriveNewtypePLiftable wrapper inner h)
p

{- | Similar to 'Identity', but at the level of Plutarch. Only needed when
writing manual instances of 'PLiftable', or if you want to use 'toPlutarch'
and 'fromPlutarch' directly.

This is used for coercing Plutarch terms in Haskell level with
`coerce :: PLifted s a -> PLifted s b` for @via@-deriving helpers

@since WIP
-}
type role PLifted nominal nominal

newtype PLifted s a = PLifted {forall {k} (s :: S) (a :: k). PLifted @k s a -> Term s POpaque
unPLifted :: Term s POpaque}

-- | @since WIP
punsafeCoercePLifted :: PLifted s a -> PLifted s b
punsafeCoercePLifted :: forall {k} {k} (s :: S) (a :: k) (b :: k).
PLifted @k s a -> PLifted @k s b
punsafeCoercePLifted (PLifted Term s POpaque
t) = Term s POpaque -> PLifted @k s b
forall {k} (s :: S) (a :: k). Term s POpaque -> PLifted @k s a
PLifted Term s POpaque
t

-- | @since WIP
getPLifted :: PLifted s a -> Term s a
getPLifted :: forall (s :: S) (a :: S -> Type).
PLifted @(S -> Type) s a -> Term s a
getPLifted (PLifted Term s POpaque
t) = Term s POpaque -> Term s a
forall (s :: S) (a :: S -> Type) (b :: S -> Type).
Term s a -> Term s b
punsafeCoerce Term s POpaque
t

-- | @since WIP
mkPLifted :: Term s a -> PLifted s a
mkPLifted :: forall (s :: S) (a :: S -> Type).
Term s a -> PLifted @(S -> Type) s a
mkPLifted Term s a
t = Term s POpaque -> PLifted @(S -> Type) s a
forall {k} (s :: S) (a :: k). Term s POpaque -> PLifted @k s a
PLifted (Term s a -> Term s POpaque
forall (s :: S) (a :: S -> Type). Term s a -> Term s POpaque
popaque Term s a
t)

{- |  Use this as 'PlutusRepr' when defining 'PLiftable' instance for Scott encoded type

@since WIP
-}
newtype PLiftedClosed (a :: S -> Type) = PLiftedClosed {forall (a :: S -> Type).
PLiftedClosed a -> forall (s :: S). PLifted @(S -> Type) s a
unPLiftedClosed :: forall (s :: S). PLifted s a}