-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Measuring operation size of typed stuff.
module Michelson.Typed.OpSize
  ( OpSize (..)
  , U.opSizeHardLimit
  , U.smallTransferOpSize

  , instrOpSize
  , contractOpSize
  , valueOpSize
  ) where

import Michelson.Typed.Aliases
import Michelson.Typed.Convert
import Michelson.Typed.Instr
import Michelson.Typed.Scope
import Michelson.Untyped (OpSize)
import qualified Michelson.Untyped as U

-- | Estimate instruction operation size.
instrOpSize :: Instr inp out -> OpSize
instrOpSize :: Instr inp out -> OpSize
instrOpSize = [ExpandedOp] -> OpSize
U.expandedInstrsOpSize ([ExpandedOp] -> OpSize)
-> (Instr inp out -> [ExpandedOp]) -> Instr inp out -> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Instr inp out -> [ExpandedOp]
forall (inp :: [T]) (out :: [T]).
HasCallStack =>
Instr inp out -> [ExpandedOp]
instrToOps

-- | Estimate contract code operation size.
contractOpSize :: Contract cp st -> OpSize
contractOpSize :: Contract cp st -> OpSize
contractOpSize = Instr (ContractInp cp st) (ContractOut st) -> OpSize
forall (inp :: [T]) (out :: [T]). Instr inp out -> OpSize
instrOpSize (Instr (ContractInp cp st) (ContractOut st) -> OpSize)
-> (Contract cp st -> Instr (ContractInp cp st) (ContractOut st))
-> Contract cp st
-> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Contract cp st -> Instr (ContractInp cp st) (ContractOut st)
forall (cp :: T) (st :: T). Contract cp st -> ContractCode cp st
cCode

-- | Estimate value operation size.
-- TODO: [#428]: do not use 'PrintedValScope' here.
valueOpSize :: (PrintedValScope t) => Value t -> OpSize
valueOpSize :: Value t -> OpSize
valueOpSize = Value -> OpSize
U.valueOpSize (Value -> OpSize) -> (Value t -> Value) -> Value t -> OpSize
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value t -> Value
forall (t :: T). (SingI t, HasNoOp t) => Value' Instr t -> Value
untypeValue