Decomposition.hs

-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

module Test.Decomposition
  ( test_Decomposition
  , setDecomposedVariable
  , setMaterializedVariable
  , setDecomposedField
  , pathSetDecomposedVariable
  , pathSetMaterializedVariable
  , pathSetDecomposedField
  ) where

import Prelude

import Hedgehog (Gen)
import qualified Hedgehog.Gen as Gen
import qualified Hedgehog.Range as Range
import Test.Tasty (TestTree)

import Michelson.Interpret (MichelsonFailed(..))
import Michelson.Test.Util (genTuple2)
import Michelson.Text (genMText, mt)
import Test.Code.Decomposition
import Test.Util

test_Decomposition :: [TestTree]
test_Decomposition =
  [ testIndigoContract "Set storage to a Decomposed variable"
      (genTuple2 genColor (genTuple2 genInteger genInteger))
      genStorage
      (validateContractSt setDecomposedVariableCheck)
      setDecomposedVariable
      pathSetDecomposedVariable
  , testIndigoContract "Set storage to a Materialized variable"
      (genTuple2 genColor (genTuple2 genInteger genInteger))
      genStorage
      (validateContractSt setMaterializedVariableCheck)
      setMaterializedVariable
      pathSetMaterializedVariable
  , testIndigoContract "Set storage field"
      (genTuple2 genColor genInteger)
      genStorage
      (validateContractSt setDecomposedFieldCheck)
      setDecomposedField
      pathSetDecomposedField
  ]

pathSetDecomposedVariable :: FilePath
pathSetDecomposedVariable = "test/contracts/golden/decomposed/set_decomposed_variable.tz"

pathSetMaterializedVariable :: FilePath
pathSetMaterializedVariable = "test/contracts/golden/decomposed/set_cell_variable.tz"

pathSetDecomposedField :: FilePath
pathSetDecomposedField = "test/contracts/golden/decomposed/set_decomposed_field.tz"

genInteger :: Gen Integer
genInteger = Gen.integral (Range.linearFrom 0 -1000 1000)

genMeta :: Gen Meta
genMeta = Meta <$> Gen.integral (Range.linearFrom 0 -1000 1000) <*> genMText

genColor :: Gen Color
genColor = Gen.enumBounded

genStorage :: Gen Storage
genStorage = Storage
  <$> genColor
  <*> Gen.integral (Range.linearFrom 0 -1000 1000)
  <*> Gen.integral (Range.linearFrom 0 -1000 1000)
  <*> genMeta

------------------------------

setDecomposedVariableCheck
  :: (Color, (Integer, Integer))
  -> Storage
  -> Either MichelsonFailed Storage
setDecomposedVariableCheck (c, (x, y)) Storage{..} =
  Right $ Storage c x y (Meta 0 (mDescr sMeta))

setMaterializedVariableCheck
  :: (Color, (Integer, Integer))
  -> Storage
  -> Either MichelsonFailed Storage
setMaterializedVariableCheck (c, (x, y)) Storage{..} =
  Right $ Storage c x y (Meta 0 [mt|"hello, Ivan!"|])

setDecomposedFieldCheck
  :: (Color, Integer)
  -> Storage
  -> Either MichelsonFailed Storage
setDecomposedFieldCheck (c, w) Storage{..} =
  Right $ Storage c sX sY (Meta w (mDescr sMeta))