{- | Utilities for golden testing

To regenerate golden tests it is enough to remove @./goldens@ directory and rerun tests
-}
module Plutarch.Test.Golden (
  GoldenTestTree,
  plutarchGolden,
  goldenGroup,
  goldenEval,
  goldenEvalFail,
) where

import Data.Aeson (ToJSON (toEncoding, toJSON), encode, object, pairs, (.=))
import Data.Bifunctor (first)
import Data.ByteString.Lazy (ByteString)
import Data.ByteString.Lazy.Char8 qualified as LBS
import Data.ByteString.Short qualified as Short
import Data.Int (Int64)
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Encoding
import Plutarch.Evaluate (EvalError, evalScript)
import Plutarch.Internal.Other (printScript)
import Plutarch.Internal.Term (
  ClosedTerm,
  Config (Tracing),
  LogLevel (LogInfo),
  Script,
  TracingMode (DetTracing),
  compile,
 )
import Plutarch.Script (Script (unScript))
import PlutusLedgerApi.Common (serialiseUPLC)
import PlutusLedgerApi.V1 (ExBudget (ExBudget), ExCPU, ExMemory)
import System.FilePath ((</>))
import Test.Tasty (TestName, TestTree, testGroup)
import Test.Tasty.Golden (goldenVsString)
import Test.Tasty.HUnit (assertFailure, testCase)

{- | Opaque type representing tree of golden tests

@since WIP
-}
data GoldenTestTree where
  GoldenTestTree :: TestName -> [GoldenTestTree] -> GoldenTestTree
  GoldenTestTreeEval :: TestName -> ClosedTerm a -> GoldenTestTree
  GoldenTestTreeEvalFail :: TestName -> ClosedTerm a -> GoldenTestTree

{- | Convert tree of golden tests into standard Tasty `TestTree`, capturing results produced
by nested golden tests

@since WIP
-}
plutarchGolden ::
  TestName ->
  -- | Base file name of golden file path.
  --
  -- e.g. @"foo"@ will result in goldens:
  --
  -- * @.//goldens//foo.bench.golden@ - With execution units and size
  --
  -- * @.//goldens//foo.uplc.eval.golden@ - With AST after evaluation
  --
  -- * @.//goldens//foo.uplc.golden@ - With AST before evaluation
  FilePath ->
  [GoldenTestTree] ->
  TestTree
plutarchGolden :: TestName -> TestName -> [GoldenTestTree] -> TestTree
plutarchGolden TestName
topName TestName
goldenPath [GoldenTestTree]
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
topName [TestTree]
testsWithGoldens
  where
    -- Implementation note: Because we want to collect all Benchmarks created by nested tests
    -- we cannot use plain TestTree for these (without hacks like passing some MVars around)
    -- so we have out own GoldenTestTree that when being converted to TestTree will execute
    -- all terms and collect the results. Additionally this ensures that goldens remain the same
    -- when using `--pattern` to filter tests because even though assertions won't run the
    -- scripts will still be evaluated

    ([TestTree]
tests', [[(TestName, Benchmark)]]
benchmarks') = [(TestTree, [(TestName, Benchmark)])]
-> ([TestTree], [[(TestName, Benchmark)]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(TestTree, [(TestName, Benchmark)])]
 -> ([TestTree], [[(TestName, Benchmark)]]))
-> [(TestTree, [(TestName, Benchmark)])]
-> ([TestTree], [[(TestName, Benchmark)]])
forall a b. (a -> b) -> a -> b
$ (GoldenTestTree -> (TestTree, [(TestName, Benchmark)]))
-> [GoldenTestTree] -> [(TestTree, [(TestName, Benchmark)])]
forall a b. (a -> b) -> [a] -> [b]
map GoldenTestTree -> (TestTree, [(TestName, Benchmark)])
mkTest [GoldenTestTree]
tests
    benchmarks :: [(TestName, Benchmark)]
benchmarks = [[(TestName, Benchmark)]] -> [(TestName, Benchmark)]
forall a. Monoid a => [a] -> a
mconcat [[(TestName, Benchmark)]]
benchmarks'
    goldenTests :: [TestTree]
goldenTests =
      [ TestName -> [TestTree] -> TestTree
testGroup
          TestName
"Golden Files"
          [ TestName -> TestName -> IO ByteString -> TestTree
goldenVsString
              (TestName
goldenPath TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
".bench.golden")
              (TestName
"goldens" TestName -> TestName -> TestName
</> TestName
goldenPath TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
".bench.golden")
              (ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [(TestName, Benchmark)] -> ByteString
mkBenchGoldenValue [(TestName, Benchmark)]
benchmarks)
          , TestName -> TestName -> IO ByteString -> TestTree
goldenVsString
              (TestName
goldenPath TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
".uplc.golden")
              (TestName
"goldens" TestName -> TestName -> TestName
</> TestName
goldenPath TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
".uplc.golden")
              (ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [(TestName, Benchmark)] -> ByteString
mkUplcGoldenValue [(TestName, Benchmark)]
benchmarks)
          , TestName -> TestName -> IO ByteString -> TestTree
goldenVsString
              (TestName
goldenPath TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
".uplc.eval.golden")
              (TestName
"goldens" TestName -> TestName -> TestName
</> TestName
goldenPath TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
".uplc.eval.golden")
              (ByteString -> IO ByteString
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [(TestName, Benchmark)] -> ByteString
mkUplcEvalGoldenValue [(TestName, Benchmark)]
benchmarks)
          ]
      ]
    testsWithGoldens :: [TestTree]
testsWithGoldens = [TestTree]
goldenTests [TestTree] -> [TestTree] -> [TestTree]
forall a. Semigroup a => a -> a -> a
<> [TestTree]
tests'

{- | Like `Test.Tasty.testGroup` but for golden tests

Goldens in the group will be prefixed by the group name

@since WIP
-}
goldenGroup :: TestName -> [GoldenTestTree] -> GoldenTestTree
goldenGroup :: TestName -> [GoldenTestTree] -> GoldenTestTree
goldenGroup = TestName -> [GoldenTestTree] -> GoldenTestTree
GoldenTestTree

{- | Like `Plutarch.Test.Unit.testEval` but will append to goldens created by enclosing `plutarchGolden`

@since WIP
-}
goldenEval :: TestName -> ClosedTerm a -> GoldenTestTree
goldenEval :: forall (a :: PType). TestName -> ClosedTerm a -> GoldenTestTree
goldenEval = TestName -> ClosedTerm a -> GoldenTestTree
forall (a :: PType). TestName -> ClosedTerm a -> GoldenTestTree
GoldenTestTreeEval

{- | Like `Plutarch.Test.Unit.testEvalFail` but will append to goldens created by enclosing `plutarchGolden`

@since WIP
-}
goldenEvalFail :: TestName -> ClosedTerm a -> GoldenTestTree
goldenEvalFail :: forall (a :: PType). TestName -> ClosedTerm a -> GoldenTestTree
goldenEvalFail = TestName -> ClosedTerm a -> GoldenTestTree
forall (a :: PType). TestName -> ClosedTerm a -> GoldenTestTree
GoldenTestTreeEvalFail

-- Internals

mkFailed :: TestName -> (e -> String) -> Either e a -> Either (TestTree, [(TestName, Benchmark)]) a
mkFailed :: forall e a.
TestName
-> (e -> TestName)
-> Either e a
-> Either (TestTree, [(TestName, Benchmark)]) a
mkFailed TestName
name e -> TestName
showErr = (e -> Either (TestTree, [(TestName, Benchmark)]) a)
-> (a -> Either (TestTree, [(TestName, Benchmark)]) a)
-> Either e a
-> Either (TestTree, [(TestName, Benchmark)]) a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((TestTree, [(TestName, Benchmark)])
-> Either (TestTree, [(TestName, Benchmark)]) a
forall a b. a -> Either a b
Left ((TestTree, [(TestName, Benchmark)])
 -> Either (TestTree, [(TestName, Benchmark)]) a)
-> (e -> (TestTree, [(TestName, Benchmark)]))
-> e
-> Either (TestTree, [(TestName, Benchmark)]) a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,[]) (TestTree -> (TestTree, [(TestName, Benchmark)]))
-> (e -> TestTree) -> e -> (TestTree, [(TestName, Benchmark)])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Assertion -> TestTree
testCase TestName
name (Assertion -> TestTree) -> (e -> Assertion) -> e -> TestTree
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure (TestName -> Assertion) -> (e -> TestName) -> e -> Assertion
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e -> TestName
showErr) a -> Either (TestTree, [(TestName, Benchmark)]) a
forall a b. b -> Either a b
Right

mkTest :: GoldenTestTree -> (TestTree, [(TestName, Benchmark)])
mkTest :: GoldenTestTree -> (TestTree, [(TestName, Benchmark)])
mkTest (GoldenTestTree TestName
name [GoldenTestTree]
tests) = (TestName -> [TestTree] -> TestTree
testGroup TestName
name [TestTree]
tests', [(TestName, Benchmark)]
benchmarks)
  where
    ([TestTree]
tests', [[(TestName, Benchmark)]]
benchmarks') = [(TestTree, [(TestName, Benchmark)])]
-> ([TestTree], [[(TestName, Benchmark)]])
forall a b. [(a, b)] -> ([a], [b])
unzip ([(TestTree, [(TestName, Benchmark)])]
 -> ([TestTree], [[(TestName, Benchmark)]]))
-> [(TestTree, [(TestName, Benchmark)])]
-> ([TestTree], [[(TestName, Benchmark)]])
forall a b. (a -> b) -> a -> b
$ (GoldenTestTree -> (TestTree, [(TestName, Benchmark)]))
-> [GoldenTestTree] -> [(TestTree, [(TestName, Benchmark)])]
forall a b. (a -> b) -> [a] -> [b]
map GoldenTestTree -> (TestTree, [(TestName, Benchmark)])
mkTest [GoldenTestTree]
tests
    benchmarks :: [(TestName, Benchmark)]
benchmarks = ([(TestName, Benchmark)] -> [(TestName, Benchmark)])
-> [[(TestName, Benchmark)]] -> [(TestName, Benchmark)]
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: Type -> Type) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (((TestName, Benchmark) -> (TestName, Benchmark))
-> [(TestName, Benchmark)] -> [(TestName, Benchmark)]
forall a b. (a -> b) -> [a] -> [b]
map ((TestName -> TestName)
-> (TestName, Benchmark) -> (TestName, Benchmark)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: Type -> Type -> Type) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((TestName
name TestName -> TestName -> TestName
forall a. Semigroup a => a -> a -> a
<> TestName
".") <>))) [[(TestName, Benchmark)]]
benchmarks'
mkTest (GoldenTestTreeEval TestName
name ClosedTerm a
term) = ((TestTree, [(TestName, Benchmark)])
 -> (TestTree, [(TestName, Benchmark)]))
-> ((TestTree, [(TestName, Benchmark)])
    -> (TestTree, [(TestName, Benchmark)]))
-> Either
     (TestTree, [(TestName, Benchmark)])
     (TestTree, [(TestName, Benchmark)])
-> (TestTree, [(TestName, Benchmark)])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TestTree, [(TestName, Benchmark)])
-> (TestTree, [(TestName, Benchmark)])
forall a. a -> a
id (TestTree, [(TestName, Benchmark)])
-> (TestTree, [(TestName, Benchmark)])
forall a. a -> a
id (Either
   (TestTree, [(TestName, Benchmark)])
   (TestTree, [(TestName, Benchmark)])
 -> (TestTree, [(TestName, Benchmark)]))
-> Either
     (TestTree, [(TestName, Benchmark)])
     (TestTree, [(TestName, Benchmark)])
-> (TestTree, [(TestName, Benchmark)])
forall a b. (a -> b) -> a -> b
$ do
  Benchmark
benchmark <- TestName
-> (Text -> TestName)
-> Either Text Benchmark
-> Either (TestTree, [(TestName, Benchmark)]) Benchmark
forall e a.
TestName
-> (e -> TestName)
-> Either e a
-> Either (TestTree, [(TestName, Benchmark)]) a
mkFailed TestName
name Text -> TestName
Text.unpack (Either Text Benchmark
 -> Either (TestTree, [(TestName, Benchmark)]) Benchmark)
-> Either Text Benchmark
-> Either (TestTree, [(TestName, Benchmark)]) Benchmark
forall a b. (a -> b) -> a -> b
$ ClosedTerm a -> Either Text Benchmark
forall (a :: PType). ClosedTerm a -> Either Text Benchmark
benchmarkTerm Term s a
ClosedTerm a
term
  Script
_ <- TestName
-> (EvalError -> TestName)
-> Either EvalError Script
-> Either (TestTree, [(TestName, Benchmark)]) Script
forall e a.
TestName
-> (e -> TestName)
-> Either e a
-> Either (TestTree, [(TestName, Benchmark)]) a
mkFailed TestName
name EvalError -> TestName
forall a. Show a => a -> TestName
show (Either EvalError Script
 -> Either (TestTree, [(TestName, Benchmark)]) Script)
-> Either EvalError Script
-> Either (TestTree, [(TestName, Benchmark)]) Script
forall a b. (a -> b) -> a -> b
$ Benchmark -> Either EvalError Script
result Benchmark
benchmark
  (TestTree, [(TestName, Benchmark)])
-> Either
     (TestTree, [(TestName, Benchmark)])
     (TestTree, [(TestName, Benchmark)])
forall a. a -> Either (TestTree, [(TestName, Benchmark)]) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (TestName -> Assertion -> TestTree
testCase TestName
name (() -> Assertion
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()), [(TestName
name, Benchmark
benchmark)])
mkTest (GoldenTestTreeEvalFail TestName
name ClosedTerm a
term) = ((TestTree, [(TestName, Benchmark)])
 -> (TestTree, [(TestName, Benchmark)]))
-> ((TestTree, [(TestName, Benchmark)])
    -> (TestTree, [(TestName, Benchmark)]))
-> Either
     (TestTree, [(TestName, Benchmark)])
     (TestTree, [(TestName, Benchmark)])
-> (TestTree, [(TestName, Benchmark)])
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (TestTree, [(TestName, Benchmark)])
-> (TestTree, [(TestName, Benchmark)])
forall a. a -> a
id (TestTree, [(TestName, Benchmark)])
-> (TestTree, [(TestName, Benchmark)])
forall a. a -> a
id (Either
   (TestTree, [(TestName, Benchmark)])
   (TestTree, [(TestName, Benchmark)])
 -> (TestTree, [(TestName, Benchmark)]))
-> Either
     (TestTree, [(TestName, Benchmark)])
     (TestTree, [(TestName, Benchmark)])
-> (TestTree, [(TestName, Benchmark)])
forall a b. (a -> b) -> a -> b
$ do
  Benchmark
benchmark <- TestName
-> (Text -> TestName)
-> Either Text Benchmark
-> Either (TestTree, [(TestName, Benchmark)]) Benchmark
forall e a.
TestName
-> (e -> TestName)
-> Either e a
-> Either (TestTree, [(TestName, Benchmark)]) a
mkFailed TestName
name Text -> TestName
Text.unpack (Either Text Benchmark
 -> Either (TestTree, [(TestName, Benchmark)]) Benchmark)
-> Either Text Benchmark
-> Either (TestTree, [(TestName, Benchmark)]) Benchmark
forall a b. (a -> b) -> a -> b
$ ClosedTerm a -> Either Text Benchmark
forall (a :: PType). ClosedTerm a -> Either Text Benchmark
benchmarkTerm Term s a
ClosedTerm a
term
  (TestTree, [(TestName, Benchmark)])
-> Either
     (TestTree, [(TestName, Benchmark)])
     (TestTree, [(TestName, Benchmark)])
forall a. a -> Either (TestTree, [(TestName, Benchmark)]) a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ((TestTree, [(TestName, Benchmark)])
 -> Either
      (TestTree, [(TestName, Benchmark)])
      (TestTree, [(TestName, Benchmark)]))
-> (TestTree, [(TestName, Benchmark)])
-> Either
     (TestTree, [(TestName, Benchmark)])
     (TestTree, [(TestName, Benchmark)])
forall a b. (a -> b) -> a -> b
$ case Benchmark -> Either EvalError Script
result Benchmark
benchmark of
    Left EvalError
_ -> (TestName -> Assertion -> TestTree
testCase TestName
name (() -> Assertion
forall a. a -> IO a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure ()), [(TestName
name, Benchmark
benchmark)])
    Right Script
_ ->
      ( TestName -> Assertion -> TestTree
testCase TestName
name (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$ TestName -> Assertion
forall a. HasCallStack => TestName -> IO a
assertFailure TestName
"Script did not terminate with error as expected"
      , [(TestName
name, Benchmark
benchmark)]
      )

benchmarkTerm :: ClosedTerm a -> Either Text Benchmark
benchmarkTerm :: forall (a :: PType). ClosedTerm a -> Either Text Benchmark
benchmarkTerm ClosedTerm a
term = do
  Script
compiled <- Config -> ClosedTerm a -> Either Text Script
forall (a :: PType). Config -> ClosedTerm a -> Either Text Script
compile Config
testConfig Term s a
ClosedTerm a
term
  let (Either EvalError Script
res, ExBudget ExCPU
cpu ExMemory
mem, [Text]
_traces) = Script -> (Either EvalError Script, ExBudget, [Text])
evalScript Script
compiled
  Benchmark -> Either Text Benchmark
forall a. a -> Either Text a
forall (f :: Type -> Type) a. Applicative f => a -> f a
pure (Benchmark -> Either Text Benchmark)
-> Benchmark -> Either Text Benchmark
forall a b. (a -> b) -> a -> b
$ ExCPU
-> ExMemory
-> Int64
-> Either EvalError Script
-> Script
-> Benchmark
Benchmark ExCPU
cpu ExMemory
mem (Script -> Int64
scriptSize Script
compiled) Either EvalError Script
res Script
compiled

testConfig :: Config
testConfig :: Config
testConfig = LogLevel -> TracingMode -> Config
Tracing LogLevel
LogInfo TracingMode
DetTracing

scriptSize :: Script -> Int64
scriptSize :: Script -> Int64
scriptSize = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> (Script -> Int) -> Script -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> Int
Short.length (ShortByteString -> Int)
-> (Script -> ShortByteString) -> Script -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Program DeBruijn DefaultUni DefaultFun () -> ShortByteString
serialiseUPLC (Program DeBruijn DefaultUni DefaultFun () -> ShortByteString)
-> (Script -> Program DeBruijn DefaultUni DefaultFun ())
-> Script
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> Program DeBruijn DefaultUni DefaultFun ()
unScript

data Benchmark = Benchmark
  { Benchmark -> ExCPU
exBudgetCPU :: ExCPU
  -- ^ CPU budget used by the script.
  , Benchmark -> ExMemory
exBudgetMemory :: ExMemory
  -- ^ Memory budget used by the script.
  , Benchmark -> Int64
scriptSizeBytes :: Int64
  -- ^ Size of Plutus script in bytes
  , Benchmark -> Either EvalError Script
result :: Either EvalError Script
  , Benchmark -> Script
unevaluated :: Script
  }
  deriving stock (Int -> Benchmark -> TestName -> TestName
[Benchmark] -> TestName -> TestName
Benchmark -> TestName
(Int -> Benchmark -> TestName -> TestName)
-> (Benchmark -> TestName)
-> ([Benchmark] -> TestName -> TestName)
-> Show Benchmark
forall a.
(Int -> a -> TestName -> TestName)
-> (a -> TestName) -> ([a] -> TestName -> TestName) -> Show a
$cshowsPrec :: Int -> Benchmark -> TestName -> TestName
showsPrec :: Int -> Benchmark -> TestName -> TestName
$cshow :: Benchmark -> TestName
show :: Benchmark -> TestName
$cshowList :: [Benchmark] -> TestName -> TestName
showList :: [Benchmark] -> TestName -> TestName
Show)

newtype PerfBenchmark = PerfBenchmark Benchmark

instance ToJSON PerfBenchmark where
  toJSON :: PerfBenchmark -> Value
toJSON (PerfBenchmark (Benchmark ExCPU
cpu ExMemory
mem Int64
size Either EvalError Script
_ Script
_)) =
    [Pair] -> Value
object
      [ Key
"exBudgetCPU" Key -> ExCPU -> Item [Pair]
forall v. ToJSON v => Key -> v -> Item [Pair]
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ExCPU
cpu
      , Key
"exBudgetMemory" Key -> ExMemory -> Item [Pair]
forall v. ToJSON v => Key -> v -> Item [Pair]
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ExMemory
mem
      , Key
"scriptSizeBytes" Key -> Int64 -> Item [Pair]
forall v. ToJSON v => Key -> v -> Item [Pair]
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int64
size
      ]
  toEncoding :: PerfBenchmark -> Encoding
toEncoding (PerfBenchmark (Benchmark ExCPU
cpu ExMemory
mem Int64
size Either EvalError Script
_ Script
_)) =
    Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
      [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat
        [ Key
"exBudgetCPU" Key -> ExCPU -> Item [Series]
forall v. ToJSON v => Key -> v -> Item [Series]
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ExCPU
cpu
        , Key
"exBudgetMemory" Key -> ExMemory -> Item [Series]
forall v. ToJSON v => Key -> v -> Item [Series]
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ExMemory
mem
        , Key
"scriptSizeBytes" Key -> Int64 -> Item [Series]
forall v. ToJSON v => Key -> v -> Item [Series]
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Int64
size
        ]

mkBenchmarkValue :: (Benchmark -> ByteString) -> [(TestName, Benchmark)] -> ByteString
mkBenchmarkValue :: (Benchmark -> ByteString) -> [(TestName, Benchmark)] -> ByteString
mkBenchmarkValue Benchmark -> ByteString
go =
  [ByteString] -> ByteString
LBS.unlines
    ([ByteString] -> ByteString)
-> ([(TestName, Benchmark)] -> [ByteString])
-> [(TestName, Benchmark)]
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((TestName, Benchmark) -> ByteString)
-> [(TestName, Benchmark)] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map
      ( \(TestName
testName, Benchmark
benchmark) ->
          [ByteString] -> ByteString
forall a. Monoid a => [a] -> a
mconcat
            [ TestName -> ByteString
encodeStringUtf8 TestName
testName
            , Item [ByteString]
ByteString
" "
            , Benchmark -> ByteString
go Benchmark
benchmark
            ]
      )

mkBenchGoldenValue :: [(TestName, Benchmark)] -> ByteString
mkBenchGoldenValue :: [(TestName, Benchmark)] -> ByteString
mkBenchGoldenValue = (Benchmark -> ByteString) -> [(TestName, Benchmark)] -> ByteString
mkBenchmarkValue (PerfBenchmark -> ByteString
forall a. ToJSON a => a -> ByteString
encode (PerfBenchmark -> ByteString)
-> (Benchmark -> PerfBenchmark) -> Benchmark -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> PerfBenchmark
PerfBenchmark)

mkUplcEvalGoldenValue :: [(TestName, Benchmark)] -> ByteString
mkUplcEvalGoldenValue :: [(TestName, Benchmark)] -> ByteString
mkUplcEvalGoldenValue = (Benchmark -> ByteString) -> [(TestName, Benchmark)] -> ByteString
mkBenchmarkValue ((EvalError -> ByteString)
-> (Script -> ByteString) -> Either EvalError Script -> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> EvalError -> ByteString
forall a b. a -> b -> a
const ByteString
"program 1.0.0 error") (TestName -> ByteString
encodeStringUtf8 (TestName -> ByteString)
-> (Script -> TestName) -> Script -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> TestName
printScript) (Either EvalError Script -> ByteString)
-> (Benchmark -> Either EvalError Script)
-> Benchmark
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> Either EvalError Script
result)

mkUplcGoldenValue :: [(TestName, Benchmark)] -> ByteString
mkUplcGoldenValue :: [(TestName, Benchmark)] -> ByteString
mkUplcGoldenValue = (Benchmark -> ByteString) -> [(TestName, Benchmark)] -> ByteString
mkBenchmarkValue (TestName -> ByteString
encodeStringUtf8 (TestName -> ByteString)
-> (Benchmark -> TestName) -> Benchmark -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Script -> TestName
printScript (Script -> TestName)
-> (Benchmark -> Script) -> Benchmark -> TestName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> Script
unevaluated)

encodeStringUtf8 :: String -> ByteString
encodeStringUtf8 :: TestName -> ByteString
encodeStringUtf8 = ByteString -> ByteString
LBS.fromStrict (ByteString -> ByteString)
-> (TestName -> ByteString) -> TestName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Encoding.encodeUtf8 (Text -> ByteString)
-> (TestName -> Text) -> TestName -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Text
Text.pack