{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TupleSections         #-}

module PlutusTx.Test.Run.Uplc where

import Prelude

import Control.Exception (SomeException (..))
import Control.Lens ((^.))
import Control.Monad.Except (ExceptT, MonadError (throwError))
import Data.Either.Extras (fromRightM)
import Data.Text (Text)
import PlutusCore (DefaultFun, DefaultUni)
import PlutusCore qualified as PLC
import PlutusCore.Evaluation.Machine.ExBudget qualified as PLC
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
import PlutusCore.Test (ToUPlc (..))
import PlutusIR.Test ()
import PlutusTx.Test.Orphans ()
import Test.Tasty.Extras ()
import UntypedPlutusCore qualified as UPLC
import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC

type Term = UPLC.Term PLC.Name DefaultUni DefaultFun ()

runPlcCek
  :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun)
  => a
  -> ExceptT
       SomeException
       IO
       (UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun ())
runPlcCek :: forall a.
ToUPlc a DefaultUni DefaultFun =>
a -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
runPlcCek a
val = do
  Program Name DefaultUni DefaultFun ()
term <- a
-> ExceptT SomeException IO (Program Name DefaultUni DefaultFun ())
forall a (uni :: * -> *) fun.
ToUPlc a uni fun =>
a -> ExceptT SomeException IO (Program Name uni fun ())
toUPlc a
val
  (CekEvaluationException Name DefaultUni DefaultFun
 -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()))
-> Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun ())
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either a b -> m b
fromRightM (SomeException
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall a. SomeException -> ExceptT SomeException IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SomeException
 -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()))
-> (CekEvaluationException Name DefaultUni DefaultFun
    -> SomeException)
-> CekEvaluationException Name DefaultUni DefaultFun
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CekEvaluationException Name DefaultUni DefaultFun -> SomeException
forall e. Exception e => e -> SomeException
SomeException) (Either
   (CekEvaluationException Name DefaultUni DefaultFun)
   (Term Name DefaultUni DefaultFun ())
 -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()))
-> Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun ())
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$
    MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
-> Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun ())
forall (uni :: * -> *) fun ann.
ThrowableBuiltins uni fun =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> Term Name uni fun ann
-> Either
     (CekEvaluationException Name uni fun) (Term Name uni fun ())
UPLC.evaluateCekNoEmit
      MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall ann.
Typeable ann =>
MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)
PLC.defaultCekParametersForTesting
      (Program Name DefaultUni DefaultFun ()
term Program Name DefaultUni DefaultFun ()
-> Getting
     (Term Name DefaultUni DefaultFun ())
     (Program Name DefaultUni DefaultFun ())
     (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall s a. s -> Getting a s a -> a
^. Getting
  (Term Name DefaultUni DefaultFun ())
  (Program Name DefaultUni DefaultFun ())
  (Term Name DefaultUni DefaultFun ())
forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2
       (f :: * -> *).
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)

runPlcCekTrace
  :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun)
  => a
  -> ExceptT
       SomeException
       IO
       ( [Text]
       , UPLC.CekExTally PLC.DefaultFun
       , UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun ()
       )
runPlcCekTrace :: forall a.
ToUPlc a DefaultUni DefaultFun =>
a
-> ExceptT
     SomeException
     IO
     ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
runPlcCekTrace a
value = do
  Program Name DefaultUni DefaultFun ()
term <- a
-> ExceptT SomeException IO (Program Name DefaultUni DefaultFun ())
forall a (uni :: * -> *) fun.
ToUPlc a uni fun =>
a -> ExceptT SomeException IO (Program Name uni fun ())
toUPlc a
value
  let (Either
  (CekEvaluationException Name DefaultUni DefaultFun)
  (Term Name DefaultUni DefaultFun ())
result, UPLC.TallyingSt CekExTally DefaultFun
tally ExBudget
_, [Text]
logOut) =
        MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> ExBudgetMode (TallyingSt DefaultFun) DefaultUni DefaultFun
-> EmitterMode DefaultUni DefaultFun
-> Term Name DefaultUni DefaultFun ()
-> (Either
      (CekEvaluationException Name DefaultUni DefaultFun)
      (Term Name DefaultUni DefaultFun ()),
    TallyingSt DefaultFun, [Text])
forall (uni :: * -> *) fun ann cost.
ThrowableBuiltins uni fun =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> ExBudgetMode cost uni fun
-> EmitterMode uni fun
-> Term Name uni fun ann
-> (Either
      (CekEvaluationException Name uni fun) (Term Name uni fun ()),
    cost, [Text])
UPLC.runCek
          MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall ann.
Typeable ann =>
MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)
PLC.defaultCekParametersForTesting
          ExBudgetMode (TallyingSt DefaultFun) DefaultUni DefaultFun
forall fun (uni :: * -> *).
Hashable fun =>
ExBudgetMode (TallyingSt fun) uni fun
UPLC.tallying
          EmitterMode DefaultUni DefaultFun
forall (uni :: * -> *) fun. EmitterMode uni fun
UPLC.logEmitter
          (Program Name DefaultUni DefaultFun ()
term Program Name DefaultUni DefaultFun ()
-> Getting
     (Term Name DefaultUni DefaultFun ())
     (Program Name DefaultUni DefaultFun ())
     (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall s a. s -> Getting a s a -> a
^. Getting
  (Term Name DefaultUni DefaultFun ())
  (Program Name DefaultUni DefaultFun ())
  (Term Name DefaultUni DefaultFun ())
forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2
       (f :: * -> *).
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)
  Term Name DefaultUni DefaultFun ()
res <- (CekEvaluationException Name DefaultUni DefaultFun
 -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()))
-> Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun ())
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either a b -> m b
fromRightM (SomeException
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall a. SomeException -> ExceptT SomeException IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SomeException
 -> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ()))
-> (CekEvaluationException Name DefaultUni DefaultFun
    -> SomeException)
-> CekEvaluationException Name DefaultUni DefaultFun
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CekEvaluationException Name DefaultUni DefaultFun -> SomeException
forall e. Exception e => e -> SomeException
SomeException) Either
  (CekEvaluationException Name DefaultUni DefaultFun)
  (Term Name DefaultUni DefaultFun ())
result
  ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
-> ExceptT
     SomeException
     IO
     ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
forall a. a -> ExceptT SomeException IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text]
logOut, CekExTally DefaultFun
tally, Term Name DefaultUni DefaultFun ()
res)

runPlcCekBudget
  :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun)
  => a
  -> ExceptT
       SomeException
       IO
       (UPLC.Term PLC.Name PLC.DefaultUni PLC.DefaultFun (), PLC.ExBudget)
runPlcCekBudget :: forall a.
ToUPlc a DefaultUni DefaultFun =>
a
-> ExceptT
     SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget)
runPlcCekBudget a
val = do
  Program Name DefaultUni DefaultFun ()
term <- a
-> ExceptT SomeException IO (Program Name DefaultUni DefaultFun ())
forall a (uni :: * -> *) fun.
ToUPlc a uni fun =>
a -> ExceptT SomeException IO (Program Name uni fun ())
toUPlc a
val
  (CekEvaluationException Name DefaultUni DefaultFun
 -> ExceptT
      SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget))
-> Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun (), ExBudget)
-> ExceptT
     SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Either a b -> m b
fromRightM (SomeException
-> ExceptT
     SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget)
forall a. SomeException -> ExceptT SomeException IO a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (SomeException
 -> ExceptT
      SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget))
-> (CekEvaluationException Name DefaultUni DefaultFun
    -> SomeException)
-> CekEvaluationException Name DefaultUni DefaultFun
-> ExceptT
     SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CekEvaluationException Name DefaultUni DefaultFun -> SomeException
forall e. Exception e => e -> SomeException
SomeException) (Either
   (CekEvaluationException Name DefaultUni DefaultFun)
   (Term Name DefaultUni DefaultFun (), ExBudget)
 -> ExceptT
      SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget))
-> Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun (), ExBudget)
-> ExceptT
     SomeException IO (Term Name DefaultUni DefaultFun (), ExBudget)
forall a b. (a -> b) -> a -> b
$ do
    let
      (Either
  (CekEvaluationException Name DefaultUni DefaultFun)
  (Term Name DefaultUni DefaultFun ())
evalRes, UPLC.CountingSt ExBudget
budget) =
        MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
-> ExBudgetMode CountingSt DefaultUni DefaultFun
-> Term Name DefaultUni DefaultFun ()
-> (Either
      (CekEvaluationException Name DefaultUni DefaultFun)
      (Term Name DefaultUni DefaultFun ()),
    CountingSt)
forall (uni :: * -> *) fun ann cost.
ThrowableBuiltins uni fun =>
MachineParameters CekMachineCosts fun (CekValue uni fun ann)
-> ExBudgetMode cost uni fun
-> Term Name uni fun ann
-> (Either
      (CekEvaluationException Name uni fun) (Term Name uni fun ()),
    cost)
UPLC.runCekNoEmit
          MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ())
forall ann.
Typeable ann =>
MachineParameters
  CekMachineCosts DefaultFun (CekValue DefaultUni DefaultFun ann)
PLC.defaultCekParametersForTesting
          ExBudgetMode CountingSt DefaultUni DefaultFun
forall (uni :: * -> *) fun. ExBudgetMode CountingSt uni fun
UPLC.counting
          (Program Name DefaultUni DefaultFun ()
term Program Name DefaultUni DefaultFun ()
-> Getting
     (Term Name DefaultUni DefaultFun ())
     (Program Name DefaultUni DefaultFun ())
     (Term Name DefaultUni DefaultFun ())
-> Term Name DefaultUni DefaultFun ()
forall s a. s -> Getting a s a -> a
^. Getting
  (Term Name DefaultUni DefaultFun ())
  (Program Name DefaultUni DefaultFun ())
  (Term Name DefaultUni DefaultFun ())
forall name1 (uni1 :: * -> *) fun1 ann name2 (uni2 :: * -> *) fun2
       (f :: * -> *).
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)
    (,ExBudget
budget) (Term Name DefaultUni DefaultFun ()
 -> (Term Name DefaultUni DefaultFun (), ExBudget))
-> Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun ())
-> Either
     (CekEvaluationException Name DefaultUni DefaultFun)
     (Term Name DefaultUni DefaultFun (), ExBudget)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either
  (CekEvaluationException Name DefaultUni DefaultFun)
  (Term Name DefaultUni DefaultFun ())
evalRes