cleveland-0.3.1: src/Test/Cleveland/Internal/Common.hs

-- SPDX-FileCopyrightText: 2023 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_HADDOCK not-home #-}

-- | Helpers common to all 'MonadCleveland' implementations
module Test.Cleveland.Internal.Common
  ( module Test.Cleveland.Internal.Common
  ) where

import Data.Default (def)

import Lorentz qualified as L
import Morley.Michelson.TypeCheck (TcError, typeCheckContractAndStorage, typeCheckingWith)
import Morley.Michelson.Typed qualified as T

import Test.Cleveland.Internal.Abstract

typeCheckODContractAndStorageIfNeeded
  :: ODContractAndStorage oty
  -> Either TcError T.SomeContractAndStorage
typeCheckODContractAndStorageIfNeeded = \case
  ODContractAndStorageUntyped{..} ->
    typeCheckingWith def $ typeCheckContractAndStorage uodContract uodStorage
  ODContractAndStorageTyped{..} | T.Contract{} <- todContract ->
    pure $ T.SomeContractAndStorage todContract (T.toVal todStorage)
  ODContractAndStorageLorentz{..} | L.Contract{} <- odContract ->
    pure $ T.SomeContractAndStorage (L.toMichelsonContract odContract) (T.toVal odStorage)