{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}

module PlutusLedgerApi.Test.V4.EvaluationContext
  ( costModelParamsForTesting
  , mCostModel
  , clearMachineCostModel
  , clearBuiltinCostModel
  ) where

import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
import PlutusLedgerApi.Test.Common.EvaluationContext as Common
import PlutusLedgerApi.V4 qualified as V4

import Data.Int (Int64)
import Data.Map qualified as Map
import GHC.Stack (HasCallStack)

{-| Example values of costs for @PlutusV4@, in expected ledger order.
Suitable to be used in testing. -}
costModelParamsForTesting :: HasCallStack => [(V4.ParamName, Int64)]
costModelParamsForTesting :: HasCallStack => [(ParamName, Int64)]
costModelParamsForTesting =
  case MCostModel -> Maybe (Map ParamName Int64)
forall p.
(IsParamName p, Ord p) =>
MCostModel -> Maybe (Map p Int64)
Common.extractCostModelParamsLedgerOrder MCostModel
mCostModel of
    Maybe (Map ParamName Int64)
Nothing -> [Char] -> [(ParamName, Int64)]
forall a. HasCallStack => [Char] -> a
error [Char]
"extractCostModelParamsLedgerOrder (V4): nothing extracted"
    Just Map ParamName Int64
xs -> Map ParamName Int64 -> [(ParamName, Int64)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ParamName Int64
xs

{-| The PlutusV4 "cost model" is the full cost model: there is no later ledger
language whose introductions would have to be cleared. -}
mCostModel :: MCostModel
mCostModel :: MCostModel
mCostModel = CostModel CekMachineCosts BuiltinCostModel -> MCostModel
toMCostModel CostModel CekMachineCosts BuiltinCostModel
defaultCekCostModelForTesting

{-| Assign to `mempty` those CEK constructs that @PlutusV4@ introduces (indirectly by introducing
a ledger language version with those CEK constructs).

This can be used to generate a (machine) cost model of the previous plutus version,
by omitting the generation of the costs concerning the missing @PlutusV4@ CEK constructs. -}
clearMachineCostModel :: m ~ MCekMachineCosts => m -> m
clearMachineCostModel :: forall m. (m ~ MCekMachineCosts) => m -> m
clearMachineCostModel = m -> m
forall a. a -> a
id -- PlutusV4 introduces no new CEK constructs

{-| Assign to `mempty` those builtins that the @PlutusV4@ introduces.

This can be used to generate a (builtin) cost model of the previous version
by omitting the generation of the costs concerning the missing @PlutusV4@ builtins. -}
clearBuiltinCostModel :: m ~ MBuiltinCostModel => m -> m
clearBuiltinCostModel :: forall m. (m ~ MBuiltinCostModel) => m -> m
clearBuiltinCostModel = m -> m
forall a. a -> a
id -- PlutusV4 introduces no new builtins