module Test.Cleveland.Michelson.Entrypoints
( contractHasEntrypoints
, testContractCoversEntrypoints
, testContractMatchesEntrypoints
, mkEntrypointsMap
, hasEp
) where
import Test.Tasty (TestName, TestTree)
import Morley.Michelson.Untyped hiding (Contract)
import Morley.Michelson.Untyped qualified as U
import Test.Cleveland.Michelson.Internal.Entrypoints
hasEp :: T -> (EpName, U.Ty) -> Bool
hasEp :: T -> (EpName, Ty) -> Bool
hasEp (TOr FieldAnn
lFieldAnn FieldAnn
rFieldAnn lType :: Ty
lType@(Ty T
lT TypeAnn
_) rType :: Ty
rType@(Ty T
rT TypeAnn
_))
ep :: (EpName, Ty)
ep@(EpName -> FieldAnn
epNameToParamAnn -> FieldAnn
epAnn, Ty
epType) = [Bool] -> Element [Bool]
forall c.
(Container c, BooleanMonoid (Element c)) =>
c -> Element c
or
[ (FieldAnn
epAnn FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
lFieldAnn Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Ty
epType Ty -> Ty -> Bool
forall a. Eq a => a -> a -> Bool
== Ty
lType)
, (FieldAnn
epAnn FieldAnn -> FieldAnn -> Bool
forall a. Eq a => a -> a -> Bool
== FieldAnn
rFieldAnn Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Ty
epType Ty -> Ty -> Bool
forall a. Eq a => a -> a -> Bool
== Ty
rType)
, T -> (EpName, Ty) -> Bool
hasEp T
lT (EpName, Ty)
ep
, T -> (EpName, Ty) -> Bool
hasEp T
rT (EpName, Ty)
ep ]
hasEp T
_ (EpName, Ty)
_ = Bool
False
contractHasEntrypoints :: U.Contract -> Map EpName U.Ty -> Bool
contractHasEntrypoints :: Contract -> Map EpName Ty -> Bool
contractHasEntrypoints Contract
contract Map EpName Ty
eps = case Contract -> Map EpName Ty -> Either TcTypeError EPMismatch
contractCoversEntrypoints Contract
contract Map EpName Ty
eps of
Right EPMismatch
EPComparisonResultOK -> Bool
True
Either TcTypeError EPMismatch
_ -> Bool
False
testContractCoversEntrypoints :: TestName -> U.Contract -> Map EpName U.Ty -> TestTree
testContractCoversEntrypoints :: TestName -> Contract -> Map EpName Ty -> TestTree
testContractCoversEntrypoints = (EPMismatch -> EPMismatch)
-> TestName -> Contract -> Map EpName Ty -> TestTree
testContractEntrypoints EPMismatch -> EPMismatch
ignoreExtraEntrypoints
testContractMatchesEntrypoints :: TestName -> U.Contract -> Map EpName U.Ty -> TestTree
testContractMatchesEntrypoints :: TestName -> Contract -> Map EpName Ty -> TestTree
testContractMatchesEntrypoints = (EPMismatch -> EPMismatch)
-> TestName -> Contract -> Map EpName Ty -> TestTree
testContractEntrypoints EPMismatch -> EPMismatch
forall a. a -> a
id