-- 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 :: forall (oty :: OriginationType).
ODContractAndStorage oty -> Either TcError SomeContractAndStorage
typeCheckODContractAndStorageIfNeeded = \case
  ODContractAndStorageUntyped{Value
Contract
uodContract :: ODContractAndStorage 'OTUntyped -> Contract
uodStorage :: ODContractAndStorage 'OTUntyped -> Value
uodContract :: Contract
uodStorage :: Value
..} ->
    TypeCheckOptions
-> TypeCheckResult ExpandedOp SomeContractAndStorage
-> Either TcError SomeContractAndStorage
forall op a.
TypeCheckOptions -> TypeCheckResult op a -> Either (TcError' op) a
typeCheckingWith TypeCheckOptions
forall a. Default a => a
def (TypeCheckResult ExpandedOp SomeContractAndStorage
 -> Either TcError SomeContractAndStorage)
-> TypeCheckResult ExpandedOp SomeContractAndStorage
-> Either TcError SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$ Contract
-> Value -> TypeCheckResult ExpandedOp SomeContractAndStorage
typeCheckContractAndStorage Contract
uodContract Value
uodStorage
  ODContractAndStorageTyped{st
Contract (ToT cp) (ToT st)
todContract :: forall st vd cp.
ODContractAndStorage ('OTTypedMorley cp st vd)
-> Contract (ToT cp) (ToT st)
todStorage :: forall st vd cp.
ODContractAndStorage ('OTTypedMorley cp st vd) -> st
todContract :: Contract (ToT cp) (ToT st)
todStorage :: st
..} | T.Contract{} <- Contract (ToT cp) (ToT st)
todContract ->
    SomeContractAndStorage -> Either TcError SomeContractAndStorage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeContractAndStorage -> Either TcError SomeContractAndStorage)
-> SomeContractAndStorage -> Either TcError SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$ Contract (ToT cp) (ToT st)
-> Value (ToT st) -> SomeContractAndStorage
forall (cp :: T) (st :: T).
(StorageScope st, ParameterScope cp) =>
Contract cp st -> Value st -> SomeContractAndStorage
T.SomeContractAndStorage Contract (ToT cp) (ToT st)
todContract (st -> Value (ToT st)
forall a. IsoValue a => a -> Value (ToT a)
T.toVal st
todStorage)
  ODContractAndStorageLorentz{st
Contract param st vd
odContract :: forall st param vd.
ODContractAndStorage ('OTTypedLorentz param st vd)
-> Contract param st vd
odStorage :: forall st param vd.
ODContractAndStorage ('OTTypedLorentz param st vd) -> st
odContract :: Contract param st vd
odStorage :: st
..} | L.Contract{} <- Contract param st vd
odContract ->
    SomeContractAndStorage -> Either TcError SomeContractAndStorage
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeContractAndStorage -> Either TcError SomeContractAndStorage)
-> SomeContractAndStorage -> Either TcError SomeContractAndStorage
forall a b. (a -> b) -> a -> b
$ Contract (ToT param) (ToT st)
-> Value (ToT st) -> SomeContractAndStorage
forall (cp :: T) (st :: T).
(StorageScope st, ParameterScope cp) =>
Contract cp st -> Value st -> SomeContractAndStorage
T.SomeContractAndStorage (Contract param st vd -> Contract (ToT param) (ToT st)
forall cp st vd. Contract cp st vd -> Contract (ToT cp) (ToT st)
L.toMichelsonContract Contract param st vd
odContract) (st -> Value (ToT st)
forall a. IsoValue a => a -> Value (ToT a)
T.toVal st
odStorage)