{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell   #-}

-- TODO: Extend this to handle the different variants of the cost model
{- | A program to parse a JSON representation of costing functions for Plutus Core
   builtins and and produce a simple cost model which can be used from Agda and other
   executables -}
module PlutusCore.Evaluation.Machine.SimpleBuiltinCostModel
   ( BuiltinCostMap
   , BuiltinCostKeyMap
   , toSimpleBuiltinCostModel
   , defaultSimpleBuiltinCostModel
   ) where

import Data.Aeson.Key as Key (toText)
import Data.Aeson.KeyMap qualified as KeyMap
import Data.Aeson.THReader (readJSONFromFile)
import Data.Bifunctor
import Data.Text (Text, replace)
import PlutusCore.DataFilePaths qualified as DFP
import PlutusCore.Evaluation.Machine.CostingFun.SimpleJSON

type BuiltinCostMap = [(Text, CpuAndMemoryModel)]
type BuiltinCostKeyMap = KeyMap.KeyMap CpuAndMemoryModel

-- | The default builtin cost map.
 -- TODO: maybe we should take account of the semantic variant here.
defaultBuiltinCostKeyMap :: BuiltinCostKeyMap
defaultBuiltinCostKeyMap :: BuiltinCostKeyMap
defaultBuiltinCostKeyMap =
    $$(readJSONFromFile DFP.latestBuiltinCostModelFile)

-- replace underscores _ by dashes -
builtinName :: Text -> Text
builtinName :: Text -> Text
builtinName = HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace Text
"_" Text
"-"

toSimpleBuiltinCostModel :: BuiltinCostKeyMap -> BuiltinCostMap
toSimpleBuiltinCostModel :: BuiltinCostKeyMap -> BuiltinCostMap
toSimpleBuiltinCostModel BuiltinCostKeyMap
m = ((Key, CpuAndMemoryModel) -> (Text, CpuAndMemoryModel))
-> [(Key, CpuAndMemoryModel)] -> BuiltinCostMap
forall a b. (a -> b) -> [a] -> [b]
map ((Key -> Text)
-> (Key, CpuAndMemoryModel) -> (Text, CpuAndMemoryModel)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (Text -> Text
builtinName (Text -> Text) -> (Key -> Text) -> Key -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Key -> Text
toText)) (BuiltinCostKeyMap -> [(Key, CpuAndMemoryModel)]
forall v. KeyMap v -> [(Key, v)]
KeyMap.toList BuiltinCostKeyMap
m)

defaultSimpleBuiltinCostModel :: BuiltinCostMap
defaultSimpleBuiltinCostModel :: BuiltinCostMap
defaultSimpleBuiltinCostModel = BuiltinCostKeyMap -> BuiltinCostMap
toSimpleBuiltinCostModel BuiltinCostKeyMap
defaultBuiltinCostKeyMap