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

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

import PlutusCore.Evaluation.Machine.BuiltinCostModel
import PlutusCore.Evaluation.Machine.ExBudgetingDefaults
import PlutusCore.Evaluation.Machine.MachineParameters
import PlutusLedgerApi.Test.Common.EvaluationContext as Common
import PlutusLedgerApi.Test.V3.EvaluationContext qualified as V3
import PlutusLedgerApi.V2 qualified as V2
import PlutusPrelude

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

{-| Example values of costs for @PlutusV2@, in expected ledger order.
Suitable to be used in testing. -}
costModelParamsForTesting :: HasCallStack => [(V2.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 (V2): 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 PlutusV2 "cost model" is constructed by the v3 "cost model", by clearing v3 introductions.
mCostModel :: MCostModel
mCostModel :: MCostModel
mCostModel =
  CostModel CekMachineCosts BuiltinCostModel -> MCostModel
toMCostModel CostModel CekMachineCosts BuiltinCostModel
defaultCekCostModelForTestingB
    MCostModel -> (MCostModel -> MCostModel) -> MCostModel
forall a b. a -> (a -> b) -> b
& (MCekMachineCosts -> Identity MCekMachineCosts)
-> MCostModel -> Identity MCostModel
forall machinecosts1 builtincosts machinecosts2 (f :: * -> *).
Functor f =>
(machinecosts1 -> f machinecosts2)
-> CostModel machinecosts1 builtincosts
-> f (CostModel machinecosts2 builtincosts)
machineCostModel
    ((MCekMachineCosts -> Identity MCekMachineCosts)
 -> MCostModel -> Identity MCostModel)
-> (MCekMachineCosts -> MCekMachineCosts)
-> MCostModel
-> MCostModel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MCekMachineCosts -> MCekMachineCosts
forall m. (m ~ MCekMachineCosts) => m -> m
V3.clearMachineCostModel
    MCostModel -> (MCostModel -> MCostModel) -> MCostModel
forall a b. a -> (a -> b) -> b
& (MBuiltinCostModel -> Identity MBuiltinCostModel)
-> MCostModel -> Identity MCostModel
forall machinecosts builtincosts1 builtincosts2 (f :: * -> *).
Functor f =>
(builtincosts1 -> f builtincosts2)
-> CostModel machinecosts builtincosts1
-> f (CostModel machinecosts builtincosts2)
builtinCostModel
    ((MBuiltinCostModel -> Identity MBuiltinCostModel)
 -> MCostModel -> Identity MCostModel)
-> (MBuiltinCostModel -> MBuiltinCostModel)
-> MCostModel
-> MCostModel
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ MBuiltinCostModel -> MBuiltinCostModel
forall m. (m ~ MBuiltinCostModel) => m -> m
V3.clearBuiltinCostModel

{-| Assign to `mempty` those CEK constructs that @PlutusV2@ 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 @PlutusV2@ CEK constructs. -}
clearMachineCostModel :: m ~ MCekMachineCosts => m -> m
clearMachineCostModel :: forall m. (m ~ MCekMachineCosts) => m -> m
clearMachineCostModel = m -> m
forall a. a -> a
id -- nothing changed, so nothing to clear

{-| Assign to `mempty` those builtins that the @PlutusV2@ 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 @PlutusV2@ builtins. -}
clearBuiltinCostModel :: m ~ MBuiltinCostModel => m -> m
clearBuiltinCostModel :: forall m. (m ~ MBuiltinCostModel) => m -> m
clearBuiltinCostModel m
r =
  m
r
    { paramSerialiseData = mempty
    , paramVerifyEcdsaSecp256k1Signature = mempty
    , paramVerifySchnorrSecp256k1Signature = mempty
    , paramIntegerToByteString = mempty
    , paramByteStringToInteger = mempty
    }