{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}

module Plutarch.Internal.Evaluate (evalScript, evalScriptHuge, evalScript', EvalError) where

import Data.Text (Text)
import Plutarch.Script (Script (Script))
import PlutusCore qualified as PLC
import PlutusCore.Evaluation.Machine.ExBudget (
  ExBudget (ExBudget),
  ExRestrictingBudget (ExRestrictingBudget),
  minusExBudget,
 )
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults (defaultCekParameters)
import PlutusCore.Evaluation.Machine.ExMemory (ExCPU (ExCPU), ExMemory (ExMemory))
import UntypedPlutusCore (
  Program (Program),
  Term,
 )
import UntypedPlutusCore qualified as UPLC
import UntypedPlutusCore.Evaluation.Machine.Cek qualified as Cek

type EvalError = (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun)

-- | Evaluate a script with a big budget, returning the trace log and term result.
evalScript :: Script -> (Either EvalError Script, ExBudget, [Text])
evalScript :: Script -> (Either EvalError Script, ExBudget, [Text])
evalScript = ExBudget -> Script -> (Either EvalError Script, ExBudget, [Text])
evalScript' ExBudget
budget
  where
    -- from https://github.com/input-output-hk/cardano-node/blob/master/configuration/cardano/mainnet-alonzo-genesis.json#L17
    budget :: ExBudget
budget = ExCPU -> ExMemory -> ExBudget
ExBudget (CostingInteger -> ExCPU
ExCPU CostingInteger
10000000000) (CostingInteger -> ExMemory
ExMemory CostingInteger
10000000)

-- | Evaluate a script with a huge budget, returning the trace log and term result.
evalScriptHuge :: Script -> (Either EvalError Script, ExBudget, [Text])
evalScriptHuge :: Script -> (Either EvalError Script, ExBudget, [Text])
evalScriptHuge = ExBudget -> Script -> (Either EvalError Script, ExBudget, [Text])
evalScript' ExBudget
budget
  where
    -- from https://github.com/input-output-hk/cardano-node/blob/master/configuration/cardano/mainnet-alonzo-genesis.json#L17
    budget :: ExBudget
budget = ExCPU -> ExMemory -> ExBudget
ExBudget (CostingInteger -> ExCPU
ExCPU forall a. Bounded a => a
maxBound) (CostingInteger -> ExMemory
ExMemory forall a. Bounded a => a
maxBound)

-- | Evaluate a script with a specific budget, returning the trace log and term result.
evalScript' :: ExBudget -> Script -> (Either (Cek.CekEvaluationException PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun) Script, ExBudget, [Text])
evalScript' :: ExBudget -> Script -> (Either EvalError Script, ExBudget, [Text])
evalScript' ExBudget
budget (Script (Program ()
_ Version ()
_ Term DeBruijn DefaultUni DefaultFun ()
t)) = case ExBudget
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ()),
    ExBudget, [Text])
evalTerm ExBudget
budget (forall name name' (uni :: Type -> Type) fun ann.
(name -> name') -> Term name uni fun ann -> Term name' uni fun ann
UPLC.termMapNames DeBruijn -> NamedDeBruijn
UPLC.fakeNameDeBruijn Term DeBruijn DefaultUni DefaultFun ()
t) of
  (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
res, ExBudget
remaining, [Text]
logs) -> (Program DeBruijn DefaultUni DefaultFun () -> Script
Script forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name (uni :: Type -> Type) fun ann.
ann
-> Version ann -> Term name uni fun ann -> Program name uni fun ann
Program () (forall ann. ann -> Version ann
PLC.defaultVersion ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall name name' (uni :: Type -> Type) fun ann.
(name -> name') -> Term name uni fun ann -> Term name' uni fun ann
UPLC.termMapNames NamedDeBruijn -> DeBruijn
UPLC.unNameDeBruijn forall (f :: Type -> Type) a b. Functor f => (a -> b) -> f a -> f b
<$> Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
res, ExBudget
remaining, [Text]
logs)

evalTerm ::
  ExBudget ->
  Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun () ->
  ( Either
      EvalError
      (Term PLC.NamedDeBruijn PLC.DefaultUni PLC.DefaultFun ())
  , ExBudget
  , [Text]
  )
evalTerm :: ExBudget
-> Term NamedDeBruijn DefaultUni DefaultFun ()
-> (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ()),
    ExBudget, [Text])
evalTerm ExBudget
budget Term NamedDeBruijn DefaultUni DefaultFun ()
t =
  case forall fun (uni :: Type -> Type) cost.
(Ix fun, PrettyUni uni fun) =>
MachineParameters CekMachineCosts CekValue uni fun
-> ExBudgetMode cost uni fun
-> EmitterMode uni fun
-> Term NamedDeBruijn uni fun ()
-> (Either
      (CekEvaluationException NamedDeBruijn uni fun)
      (Term NamedDeBruijn uni fun ()),
    cost, [Text])
Cek.runCekDeBruijn MachineParameters CekMachineCosts CekValue DefaultUni DefaultFun
defaultCekParameters (forall (uni :: Type -> Type) fun.
PrettyUni uni fun =>
ExRestrictingBudget -> ExBudgetMode RestrictingSt uni fun
Cek.restricting (ExBudget -> ExRestrictingBudget
ExRestrictingBudget ExBudget
budget)) forall (uni :: Type -> Type) fun. EmitterMode uni fun
Cek.logEmitter Term NamedDeBruijn DefaultUni DefaultFun ()
t of
    (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
errOrRes, Cek.RestrictingSt (ExRestrictingBudget ExBudget
final), [Text]
logs) -> (Either EvalError (Term NamedDeBruijn DefaultUni DefaultFun ())
errOrRes, ExBudget
budget ExBudget -> ExBudget -> ExBudget
`minusExBudget` ExBudget
final, [Text]
logs)