{-# LANGUAGE ImpredicativeTypes #-}

module Plutarch.Evaluate (
  E.evalScript,
  E.evalScriptHuge,
  E.evalScript',
  E.evalScriptUnlimited,
  E.EvalError,
  evalTerm,
  evalTerm',
  unsafeEvalTerm,
  applyArguments,
) where

import Control.Lens.Combinators (over)
import Data.Text (Text)
import Plutarch.Internal.Evaluate qualified as E
import Plutarch.Internal.Term (
  ClosedTerm,
  Config,
  RawTerm (RCompiled),
  Term (..),
  TermResult (TermResult),
  compile,
 )
import Plutarch.Script (Script (Script))
import PlutusCore.Evaluation.Machine.ExBudget (ExBudget)
import PlutusCore.MkPlc (mkConstant, mkIterAppNoAnn)
import PlutusLedgerApi.Common (Data)
import UntypedPlutusCore qualified as UPLC

-- | Compile and evaluate term.
evalTerm ::
  Config ->
  ClosedTerm a ->
  Either Text (Either E.EvalError (ClosedTerm a), ExBudget, [Text])
evalTerm :: forall (a :: PType).
Config
-> ClosedTerm a
-> Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
evalTerm Config
config ClosedTerm a
term =
  case Config -> ClosedTerm a -> Either Text Script
forall (a :: PType). Config -> ClosedTerm a -> Either Text Script
compile Config
config Term s a
ClosedTerm a
term of
    Right Script
script ->
      let (Either EvalError Script
s, ExBudget
b, [Text]
t) = Script -> (Either EvalError Script, ExBudget, [Text])
E.evalScriptHuge Script
script
       in (Either EvalError (ClosedTerm a), ExBudget, [Text])
-> Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
forall a b. b -> Either a b
Right (Script -> ClosedTerm a
forall (a :: PType). Script -> ClosedTerm a
fromScript (Script -> ClosedTerm a)
-> Either EvalError Script -> Either EvalError (ClosedTerm a)
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either EvalError Script
s, ExBudget
b, [Text]
t)
    Left Text
a -> Text
-> Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
forall a b. a -> Either a b
Left Text
a
  where
    fromScript :: Script -> ClosedTerm a
    fromScript :: forall (a :: PType). Script -> ClosedTerm a
fromScript (Script Program DeBruijn DefaultUni DefaultFun ()
script) =
      (Word64 -> TermMonad TermResult) -> Term s a
forall (s :: S) (a :: PType).
(Word64 -> TermMonad TermResult) -> Term s a
Term ((Word64 -> TermMonad TermResult) -> Term s a)
-> (Word64 -> TermMonad TermResult) -> Term s a
forall a b. (a -> b) -> a -> b
$ TermMonad TermResult -> Word64 -> TermMonad TermResult
forall a b. a -> b -> a
const (TermMonad TermResult -> Word64 -> TermMonad TermResult)
-> TermMonad TermResult -> Word64 -> TermMonad TermResult
forall a b. (a -> b) -> a -> b
$ TermResult -> TermMonad TermResult
forall a. a -> TermMonad a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TermResult -> TermMonad TermResult)
-> TermResult -> TermMonad TermResult
forall a b. (a -> b) -> a -> b
$ RawTerm -> [HoistedTerm] -> TermResult
TermResult (UTerm -> RawTerm
RCompiled (UTerm -> RawTerm) -> UTerm -> RawTerm
forall a b. (a -> b) -> a -> b
$ Program DeBruijn DefaultUni DefaultFun () -> UTerm
forall name (uni :: Type -> Type) fun ann.
Program name uni fun ann -> Term name uni fun ann
UPLC._progTerm Program DeBruijn DefaultUni DefaultFun ()
script) []

-- | Same as `evalTerm` but without error handling
evalTerm' :: Config -> ClosedTerm a -> ClosedTerm a
evalTerm' :: forall (a :: PType). Config -> ClosedTerm a -> ClosedTerm a
evalTerm' Config
config ClosedTerm a
term =
  case Config
-> ClosedTerm a
-> Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
forall (a :: PType).
Config
-> ClosedTerm a
-> Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
evalTerm Config
config Term s a
ClosedTerm a
term of
    Right (Right ClosedTerm a
t, ExBudget
_, [Text]
_) -> Term s a
ClosedTerm a
t
    Left Text
err -> [Char] -> Term s a
forall a. HasCallStack => [Char] -> a
error ([Char] -> Term s a) -> [Char] -> Term s a
forall a b. (a -> b) -> a -> b
$ [Char]
"evalTerm' failed: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
err
    Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
_ -> [Char] -> Term s a
forall a. HasCallStack => [Char] -> a
error [Char]
"evalTerm' failed"

{- | Compile and evaluate a ClosedTerm
Useful for pre-evaluating terms so that they can be used as constants in
an onchain script. Consider the following:
 _________________________________________________________________________
     term :: Term _ PInteger
     term = unsafeEvalTerm NoTracing foo

     foo :: Term s PInteger
     foo = (pconstant 1 #+ pconstant 5) #* pconstant 3

     bar :: Term s (PInteger :--> PInteger)
     bar = plam \x ->
       x + foo

     bar2 :: Term s (PInteger :--> PInteger)
     bar2 = plam \x ->
       x + term


    PI.compile PI.NoTracing bar
    Right (Script {unScript = Program {_progAnn = (), _progVer = Version {_versionMajor = 1, _versionMinor = 0, _versionPatch = 0}, _progTerm = LamAbs () (DeBruijn {dbnIndex = 0}) (Apply () (Apply () (Builtin () AddInteger) (Var () (DeBruijn {dbnIndex = 1}))) (Apply () (Apply () (Builtin () MultiplyInteger) (Apply () (Apply () (Builtin () AddInteger) (Constant () (Some (ValueOf DefaultUniInteger 1)))) (Constant () (Some (ValueOf DefaultUniInteger 5))))) (Constant () (Some (ValueOf DefaultUniInteger 3)))))}})
    PI.compile PI.NoTracing bar2
    Right (Script {unScript = Program {_progAnn = (), _progVer = Version {_versionMajor = 1, _versionMinor = 0, _versionPatch = 0}, _progTerm = LamAbs () (DeBruijn {dbnIndex = 0}) (Apply () (Apply () (Builtin () AddInteger) (Var () (DeBruijn {dbnIndex = 1}))) (Constant () (Some (ValueOf DefaultUniInteger 18))))}})
 _________________________________________________________________________

In bar, foo is an unevaluated term and thus must be evaluated. In bar2, foo has been
pre-evaluated with `unsafeEvalTerm` and thus appears as a constant.

Error if the compilation or evaluation fails.
-}
unsafeEvalTerm :: Config -> ClosedTerm a -> ClosedTerm a
unsafeEvalTerm :: forall (a :: PType). Config -> ClosedTerm a -> ClosedTerm a
unsafeEvalTerm Config
c ClosedTerm a
t = Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
-> ClosedTerm a
forall (a :: PType).
Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
-> ClosedTerm a
extractResult (Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
 -> ClosedTerm a)
-> Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
-> ClosedTerm a
forall a b. (a -> b) -> a -> b
$ Config
-> ClosedTerm a
-> Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
forall (a :: PType).
Config
-> ClosedTerm a
-> Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
evalTerm Config
c Term s a
ClosedTerm a
t
  where
    extractResult :: Either Text (Either E.EvalError (ClosedTerm a), ExBudget, [Text]) -> ClosedTerm a
    extractResult :: forall (a :: PType).
Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
-> ClosedTerm a
extractResult (Right (Right ClosedTerm a
term, ExBudget
_, [Text]
_)) = Term s a
ClosedTerm a
term
    extractResult Either Text (Either EvalError (ClosedTerm a), ExBudget, [Text])
_ = [Char] -> Term s a
forall a. HasCallStack => [Char] -> a
error [Char]
"unsafeEvalTerm: failed to evaluate or compile the term."

{- | Given a compiled 'Script' representing a function that takes arguments, and
a list of those 'Data'-encoded arguments, produce a new script with those
arguments applied.

@since 1.8.1
-}
applyArguments :: Script -> [Data] -> Script
applyArguments :: Script -> [Data] -> Script
applyArguments (Script Program DeBruijn DefaultUni DefaultFun ()
p) [Data]
args =
  let termArgs :: [UTerm]
termArgs = () -> Data -> UTerm
forall a (uni :: Type -> Type) fun (term :: Type -> Type) tyname
       name ann.
(TermLike term tyname name uni fun, HasTermLevel @Type uni a) =>
ann -> a -> term ann
mkConstant () (Data -> UTerm) -> [Data] -> [UTerm]
forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> [Data]
args
      applied :: UTerm -> UTerm
applied UTerm
t = UTerm -> [UTerm] -> UTerm
forall (term :: Type -> Type) tyname name (uni :: Type -> Type)
       fun.
TermLike term tyname name uni fun =>
term () -> [term ()] -> term ()
mkIterAppNoAnn UTerm
t [UTerm]
termArgs
   in Program DeBruijn DefaultUni DefaultFun () -> Script
Script (Program DeBruijn DefaultUni DefaultFun () -> Script)
-> Program DeBruijn DefaultUni DefaultFun () -> Script
forall a b. (a -> b) -> a -> b
$ ASetter
  (Program DeBruijn DefaultUni DefaultFun ())
  (Program DeBruijn DefaultUni DefaultFun ())
  UTerm
  UTerm
-> (UTerm -> UTerm)
-> Program DeBruijn DefaultUni DefaultFun ()
-> Program DeBruijn DefaultUni DefaultFun ()
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ASetter
  (Program DeBruijn DefaultUni DefaultFun ())
  (Program DeBruijn DefaultUni DefaultFun ())
  UTerm
  UTerm
forall name1 (uni1 :: Type -> Type) fun1 ann name2
       (uni2 :: Type -> Type) fun2 (f :: Type -> Type).
Functor f =>
(Term name1 uni1 fun1 ann -> f (Term name2 uni2 fun2 ann))
-> Program name1 uni1 fun1 ann -> f (Program name2 uni2 fun2 ann)
UPLC.progTerm UTerm -> UTerm
applied Program DeBruijn DefaultUni DefaultFun ()
p