ComparableSet.hs

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