-- | Utilities for unit testing plutarch terms
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)

{- | Assert that term compiled and evaluated without errors

@since WIP
-}
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 ()

{- | Assert that term compiled correctly but evaluated with errors

@since WIP
-}
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)

{- | Assert that term failed to compile

@since WIP
-}
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

{- | Assert that term compiled and evaluated without errors and matches the expected value
note that comparison is done on AST level, not by `Eq` or `PEq`

@since WIP
-}
testEvalEqual ::
  TestName ->
  -- | Actual
  ClosedTerm a ->
  -- | Expected
  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

{- | Assert that term compiled (with specified tracing level and `TracingMode.DetTracing`) and evaluated
without errors produced traces that match expected value. Note that this succeeds even if script
evaluated to error if traces still match

@since WIP
-}
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

-- | @since WIP
data TermResult
  = FailedToCompile Text
  | FailedToEvaluate EvalError [Text]
  | Evaluated String [Text]

-- | @since WIP
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