-- | Module, containing spec to test compare.tz contract. module Test.Interpreter.ComparableSet ( test_comparable_set ) where import Data.Set as Set (fromList, toList) import Test.QuickCheck (Property, (===)) import Test.QuickCheck.Property (withMaxSuccess) import Test.Tasty (TestTree) import Test.Tasty.QuickCheck (testProperty) import Michelson.Interpret (InterpreterState, MichelsonFailed) import Michelson.Test (contractProp, testTreesWithTypedContract) import Michelson.Test.Dummy import Michelson.Test.Util (failedProp) import Michelson.Typed (ToT, fromVal) import qualified Michelson.Typed as T import Test.Util.Contracts type Param = Set (Integer, Integer) type HContractStorage = Maybe (Integer, Integer) type ContractStorage = T.Value (ToT HContractStorage) type ContractResult x = ( Either MichelsonFailed ([x], ContractStorage) , InterpreterState) -- | Spec to test comparable_set.tz contract. test_comparable_set :: IO [TestTree] test_comparable_set = testTreesWithTypedContract (inContractsDir "comparable_set.tz") $ \contract -> let contractProp' inputParam = contractProp contract (validate (mkExpected inputParam)) dummyContractEnv inputParam initStorage in pure [ testProperty "success test" $ contractProp' (fromList [ (10, 11) , (10, 12)]) , testProperty "Random check" $ withMaxSuccess 200 contractProp' ] where initStorage :: HContractStorage initStorage = Nothing mkExpected :: Param -> HContractStorage mkExpected x = case Set.toList x of [] -> Nothing _ -> Just $ maximum x validate :: HContractStorage -> ContractResult x -> Property validate e (Right ([], fromVal -> l), _) = l === e validate _ (Left _, _) = failedProp "Unexpected fail of script." validate _ _ = failedProp "Invalid result got."