ComparableSet.hs

-- 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