-- editorconfig-checker-disable-file
{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE StrictData           #-}
{-# LANGUAGE UndecidableInstances #-}

module UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts
    ( CekMachineCosts
    , CekMachineCostsBase(..)
    , cekMachineCostsPrefix
    , unitCekMachineCosts
    )
where

import PlutusCore.Evaluation.Machine.ExBudget

import Barbies
import Control.DeepSeq
import Data.Functor.Identity
import Data.Text qualified as Text
import Deriving.Aeson
import Language.Haskell.TH.Syntax (Lift)
import NoThunks.Class

-- | The prefix of the field names in the CekMachineCosts type, used for
-- extracting the CekMachineCosts component of the ledger's cost model
-- parameters. See Note [Cost model parameters] in CostModelInterface.
cekMachineCostsPrefix :: Text.Text
cekMachineCostsPrefix :: Text
cekMachineCostsPrefix = Text
"cek"

-- | Costs for evaluating AST nodes.  Times should be specified in picoseconds, memory sizes in bytes.

type CekMachineCosts = CekMachineCostsBase Identity

data CekMachineCostsBase f =
    CekMachineCostsBase {
      forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekStartupCost :: f ExBudget  -- General overhead
    , forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekVarCost     :: f ExBudget
    , forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekConstCost   :: f ExBudget
    , forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekLamCost     :: f ExBudget
    , forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekDelayCost   :: f ExBudget
    , forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekForceCost   :: f ExBudget
    , forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekApplyCost   :: f ExBudget
    , forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekBuiltinCost :: f ExBudget
    -- ^ Just the cost of evaluating a Builtin node, not the builtin itself.
    -- There's no entry for Error since we'll be exiting anyway; also, what would
    -- happen if calling 'Error' caused the budget to be exceeded?
    , forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekConstrCost  :: f ExBudget
    , forall (f :: * -> *). CekMachineCostsBase f -> f ExBudget
cekCaseCost    :: f ExBudget
    }
    deriving stock ((forall x. CekMachineCostsBase f -> Rep (CekMachineCostsBase f) x)
-> (forall x.
    Rep (CekMachineCostsBase f) x -> CekMachineCostsBase f)
-> Generic (CekMachineCostsBase f)
forall x. Rep (CekMachineCostsBase f) x -> CekMachineCostsBase f
forall x. CekMachineCostsBase f -> Rep (CekMachineCostsBase f) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) x.
Rep (CekMachineCostsBase f) x -> CekMachineCostsBase f
forall (f :: * -> *) x.
CekMachineCostsBase f -> Rep (CekMachineCostsBase f) x
$cfrom :: forall (f :: * -> *) x.
CekMachineCostsBase f -> Rep (CekMachineCostsBase f) x
from :: forall x. CekMachineCostsBase f -> Rep (CekMachineCostsBase f) x
$cto :: forall (f :: * -> *) x.
Rep (CekMachineCostsBase f) x -> CekMachineCostsBase f
to :: forall x. Rep (CekMachineCostsBase f) x -> CekMachineCostsBase f
Generic)
    deriving anyclass ((forall (f :: * -> *) (g :: * -> *).
 (forall a. f a -> g a)
 -> CekMachineCostsBase f -> CekMachineCostsBase g)
-> FunctorB CekMachineCostsBase
forall k (b :: (k -> *) -> *).
(forall (f :: k -> *) (g :: k -> *).
 (forall (a :: k). f a -> g a) -> b f -> b g)
-> FunctorB b
forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a)
-> CekMachineCostsBase f -> CekMachineCostsBase g
$cbmap :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a)
-> CekMachineCostsBase f -> CekMachineCostsBase g
bmap :: forall (f :: * -> *) (g :: * -> *).
(forall a. f a -> g a)
-> CekMachineCostsBase f -> CekMachineCostsBase g
FunctorB, FunctorB CekMachineCostsBase
FunctorB CekMachineCostsBase =>
(forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
 Applicative e =>
 (forall a. f a -> e (g a))
 -> CekMachineCostsBase f -> e (CekMachineCostsBase g))
-> TraversableB CekMachineCostsBase
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (e :: * -> *) (f :: k -> *) (g :: k -> *).
 Applicative e =>
 (forall (a :: k). f a -> e (g a)) -> b f -> e (b g))
-> TraversableB b
forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a))
-> CekMachineCostsBase f -> e (CekMachineCostsBase g)
$cbtraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a))
-> CekMachineCostsBase f -> e (CekMachineCostsBase g)
btraverse :: forall (e :: * -> *) (f :: * -> *) (g :: * -> *).
Applicative e =>
(forall a. f a -> e (g a))
-> CekMachineCostsBase f -> e (CekMachineCostsBase g)
TraversableB, FunctorB CekMachineCostsBase
FunctorB CekMachineCostsBase =>
(forall (c :: * -> Constraint) (f :: * -> *).
 AllB c CekMachineCostsBase =>
 CekMachineCostsBase f -> CekMachineCostsBase (Product (Dict c) f))
-> ConstraintsB CekMachineCostsBase
forall k (b :: (k -> *) -> *).
FunctorB b =>
(forall (c :: k -> Constraint) (f :: k -> *).
 AllB c b =>
 b f -> b (Product (Dict c) f))
-> ConstraintsB b
forall (c :: * -> Constraint) (f :: * -> *).
AllB c CekMachineCostsBase =>
CekMachineCostsBase f -> CekMachineCostsBase (Product (Dict c) f)
$cbaddDicts :: forall (c :: * -> Constraint) (f :: * -> *).
AllB c CekMachineCostsBase =>
CekMachineCostsBase f -> CekMachineCostsBase (Product (Dict c) f)
baddDicts :: forall (c :: * -> Constraint) (f :: * -> *).
AllB c CekMachineCostsBase =>
CekMachineCostsBase f -> CekMachineCostsBase (Product (Dict c) f)
ConstraintsB)

deriving via CustomJSON '[FieldLabelModifier LowerInitialCharacter]
             (CekMachineCostsBase Identity) instance ToJSON (CekMachineCostsBase Identity)
deriving via CustomJSON '[FieldLabelModifier LowerInitialCharacter]
             (CekMachineCostsBase Identity) instance FromJSON (CekMachineCostsBase Identity)

-- This instance will omit the generation of JSON for Nothing fields,
-- (any functors which have Maybe functor at the outer layer)
deriving via CustomJSON '[OmitNothingFields, FieldLabelModifier LowerInitialCharacter]
             (CekMachineCostsBase Maybe) instance ToJSON (CekMachineCostsBase Maybe)

deriving stock instance AllBF Show f CekMachineCostsBase => Show (CekMachineCostsBase f)
deriving stock instance AllBF Eq f CekMachineCostsBase => Eq (CekMachineCostsBase f)
deriving stock instance AllBF Lift f CekMachineCostsBase => Lift (CekMachineCostsBase f)
deriving anyclass instance AllBF NFData f CekMachineCostsBase => NFData (CekMachineCostsBase f)
deriving anyclass instance AllBF NoThunks f CekMachineCostsBase => NoThunks (CekMachineCostsBase f)

-- Charge a unit CPU cost for AST nodes: this allows us to count the number of
-- times each node type is evaluated.  For actual prediction/costing we use
-- a different version of CekMachineCosts: see ExBudgetingDefaults.defaultCekMachineCosts.
unitCekMachineCosts :: CekMachineCosts
unitCekMachineCosts :: CekMachineCostsBase Identity
unitCekMachineCosts =
    CekMachineCostsBase
    { cekStartupCost :: Identity ExBudget
cekStartupCost = Identity ExBudget
zeroCost
    , cekVarCost :: Identity ExBudget
cekVarCost     = Identity ExBudget
unitCost
    , cekConstCost :: Identity ExBudget
cekConstCost   = Identity ExBudget
unitCost
    , cekLamCost :: Identity ExBudget
cekLamCost     = Identity ExBudget
unitCost
    , cekDelayCost :: Identity ExBudget
cekDelayCost   = Identity ExBudget
unitCost
    , cekForceCost :: Identity ExBudget
cekForceCost   = Identity ExBudget
unitCost
    , cekApplyCost :: Identity ExBudget
cekApplyCost   = Identity ExBudget
unitCost
    , cekBuiltinCost :: Identity ExBudget
cekBuiltinCost = Identity ExBudget
unitCost
    , cekConstrCost :: Identity ExBudget
cekConstrCost  = Identity ExBudget
unitCost
    , cekCaseCost :: Identity ExBudget
cekCaseCost    = Identity ExBudget
unitCost
    }
  where
    zeroCost :: Identity ExBudget
zeroCost = ExBudget -> Identity ExBudget
forall a. a -> Identity a
Identity (ExBudget -> Identity ExBudget) -> ExBudget -> Identity ExBudget
forall a b. (a -> b) -> a -> b
$ ExCPU -> ExMemory -> ExBudget
ExBudget ExCPU
0 ExMemory
0
    unitCost :: Identity ExBudget
unitCost = ExBudget -> Identity ExBudget
forall a. a -> Identity a
Identity (ExBudget -> Identity ExBudget) -> ExBudget -> Identity ExBudget
forall a b. (a -> b) -> a -> b
$ ExCPU -> ExMemory -> ExBudget
ExBudget ExCPU
1 ExMemory
0