module Plutarch.Test.Unit (
testCompileFail,
testEval,
testEvalFail,
testEvalEqual,
testEvalEqualTraces,
TermResult (..),
evalTermResult,
) where
import Data.Text (Text)
import Data.Text qualified as Text
import Plutarch.Evaluate (EvalError, evalScriptUnlimited)
import Plutarch.Internal.Other (printScript)
import Plutarch.Internal.Term (
Config (NoTracing, Tracing),
LogLevel (LogDebug),
TracingMode (DetTracing),
compile,
)
import Plutarch.Prelude
import Test.Tasty (TestName, TestTree)
import Test.Tasty.HUnit (assertEqual, assertFailure, testCase)
testEval :: TestName -> ClosedTerm a -> TestTree
testEval :: forall (a :: PType). TestName -> ClosedTerm a -> TestTree
testEval TestName
name ClosedTerm a
term = TestName -> Assertion -> TestTree
testCase TestName
name (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
case Config -> ClosedTerm a -> TermResult
forall (a :: PType). Config -> ClosedTerm a -> TermResult
evalTermResult (LogLevel -> TracingMode -> Config
Tracing LogLevel
LogDebug TracingMode
DetTracing) Term s a
ClosedTerm a
term of
FailedToCompile Text
err -> TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to compile: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Text -> TestName
Text.unpack Text
err
FailedToEvaluate EvalError
err [Text]
_ -> TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to evaluate: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> EvalError -> TestName
forall a. Show a => a -> TestName
show EvalError
err
Evaluated TestName
_ [Text]
_ -> () -> Assertion
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
testEvalFail :: TestName -> ClosedTerm a -> TestTree
testEvalFail :: forall (a :: PType). TestName -> ClosedTerm a -> TestTree
testEvalFail TestName
name ClosedTerm a
term = TestName -> Assertion -> TestTree
testCase TestName
name (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
case Config -> ClosedTerm a -> TermResult
forall (a :: PType). Config -> ClosedTerm a -> TermResult
evalTermResult Config
NoTracing Term s a
ClosedTerm a
term of
FailedToCompile Text
err -> TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to compile: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Text -> TestName
Text.unpack Text
err
FailedToEvaluate EvalError
_ [Text]
_ -> () -> Assertion
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
Evaluated TestName
script [Text]
_ -> TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName
"Evaluated, but expected failure:\n" TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
script)
testCompileFail :: TestName -> ClosedTerm a -> TestTree
testCompileFail :: forall (a :: PType). TestName -> ClosedTerm a -> TestTree
testCompileFail TestName
name ClosedTerm a
term = TestName -> Assertion -> TestTree
testCase TestName
name (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
case Config -> ClosedTerm a -> TermResult
forall (a :: PType). Config -> ClosedTerm a -> TermResult
evalTermResult Config
NoTracing Term s a
ClosedTerm a
term of
FailedToCompile Text
_ -> () -> Assertion
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()
FailedToEvaluate EvalError
err [Text]
_ -> TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to evaluate: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> EvalError -> TestName
forall a. Show a => a -> TestName
show EvalError
err
Evaluated TestName
script [Text]
_ -> TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$ TestName
"Evaluated, but expected failure: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
script
testEvalEqual ::
TestName ->
ClosedTerm a ->
ClosedTerm a ->
TestTree
testEvalEqual :: forall (a :: PType).
TestName -> ClosedTerm a -> ClosedTerm a -> TestTree
testEvalEqual TestName
name ClosedTerm a
term ClosedTerm a
expectedTerm = TestName -> Assertion -> TestTree
testCase TestName
name (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ do
TestName
actual <- case Config -> ClosedTerm a -> TermResult
forall (a :: PType). Config -> ClosedTerm a -> TermResult
evalTermResult Config
NoTracing Term s a
ClosedTerm a
term of
FailedToCompile Text
err -> TestName -> IO TestName
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> IO TestName) -> TestName -> IO TestName
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to compile: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Text -> TestName
Text.unpack Text
err
FailedToEvaluate EvalError
err [Text]
_ -> TestName -> IO TestName
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> IO TestName) -> TestName -> IO TestName
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to evaluate: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> EvalError -> TestName
forall a. Show a => a -> TestName
show EvalError
err
Evaluated TestName
script [Text]
_ -> TestName -> IO TestName
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure TestName
script
case Config -> ClosedTerm a -> TermResult
forall (a :: PType). Config -> ClosedTerm a -> TermResult
evalTermResult Config
NoTracing Term s a
ClosedTerm a
expectedTerm of
FailedToCompile Text
err -> TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to compile expected term: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Text -> TestName
Text.unpack Text
err
FailedToEvaluate EvalError
err [Text]
_ -> TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to evaluate expected term: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> EvalError -> TestName
forall a. Show a => a -> TestName
show EvalError
err
Evaluated TestName
expected [Text]
_ -> TestName -> TestName -> TestName -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual TestName
"" TestName
expected TestName
actual
testEvalEqualTraces :: TestName -> ClosedTerm a -> LogLevel -> [Text] -> TestTree
testEvalEqualTraces :: forall (a :: PType).
TestName -> ClosedTerm a -> LogLevel -> [Text] -> TestTree
testEvalEqualTraces TestName
name ClosedTerm a
term LogLevel
traceLevel [Text]
expected = TestName -> Assertion -> TestTree
testCase TestName
name (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
case Config -> ClosedTerm a -> TermResult
forall (a :: PType). Config -> ClosedTerm a -> TermResult
evalTermResult (LogLevel -> TracingMode -> Config
Tracing LogLevel
traceLevel TracingMode
DetTracing) Term s a
ClosedTerm a
term of
FailedToCompile Text
err -> TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> Assertion) -> TestName -> Assertion
forall a b. (a -> b) -> a -> b
$ TestName
"Failed to compile: " TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> Text -> TestName
Text.unpack Text
err
FailedToEvaluate EvalError
_ [Text]
traces -> TestName -> [Text] -> [Text] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual TestName
"" [Text]
expected [Text]
traces
Evaluated TestName
_ [Text]
traces -> TestName -> [Text] -> [Text] -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual TestName
"" [Text]
expected [Text]
traces
data TermResult
= FailedToCompile Text
| FailedToEvaluate EvalError [Text]
| Evaluated String [Text]
evalTermResult :: Config -> ClosedTerm a -> TermResult
evalTermResult :: forall (a :: PType). Config -> ClosedTerm a -> TermResult
evalTermResult 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
Left Text
err -> Text -> TermResult
FailedToCompile Text
err
Right Script
compiledTerm ->
case Script -> (Either EvalError Script, ExBudget, [Text])
evalScriptUnlimited Script
compiledTerm of
(Left EvalError
err, ExBudget
_, [Text]
traces) -> EvalError -> [Text] -> TermResult
FailedToEvaluate EvalError
err [Text]
traces
(Right Script
evaluated, ExBudget
_, [Text]
traces) -> TestName -> [Text] -> TermResult
Evaluated (Script -> TestName
printScript Script
evaluated) [Text]
traces