{-# LANGUAGE DerivingVia      #-}
{-# LANGUAGE TypeApplications #-}
module PlutusLedgerApi.V2.EvaluationContext
    ( EvaluationContext
    , mkEvaluationContext
    , CostModelParams
    , assertWellFormedCostModelParams
    , machineParametersImmediate
    , machineParametersDeferred
    , toMachineParameters
    , CostModelApplyError (..)
    ) where

import PlutusLedgerApi.Common
import PlutusLedgerApi.V2.ParamName as V2

import PlutusCore.Default as Plutus (BuiltinVersion (DefaultFunV1))
import PlutusCore.Evaluation.Machine.CostModelInterface as Plutus

import Control.Monad
import Control.Monad.Except
import Control.Monad.Writer.Strict

{-|  Build the 'EvaluationContext'.

The input is a list of integer values passed from the ledger and
are expected to appear in correct order.
-}
mkEvaluationContext :: (MonadError CostModelApplyError m, MonadWriter [CostModelApplyWarn] m)
                    => [Integer] -> m EvaluationContext
mkEvaluationContext :: forall (m :: * -> *).
(MonadError CostModelApplyError m,
 MonadWriter [CostModelApplyWarn] m) =>
[Integer] -> m EvaluationContext
mkEvaluationContext = forall k (m :: * -> *).
(Enum k, Bounded k, MonadError CostModelApplyError m,
 MonadWriter [CostModelApplyWarn] m) =>
[Integer] -> m [(k, Integer)]
tagWithParamNames @V2.ParamName
                    forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k. IsParamName k => [(k, Integer)] -> CostModelParams
toCostModelParams
                    forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall (m :: * -> *).
MonadError CostModelApplyError m =>
BuiltinVersion DefaultFun -> CostModelParams -> m EvaluationContext
mkDynEvaluationContext BuiltinVersion DefaultFun
Plutus.DefaultFunV1