{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE KindSignatures        #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module PlutusTx.Test (
  -- * Size tests
  goldenSize,
  fitsUnder,

  -- * Compilation testing
  goldenPir,
  goldenPirReadable,
  goldenPirBy,
  goldenTPlc,
  goldenUPlc,
  goldenUPlcReadable,

  -- * Evaluation testing
  goldenEvalCek,
  goldenEvalCekCatch,
  goldenEvalCekLog,

  -- * Budget testing
  goldenBudget

) where

import Prelude

import Control.Exception
import Control.Lens
import Control.Monad.Except
import Data.Either.Extras
import Data.Kind (Type)
import Data.Tagged (Tagged (Tagged))
import Data.Text (Text)
import Flat (Flat)
import Prettyprinter
import Test.Tasty (TestName, TestTree)
import Test.Tasty.Extras
import Test.Tasty.Providers (IsTest (run, testOptions), singleTest, testFailed, testPassed)

import PlutusCore qualified as PLC
import PlutusCore.Builtin qualified as PLC
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults qualified as PLC
import PlutusCore.Pretty
import PlutusCore.Pretty qualified as PLC
import PlutusCore.Test
import PlutusIR.Analysis.Builtins as PIR
import PlutusIR.Core.Type (progTerm)
import PlutusIR.Test ()
import PlutusIR.Transform.RewriteRules as PIR
import PlutusPrelude
import PlutusTx.Code (CompiledCode, CompiledCodeIn, getPir, getPirNoAnn, getPlcNoAnn, sizePlc)
import UntypedPlutusCore qualified as UPLC
import UntypedPlutusCore.Evaluation.Machine.Cek qualified as UPLC

-- `PlutusCore.Size` comparison tests

fitsUnder ::
  forall (a :: Type).
  (Typeable a) =>
  String ->
  (String, CompiledCode a) ->
  (String, CompiledCode a) ->
  TestTree
fitsUnder :: forall a.
Typeable a =>
String
-> (String, CompiledCode a) -> (String, CompiledCode a) -> TestTree
fitsUnder String
name (String, CompiledCode a)
test (String, CompiledCode a)
target = String -> SizeComparisonTest a -> TestTree
forall t. IsTest t => String -> t -> TestTree
singleTest String
name (SizeComparisonTest a -> TestTree)
-> SizeComparisonTest a -> TestTree
forall a b. (a -> b) -> a -> b
$ (String, CompiledCode a)
-> (String, CompiledCode a) -> SizeComparisonTest a
forall a.
(String, CompiledCode a)
-> (String, CompiledCode a) -> SizeComparisonTest a
SizeComparisonTest (String, CompiledCode a)
test (String, CompiledCode a)
target

data SizeComparisonTest (a :: Type)
  = SizeComparisonTest (String, CompiledCode a) (String, CompiledCode a)

instance (Typeable a) => IsTest (SizeComparisonTest a) where
  run :: OptionSet
-> SizeComparisonTest a -> (Progress -> IO ()) -> IO Result
run OptionSet
_ (SizeComparisonTest (String
mName, CompiledCode a
mCode) (String
tName, CompiledCode a
tCode)) Progress -> IO ()
_ = do
    let tEstimate :: Integer
tEstimate = CompiledCode a -> Integer
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a -> Integer
sizePlc CompiledCode a
tCode
    let mEstimate :: Integer
mEstimate = CompiledCode a -> Integer
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a -> Integer
sizePlc CompiledCode a
mCode
    let diff :: Integer
diff = Integer
tEstimate Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
mEstimate
    Result -> IO Result
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Result -> IO Result) -> Result -> IO Result
forall a b. (a -> b) -> a -> b
$ case Integer -> Integer
forall a. Num a => a -> a
signum Integer
diff of
      (-1) -> String -> Result
testFailed (String -> Result) -> (Integer -> String) -> Integer -> Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Integer) -> (String, Integer) -> Integer -> String
renderFailed (String
tName, Integer
tEstimate) (String
mName, Integer
mEstimate) (Integer -> Result) -> Integer -> Result
forall a b. (a -> b) -> a -> b
$ Integer
diff
      Integer
0    -> String -> Result
testPassed (String -> Result)
-> ((String, Integer) -> String) -> (String, Integer) -> Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Integer) -> (String, Integer) -> String
renderEstimates (String
tName, Integer
tEstimate) ((String, Integer) -> Result) -> (String, Integer) -> Result
forall a b. (a -> b) -> a -> b
$ (String
mName, Integer
mEstimate)
      Integer
_    -> String -> Result
testPassed (String -> Result) -> (Integer -> String) -> Integer -> Result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Integer) -> (String, Integer) -> Integer -> String
renderExcess (String
tName, Integer
tEstimate) (String
mName, Integer
mEstimate) (Integer -> Result) -> Integer -> Result
forall a b. (a -> b) -> a -> b
$ Integer
diff
  testOptions :: Tagged (SizeComparisonTest a) [OptionDescription]
testOptions = [OptionDescription]
-> Tagged (SizeComparisonTest a) [OptionDescription]
forall {k} (s :: k) b. b -> Tagged s b
Tagged []

renderFailed :: (String, Integer) -> (String, Integer) -> Integer -> String
renderFailed :: (String, Integer) -> (String, Integer) -> Integer -> String
renderFailed (String, Integer)
tData (String, Integer)
mData Integer
diff =
  (String, Integer) -> (String, Integer) -> String
renderEstimates (String, Integer)
tData (String, Integer)
mData
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Exceeded by: "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
diff

renderEstimates :: (String, Integer) -> (String, Integer) -> String
renderEstimates :: (String, Integer) -> (String, Integer) -> String
renderEstimates (String
tName, Integer
tEstimate) (String
mName, Integer
mEstimate) =
  String
"Target: "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tName
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"; size "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
tEstimate
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n"
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Measured: "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
mName
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"; size "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
mEstimate
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n"

renderExcess :: (String, Integer) -> (String, Integer) -> Integer -> String
renderExcess :: (String, Integer) -> (String, Integer) -> Integer -> String
renderExcess (String, Integer)
tData (String, Integer)
mData Integer
diff =
  (String, Integer) -> (String, Integer) -> String
renderEstimates (String, Integer)
tData (String, Integer)
mData
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Remaining headroom: "
    String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Integer -> String
forall a. Show a => a -> String
show Integer
diff

-- Budget testing

goldenBudget :: TestName -> CompiledCode a -> TestNested
goldenBudget :: forall a. String -> CompiledCode a -> TestNested
goldenBudget String
name CompiledCode a
compiledCode = String -> [CompiledCode a] -> TestNested
forall a.
ToUPlc a DefaultUni DefaultFun =>
String -> [a] -> TestNested
goldenUEvalBudget String
name [CompiledCode a
compiledCode]

-- Compilation testing

-- | Does not print uniques.
goldenPir ::
  (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) =>
  String ->
  CompiledCodeIn uni fun a ->
  TestNested
goldenPir :: forall (uni :: * -> *) fun a.
(PrettyUni uni, Pretty fun, Everywhere uni Flat, Flat fun) =>
String -> CompiledCodeIn uni fun a -> TestNested
goldenPir String
name CompiledCodeIn uni fun a
value =
  String -> String -> Doc Any -> TestNested
forall ann. String -> String -> Doc ann -> TestNested
nestedGoldenVsDoc String
name String
".pir"
    (Doc Any -> TestNested)
-> (Maybe (Program TyName Name uni fun ()) -> Doc Any)
-> Maybe (Program TyName Name uni fun ())
-> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any
-> (Program TyName Name uni fun () -> Doc Any)
-> Maybe (Program TyName Name uni fun ())
-> Doc Any
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Any
"PIR not found in CompiledCode" (Term TyName Name uni fun () -> Doc Any
forall a ann. PrettyClassic a => a -> Doc ann
prettyClassicSimple (Term TyName Name uni fun () -> Doc Any)
-> (Program TyName Name uni fun () -> Term TyName Name uni fun ())
-> Program TyName Name uni fun ()
-> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Term TyName Name uni fun ())
  (Program TyName Name uni fun ())
  (Term TyName Name uni fun ())
-> Program TyName Name uni fun () -> Term TyName Name uni fun ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Term TyName Name uni fun ())
  (Program TyName Name uni fun ())
  (Term TyName Name uni fun ())
forall tyname1 name1 (uni1 :: * -> *) fun1 ann tyname2 name2
       (uni2 :: * -> *) fun2 (f :: * -> *).
Functor f =>
(Term tyname1 name1 uni1 fun1 ann
 -> f (Term tyname2 name2 uni2 fun2 ann))
-> Program tyname1 name1 uni1 fun1 ann
-> f (Program tyname2 name2 uni2 fun2 ann)
progTerm)
    (Maybe (Program TyName Name uni fun ()) -> TestNested)
-> Maybe (Program TyName Name uni fun ()) -> TestNested
forall a b. (a -> b) -> a -> b
$ CompiledCodeIn uni fun a -> Maybe (Program TyName Name uni fun ())
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a -> Maybe (Program TyName Name uni fun ())
getPirNoAnn CompiledCodeIn uni fun a
value

-- | Does not print uniques.
goldenPirReadable ::
  (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) =>
  String ->
  CompiledCodeIn uni fun a ->
  TestNested
goldenPirReadable :: forall (uni :: * -> *) fun a.
(PrettyUni uni, Pretty fun, Everywhere uni Flat, Flat fun) =>
String -> CompiledCodeIn uni fun a -> TestNested
goldenPirReadable String
name CompiledCodeIn uni fun a
value =
  String -> String -> Doc Any -> TestNested
forall ann. String -> String -> Doc ann -> TestNested
nestedGoldenVsDoc String
name String
".pir"
    (Doc Any -> TestNested)
-> (Maybe (Program TyName Name uni fun ()) -> Doc Any)
-> Maybe (Program TyName Name uni fun ())
-> TestNested
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc Any
-> (Program TyName Name uni fun () -> Doc Any)
-> Maybe (Program TyName Name uni fun ())
-> Doc Any
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc Any
"PIR not found in CompiledCode" (Term TyName Name uni fun () -> Doc Any
forall a ann. PrettyReadable a => a -> Doc ann
prettyReadableSimple (Term TyName Name uni fun () -> Doc Any)
-> (Program TyName Name uni fun () -> Term TyName Name uni fun ())
-> Program TyName Name uni fun ()
-> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  (Term TyName Name uni fun ())
  (Program TyName Name uni fun ())
  (Term TyName Name uni fun ())
-> Program TyName Name uni fun () -> Term TyName Name uni fun ()
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Term TyName Name uni fun ())
  (Program TyName Name uni fun ())
  (Term TyName Name uni fun ())
forall tyname1 name1 (uni1 :: * -> *) fun1 ann tyname2 name2
       (uni2 :: * -> *) fun2 (f :: * -> *).
Functor f =>
(Term tyname1 name1 uni1 fun1 ann
 -> f (Term tyname2 name2 uni2 fun2 ann))
-> Program tyname1 name1 uni1 fun1 ann
-> f (Program tyname2 name2 uni2 fun2 ann)
progTerm)
    (Maybe (Program TyName Name uni fun ()) -> TestNested)
-> Maybe (Program TyName Name uni fun ()) -> TestNested
forall a b. (a -> b) -> a -> b
$ CompiledCodeIn uni fun a -> Maybe (Program TyName Name uni fun ())
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a -> Maybe (Program TyName Name uni fun ())
getPirNoAnn CompiledCodeIn uni fun a
value

goldenPirBy ::
  (PrettyUni uni, Pretty fun, uni `PLC.Everywhere` Flat, Flat fun) =>
  PrettyConfigClassic PrettyConfigName ->
  String ->
  CompiledCodeIn uni fun a ->
  TestNested
goldenPirBy :: forall (uni :: * -> *) fun a.
(PrettyUni uni, Pretty fun, Everywhere uni Flat, Flat fun) =>
PrettyConfigClassic PrettyConfigName
-> String -> CompiledCodeIn uni fun a -> TestNested
goldenPirBy PrettyConfigClassic PrettyConfigName
config String
name CompiledCodeIn uni fun a
value =
  String -> String -> Doc Any -> TestNested
forall ann. String -> String -> Doc ann -> TestNested
nestedGoldenVsDoc String
name String
".pir" (Doc Any -> TestNested) -> Doc Any -> TestNested
forall a b. (a -> b) -> a -> b
$
    PrettyConfigClassic PrettyConfigName
-> Maybe (Program TyName Name uni fun SrcSpans) -> Doc Any
forall ann.
PrettyConfigClassic PrettyConfigName
-> Maybe (Program TyName Name uni fun SrcSpans) -> Doc ann
forall config a ann. PrettyBy config a => config -> a -> Doc ann
prettyBy PrettyConfigClassic PrettyConfigName
config (Maybe (Program TyName Name uni fun SrcSpans) -> Doc Any)
-> Maybe (Program TyName Name uni fun SrcSpans) -> Doc Any
forall a b. (a -> b) -> a -> b
$ CompiledCodeIn uni fun a
-> Maybe (Program TyName Name uni fun SrcSpans)
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a
-> Maybe (Program TyName Name uni fun SrcSpans)
getPir CompiledCodeIn uni fun a
value

-- Evaluation testing

-- TODO: rationalize with the functions exported from PlcTestUtils
goldenEvalCek :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => String -> [a] -> TestNested
goldenEvalCek :: forall a.
ToUPlc a DefaultUni DefaultFun =>
String -> [a] -> TestNested
goldenEvalCek String
name [a]
values =
  String -> String -> IO (Doc Any) -> TestNested
forall ann. String -> String -> IO (Doc ann) -> TestNested
nestedGoldenVsDocM String
name String
".eval" (IO (Doc Any) -> TestNested) -> IO (Doc Any) -> TestNested
forall a b. (a -> b) -> a -> b
$ Term Name DefaultUni DefaultFun () -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcClassicSimple (Term Name DefaultUni DefaultFun () -> Doc Any)
-> IO (Term Name DefaultUni DefaultFun ()) -> IO (Doc Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
-> IO (Term Name DefaultUni DefaultFun ())
forall a. ExceptT SomeException IO a -> IO a
rethrow ([a]
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall a.
ToUPlc a DefaultUni DefaultFun =>
[a]
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
runPlcCek [a]
values)

goldenEvalCekCatch :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => String -> [a] -> TestNested
goldenEvalCekCatch :: forall a.
ToUPlc a DefaultUni DefaultFun =>
String -> [a] -> TestNested
goldenEvalCekCatch String
name [a]
values =
  String -> String -> IO (Doc Any) -> TestNested
forall ann. String -> String -> IO (Doc ann) -> TestNested
nestedGoldenVsDocM String
name String
".eval" (IO (Doc Any) -> TestNested) -> IO (Doc Any) -> TestNested
forall a b. (a -> b) -> a -> b
$
    (SomeException -> Doc Any)
-> (Term Name DefaultUni DefaultFun () -> Doc Any)
-> Either SomeException (Term Name DefaultUni DefaultFun ())
-> Doc Any
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Doc Any
forall ann. String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (String -> Doc Any)
-> (SomeException -> String) -> SomeException -> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SomeException -> String
forall a. Show a => a -> String
show) Term Name DefaultUni DefaultFun () -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcClassicSimple (Either SomeException (Term Name DefaultUni DefaultFun ())
 -> Doc Any)
-> IO (Either SomeException (Term Name DefaultUni DefaultFun ()))
-> IO (Doc Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
-> IO (Either SomeException (Term Name DefaultUni DefaultFun ()))
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ([a]
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
forall a.
ToUPlc a DefaultUni DefaultFun =>
[a]
-> ExceptT SomeException IO (Term Name DefaultUni DefaultFun ())
runPlcCek [a]
values)

goldenEvalCekLog :: (ToUPlc a PLC.DefaultUni PLC.DefaultFun) => String -> [a] -> TestNested
goldenEvalCekLog :: forall a.
ToUPlc a DefaultUni DefaultFun =>
String -> [a] -> TestNested
goldenEvalCekLog String
name [a]
values =
  String -> String -> IO (Doc Any) -> TestNested
forall ann. String -> String -> IO (Doc ann) -> TestNested
nestedGoldenVsDocM String
name String
".eval" (IO (Doc Any) -> TestNested) -> IO (Doc Any) -> TestNested
forall a b. (a -> b) -> a -> b
$
    [Text] -> Doc Any
forall a ann. PrettyPlc a => a -> Doc ann
prettyPlcClassicSimple ([Text] -> Doc Any)
-> (([Text], CekExTally DefaultFun,
     Term Name DefaultUni DefaultFun ())
    -> [Text])
-> ([Text], CekExTally DefaultFun,
    Term Name DefaultUni DefaultFun ())
-> Doc Any
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting
  [Text]
  ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
  [Text]
-> ([Text], CekExTally DefaultFun,
    Term Name DefaultUni DefaultFun ())
-> [Text]
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  [Text]
  ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
  [Text]
forall s t a b. Field1 s t a b => Lens s t a b
Lens
  ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
  ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
  [Text]
  [Text]
_1 (([Text], CekExTally DefaultFun,
  Term Name DefaultUni DefaultFun ())
 -> Doc Any)
-> IO
     ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
-> IO (Doc Any)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ExceptT
  SomeException
  IO
  ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
-> IO
     ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
forall a. ExceptT SomeException IO a -> IO a
rethrow (ExceptT
   SomeException
   IO
   ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
 -> IO
      ([Text], CekExTally DefaultFun,
       Term Name DefaultUni DefaultFun ()))
-> ExceptT
     SomeException
     IO
     ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
-> IO
     ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
forall a b. (a -> b) -> a -> b
$ [a]
-> ExceptT
     SomeException
     IO
     ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
forall a.
ToUPlc a DefaultUni DefaultFun =>
[a]
-> ExceptT
     SomeException
     IO
     ([Text], CekExTally DefaultFun, Term Name DefaultUni DefaultFun ())
runPlcCekTrace [a]
values)

-- Helpers

instance
  (PLC.Closed uni, uni `PLC.Everywhere` Flat, Flat fun) =>
  ToUPlc (CompiledCodeIn uni fun a) uni fun
  where
  toUPlc :: CompiledCodeIn uni fun a
-> ExceptT SomeException IO (Program Name uni fun ())
toUPlc CompiledCodeIn uni fun a
v = do
    Program NamedDeBruijn uni fun ()
v' <- Program NamedDeBruijn uni fun ()
-> ExceptT SomeException IO (Program NamedDeBruijn uni fun ())
forall a. a -> ExceptT SomeException IO a
catchAll (Program NamedDeBruijn uni fun ()
 -> ExceptT SomeException IO (Program NamedDeBruijn uni fun ()))
-> Program NamedDeBruijn uni fun ()
-> ExceptT SomeException IO (Program NamedDeBruijn uni fun ())
forall a b. (a -> b) -> a -> b
$ CompiledCodeIn uni fun a -> Program NamedDeBruijn uni fun ()
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a -> Program NamedDeBruijn uni fun ()
getPlcNoAnn CompiledCodeIn uni fun a
v
    Program NamedDeBruijn uni fun ()
-> ExceptT SomeException IO (Program Name uni fun ())
forall a (uni :: * -> *) fun.
ToUPlc a uni fun =>
a -> ExceptT SomeException IO (Program Name uni fun ())
toUPlc Program NamedDeBruijn uni fun ()
v'

instance
  ( PLC.PrettyParens (PLC.SomeTypeIn uni)
  , PLC.GEq uni
  , PLC.Typecheckable uni fun
  , PLC.Closed uni
  , uni `PLC.Everywhere` PrettyConst
  , Pretty fun
  , uni `PLC.Everywhere` Flat
  , Flat fun
  , Default (PLC.CostingPart uni fun)
  , Default (PIR.BuiltinsInfo uni fun)
  , Default (PIR.RewriteRules uni fun)
  ) =>
  ToTPlc (CompiledCodeIn uni fun a) uni fun
  where
  toTPlc :: CompiledCodeIn uni fun a
-> ExceptT SomeException IO (Program TyName Name uni fun ())
toTPlc CompiledCodeIn uni fun a
v = do
    Maybe (Program TyName Name uni fun SrcSpans)
mayV' <- Maybe (Program TyName Name uni fun SrcSpans)
-> ExceptT
     SomeException IO (Maybe (Program TyName Name uni fun SrcSpans))
forall a. a -> ExceptT SomeException IO a
catchAll (Maybe (Program TyName Name uni fun SrcSpans)
 -> ExceptT
      SomeException IO (Maybe (Program TyName Name uni fun SrcSpans)))
-> Maybe (Program TyName Name uni fun SrcSpans)
-> ExceptT
     SomeException IO (Maybe (Program TyName Name uni fun SrcSpans))
forall a b. (a -> b) -> a -> b
$ CompiledCodeIn uni fun a
-> Maybe (Program TyName Name uni fun SrcSpans)
forall (uni :: * -> *) fun a.
(Closed uni, Everywhere uni Flat, Flat fun) =>
CompiledCodeIn uni fun a
-> Maybe (Program TyName Name uni fun SrcSpans)
getPir CompiledCodeIn uni fun a
v
    case Maybe (Program TyName Name uni fun SrcSpans)
mayV' of
      Maybe (Program TyName Name uni fun SrcSpans)
Nothing -> String -> ExceptT SomeException IO (Program TyName Name uni fun ())
forall a. String -> ExceptT SomeException IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"No PIR available"
      Just Program TyName Name uni fun SrcSpans
v' -> Program TyName Name uni fun SrcSpans
-> ExceptT SomeException IO (Program TyName Name uni fun ())
forall a (uni :: * -> *) fun.
ToTPlc a uni fun =>
a -> ExceptT SomeException IO (Program TyName Name uni fun ())
toTPlc Program TyName Name uni fun SrcSpans
v'

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]
values = do
  [Program Name DefaultUni DefaultFun ()]
ps <- (a
 -> ExceptT
      SomeException IO (Program Name DefaultUni DefaultFun ()))
-> [a]
-> ExceptT SomeException IO [Program Name DefaultUni DefaultFun ()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse 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]
values
  let p :: Program Name DefaultUni DefaultFun ()
p =
        (Program Name DefaultUni DefaultFun ()
 -> Program Name DefaultUni DefaultFun ()
 -> Program Name DefaultUni DefaultFun ())
-> [Program Name DefaultUni DefaultFun ()]
-> Program Name DefaultUni DefaultFun ()
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (Either ApplyProgramError (Program Name DefaultUni DefaultFun ())
-> Program Name DefaultUni DefaultFun ()
forall e a. Show e => Either e a -> a
unsafeFromRight (Either ApplyProgramError (Program Name DefaultUni DefaultFun ())
 -> Program Name DefaultUni DefaultFun ())
-> (Program Name DefaultUni DefaultFun ()
    -> Program Name DefaultUni DefaultFun ()
    -> Either
         ApplyProgramError (Program Name DefaultUni DefaultFun ()))
-> Program Name DefaultUni DefaultFun ()
-> Program Name DefaultUni DefaultFun ()
-> Program Name DefaultUni DefaultFun ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Program Name DefaultUni DefaultFun ()
-> Program Name DefaultUni DefaultFun ()
-> Either ApplyProgramError (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) a name (uni :: * -> *) fun.
(MonadError ApplyProgramError m, Semigroup a) =>
Program name uni fun a
-> Program name uni fun a -> m (Program name uni fun a)
UPLC.applyProgram) [Program Name DefaultUni DefaultFun ()]
ps
  (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 ()
p 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]
values = do
  [Program Name DefaultUni DefaultFun ()]
ps <- (a
 -> ExceptT
      SomeException IO (Program Name DefaultUni DefaultFun ()))
-> [a]
-> ExceptT SomeException IO [Program Name DefaultUni DefaultFun ()]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse 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]
values
  let p :: Program Name DefaultUni DefaultFun ()
p =
        (Program Name DefaultUni DefaultFun ()
 -> Program Name DefaultUni DefaultFun ()
 -> Program Name DefaultUni DefaultFun ())
-> [Program Name DefaultUni DefaultFun ()]
-> Program Name DefaultUni DefaultFun ()
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (Either ApplyProgramError (Program Name DefaultUni DefaultFun ())
-> Program Name DefaultUni DefaultFun ()
forall e a. Show e => Either e a -> a
unsafeFromRight (Either ApplyProgramError (Program Name DefaultUni DefaultFun ())
 -> Program Name DefaultUni DefaultFun ())
-> (Program Name DefaultUni DefaultFun ()
    -> Program Name DefaultUni DefaultFun ()
    -> Either
         ApplyProgramError (Program Name DefaultUni DefaultFun ()))
-> Program Name DefaultUni DefaultFun ()
-> Program Name DefaultUni DefaultFun ()
-> Program Name DefaultUni DefaultFun ()
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Program Name DefaultUni DefaultFun ()
-> Program Name DefaultUni DefaultFun ()
-> Either ApplyProgramError (Program Name DefaultUni DefaultFun ())
forall (m :: * -> *) a name (uni :: * -> *) fun.
(MonadError ApplyProgramError m, Semigroup a) =>
Program name uni fun a
-> Program name uni fun a -> m (Program name uni fun a)
UPLC.applyProgram) [Program Name DefaultUni DefaultFun ()]
ps
  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 ()
p 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)