-- SPDX-FileCopyrightText: 2021 Oxhead Alpha -- SPDX-License-Identifier: LicenseRef-MIT-OA -- | Module, containing spec to test compare.tz contract. module Test.Interpreter.ComparableSet ( test_comparable_set ) where import Data.Set as Set (fromList, toList) import Hedgehog (forAll, property, withTests) import Hedgehog.Gen qualified as Gen import Hedgehog.Range qualified as Range import Test.Tasty (TestTree) import Test.Tasty.Hedgehog (testProperty) import Morley.Michelson.Interpret (ContractReturn) import Morley.Michelson.Typed (ToT) import Test.Cleveland import Test.Cleveland.Michelson.Import (embedContract) import Test.Cleveland.Util (genTuple2) import Test.Util.Contracts type Param = Set (Integer, Integer) type HContractStorage = Maybe (Integer, Integer) type ContractResult = ContractReturn (ToT HContractStorage) -- | Spec to test comparable_set.tz contract. test_comparable_set :: [TestTree] test_comparable_set = [ testScenarioOnEmulator "success test" $ myScenario (fromList [ (10, 11) , (10, 12)]) , testProperty "Random check" $ withTests 200 $ property $ do let genInteger = Gen.integral (Range.linearFrom 0 -1000 1000) inputParam <- forAll $ Gen.set (Range.linear 0 100) (genTuple2 genInteger genInteger) testScenarioProps $ myScenario inputParam ] where contract = $$(embedContract @(ToT Param) @(ToT HContractStorage) (inContractsDir "comparable_set.tz")) myScenario :: Monad m => Param -> Scenario m myScenario inp = scenario do handle <- originateTypedSimple @Param @HContractStorage @() "compare" Nothing contract call handle CallDefault inp getStorage handle @@== mkExpected inp pure () mkExpected :: Param -> HContractStorage mkExpected = fmap maximum . nonEmpty . Set.toList