ComparePairs.hs

-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | Module, containing spec to test compare.tz contract.
module Test.Interpreter.ComparePairs
  ( test_compare_pairs
  ) where

import Hedgehog (forAll, property, withTests)
import Test.Tasty (TestTree)
import Test.Tasty.Hedgehog (testProperty)

import Hedgehog.Gen.Tezos.Core (genMutez)
import Morley.Tezos.Core (Mutez)
import Test.Cleveland
import Test.Cleveland.Lorentz.Import (embedContract)
import Test.Cleveland.Util (genTuple2)

import Test.Util.Contracts

type Param = ((Mutez, Mutez), (Mutez, Mutez))

-- | Spec to test compare.tz contract.
test_compare_pairs :: [TestTree]
test_compare_pairs =
    [ testScenarioOnEmulator "success test" $ myScenario
          ( (10, 11)
          , (10, 12)
          )
    , testProperty "Random check" $
        withTests 200 $ property $ do
          inputParam <- forAll $ genTuple2 (genTuple2 genMutez genMutez) (genTuple2 genMutez genMutez)
          testScenarioProps $ myScenario inputParam
    ]
  where
    myScenario :: Monad m => Param -> Scenario m
    myScenario inp = scenario do
      handle <- originateSimple "compare_pairs" [] contract
      call handle CallDefault inp
      getStorage handle @@== mkExpected inp
      pure ()

    contract = $$(embedContract @Param @[Bool] @() (inContractsDir "compare_pairs.tz"))

    mkExpected :: Param -> [Bool]
    mkExpected (a, b) = [a == b, a > b, a < b, a >= b, a <= b]