{-# LANGUAGE TypeFamilies  #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}
module PlutusLedgerApi.Test.V1.EvaluationContext
    ( costModelParamsForTesting
    , mCostModel
    , clearMachineCostModel
    , clearBuiltinCostModel
    ) where

import PlutusCore.Evaluation.Machine.MachineParameters
import PlutusLedgerApi.Test.Common.EvaluationContext as Common
import PlutusLedgerApi.Test.V2.EvaluationContext qualified as V2
import PlutusLedgerApi.V1 qualified as V1
import PlutusPrelude

import Data.Int (Int64)
import Data.Map qualified as Map
import Data.Maybe

-- | Example values of costs for @PlutusV1@, in expected ledger order.
-- Suitable to be used in testing.
costModelParamsForTesting :: [(V1.ParamName, Int64)]
costModelParamsForTesting :: [(ParamName, Int64)]
costModelParamsForTesting = Map ParamName Int64 -> [(ParamName, Int64)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map ParamName Int64 -> [(ParamName, Int64)])
-> Map ParamName Int64 -> [(ParamName, Int64)]
forall a b. (a -> b) -> a -> b
$ Maybe (Map ParamName Int64) -> Map ParamName Int64
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe (Map ParamName Int64) -> Map ParamName Int64)
-> Maybe (Map ParamName Int64) -> Map ParamName Int64
forall a b. (a -> b) -> a -> b
$
    MCostModel -> Maybe (Map ParamName Int64)
forall p.
(IsParamName p, Ord p) =>
MCostModel -> Maybe (Map p Int64)
Common.extractCostModelParamsLedgerOrder MCostModel
mCostModel

-- | The PlutusV1 "cost model" is constructed by the v2 "cost model", by clearing v2 introductions.
mCostModel :: MCostModel
mCostModel :: MCostModel
mCostModel = MCostModel
V2.mCostModel
           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
V2.clearMachineCostModel -- no changes for machine costs, so this is id
           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
V2.clearBuiltinCostModel

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

{- | Assign to `mempty` those builtins that the @PlutusV1@ 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 @PlutusV1@ builtins.
-}
clearBuiltinCostModel :: (m ~ MBuiltinCostModel) => m -> m
clearBuiltinCostModel :: forall m. (m ~ MBuiltinCostModel) => m -> m
clearBuiltinCostModel = m -> m
forall a. a -> a
id -- no PlutusV0 so nothing to clear