Scenario.hs

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

module Test.Cleveland.Internal.Scenario
  ( Scenario(..)
  , scenario
  , scenarioEmulated
  , withInitialNow
  , withInitialLevel
  ) where

import qualified Morley.Tezos.Core as TC
import Test.Cleveland.Internal.Abstract
import Test.Cleveland.Internal.Pure

-- | A type representing a finalized scenario
data Scenario m where
  ScenarioCleveland :: ClevelandT m () -> Scenario m
  ScenarioEmulated :: EmulatedT PureM () -> Scenario PureM

-- | Finalize a generic cleveland scenario.
scenario :: ClevelandT m () -> Scenario m
scenario = ScenarioCleveland

-- | Finalize a scenario that needs emulator-only features.
scenarioEmulated :: EmulatedT PureM () -> Scenario PureM
scenarioEmulated = ScenarioEmulated

withModifiedState
  :: (PureState -> PureState)
  -> Scenario PureM
  -> Scenario PureM
withModifiedState modfn = \case
  ScenarioEmulated emulated ->
    ScenarioEmulated $ lift (modify modfn) >> emulated
  ScenarioCleveland cleveland ->
    ScenarioCleveland $ lift (modify modfn) >> cleveland

-- | Use with an emulated 'Scenario' to configure the initial @now@ value in tests.
--
-- Example :
-- > withInitialNow (Timestamp 10000000) $ testScenarioOnEmulator "Testname" $ scenarioEmulated $ tests
-- > withInitialNow (Timestamp 10000000) $ testScenarioOnEmulator "Testname" $ scenario $ tests
withInitialNow
  :: TC.Timestamp
  -> Scenario PureM
  -> Scenario PureM
withInitialNow = withModifiedState . set psNow

-- | Similar to 'withInitialNow' but for the initial level
withInitialLevel
  :: Natural
  -> Scenario PureM
  -> Scenario PureM
withInitialLevel = withModifiedState . set psLevel