MapOption.hs

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

-- | Tests for 'map' instruction over 'Maybe' (a.k.a. @option@)
module Test.Lorentz.Instr.MapOption
  ( test_mapOption
  ) where

import Hedgehog (forAll, property)
import Hedgehog.Gen qualified as Gen
import Hedgehog.Range qualified as Range
import Lorentz
import Prelude hiding (drop, map)
import Test.Tasty.Hedgehog

import Test.Tasty (TestTree)

import Test.Cleveland

exampleMapContract :: Contract (Maybe Integer) Integer ()
exampleMapContract = defaultContract $
  unpair #
  map (add # push @Natural 0) #
  drop #
  nil #
  pair

test_mapOption :: [TestTree]
test_mapOption =
  [ testScenario "MAP over option int" $ scenario do
      handle <- originateSimple "map example contract" 123 exampleMapContract
      call handle CallDefault Nothing
      getStorage handle @@== 123
      call handle CallDefault (Just 321)
      getStorage handle @@== 444
      call handle CallDefault Nothing
      getStorage handle @@== 444
  , testProperty "MAP over option int randomized test" $ property do
      let intGen = Gen.integral (Range.linear -10000 10000)
      st <- forAll intGen
      arg <- forAll $ Gen.maybe intGen
      testScenarioProps $ scenario do
        handle <- originateSimple "map example contract" st exampleMapContract
        call handle CallDefault arg
        getStorage handle @@== (fromMaybe 0 arg + st)
  ]