Decomposition.hs

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

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

import Prelude

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

import Hedgehog.Gen.Michelson (genMText)
import Morley.Michelson.Text (mt)
import Test.Cleveland.Util (genTuple2)
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 def

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
  -> Storage
setDecomposedVariableCheck (c, (x, y)) Storage{..} = Storage c x y (Meta 0 (mDescr sMeta))

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

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