diff --git a/plutus-playground-client/src/Action.purs b/plutus-playground-client/src/Action.purs index 0cfba75987c..0038de57fc7 100644 --- a/plutus-playground-client/src/Action.purs +++ b/plutus-playground-client/src/Action.purs @@ -9,8 +9,8 @@ import Cursor as Cursor import Data.Array (mapWithIndex) import Data.Array as Array import Data.Int as Int -import Data.Lens (view) -import Data.Maybe (Maybe(..), fromMaybe, maybe) +import Data.Lens (preview, view) +import Data.Maybe (Maybe(..), fromMaybe, isJust, maybe) import Data.Tuple (Tuple(..)) import Data.Tuple.Nested ((/\)) import Halogen (HTML) @@ -26,10 +26,11 @@ import Icons (Icon(..), icon) import Network.RemoteData (RemoteData(Loading, NotAsked, Failure, Success)) import Playground.API (EvaluationResult, _Fn, _FunctionSchema) import Prelude (map, pure, show, (#), ($), (+), (/=), (<$>), (<<<), (<>), (==)) -import Types (Action(Wait, Action), ActionEvent(AddWaitAction, SetWaitTime, RemoveAction), Blockchain, ChildQuery, ChildSlot, FormEvent(..), Query(..), SimpleArgument(..), Simulation(Simulation), WebData, _argumentSchema, _functionName, _resultBlockchain, _simulatorWalletWallet) +import Types (Action(Wait, Action), ActionEvent(AddWaitAction, SetWaitTime, RemoveAction), Blockchain, ChildQuery, ChildSlot, FormEvent(..), Query(..), SimpleArgument(..), Simulation(Simulation), WebData, _Action, _argumentSchema, _functionName, _resultBlockchain, _simulatorWallet, _simulatorWalletWallet, _walletId) import Validation (ValidationError, WithPath, joinPath, showPathValue, validate) import ValueEditor (valueForm) import Wallet (walletIdPane, walletsPane) +import Wallet.Emulator.Types (Wallet) simulationPane :: forall m aff. @@ -40,12 +41,20 @@ simulationPane :: simulationPane simulations evaluationResult = case current simulations of Just (Simulation simulation) -> - div_ - [ simulationsNav simulations - , walletsPane simulation.signatures simulation.wallets - , br_ - , actionsPane simulation.actions (view _resultBlockchain <$> evaluationResult) - ] + let + isValidWallet :: Wallet -> Boolean + isValidWallet target = + isJust $ Array.find (\wallet -> view _walletId target + == + view (_simulatorWalletWallet <<< _walletId) wallet) + simulation.wallets + in + div_ + [ simulationsNav simulations + , walletsPane simulation.signatures simulation.wallets + , br_ + , actionsPane isValidWallet simulation.actions (view _resultBlockchain <$> evaluationResult) + ] Nothing -> div_ [ text "Click the " @@ -107,25 +116,31 @@ addSimulationControl = ] [ icon Plus ] -actionsPane :: forall p. Array Action -> WebData Blockchain -> HTML p Query -actionsPane actions evaluationResult = +actionsPane :: forall p. (Wallet -> Boolean) -> Array Action -> WebData Blockchain -> HTML p Query +actionsPane isValidWallet actions evaluationResult = div_ [ h2_ [ text "Actions" ] , p_ [ text "This is your action sequence. Click 'Evaluate' to run these actions against a simulated blockchain." ] , Keyed.div [ classes [ ClassName "actions", row ] ] - (Array.snoc (mapWithIndex actionPane actions) addWaitActionPane) + (Array.snoc (mapWithIndex (actionPane isValidWallet) actions) addWaitActionPane) , br_ , row_ [ evaluateActionsPane evaluationResult actions ] , br_ , div_ [ small_ [ text "Run this set of actions against a simulated blockchain." ] ] ] -actionPane :: forall p. Int -> Action -> Tuple String (HTML p Query) -actionPane index action = +actionPane :: forall p. (Wallet -> Boolean) -> Int -> Action -> Tuple String (HTML p Query) +actionPane isValidWallet index action = Tuple (show index) $ col4_ - [ div [ classes [ ClassName "action", ClassName ("action-" <> show index) ] ] + [ div [ classes [ ClassName "action" + , ClassName ("action-" <> show index) + , ClassName ("action-" <> (case isValidWallet <$> (preview (_Action <<< _simulatorWallet <<< _simulatorWalletWallet) action) of + Just true -> "valid-wallet" + _ -> "invalid-wallet")) + ] + ] [ div [ class_ card ] [ cardBody_ [ div diff --git a/plutus-playground-client/src/Types.purs b/plutus-playground-client/src/Types.purs index f35f12d1ec5..0e3ba5fb367 100644 --- a/plutus-playground-client/src/Types.purs +++ b/plutus-playground-client/src/Types.purs @@ -47,6 +47,9 @@ import Test.QuickCheck.Gen as Gen import Validation (class Validation, ValidationError(Unsupported, Required), WithPath, addPath, noPath, validate) import Wallet.Emulator.Types (Wallet, _Wallet) +_simulatorWallet :: forall r a. Lens' { simulatorWallet :: a | r } a +_simulatorWallet = prop (SProxy :: SProxy "simulatorWallet") + _simulatorWalletWallet :: Lens' SimulatorWallet Wallet _simulatorWalletWallet = _SimulatorWallet <<< prop (SProxy :: SProxy "simulatorWalletWallet") diff --git a/plutus-playground-client/static/main.scss b/plutus-playground-client/static/main.scss index 3004b35ac91..33a8d38f023 100644 --- a/plutus-playground-client/static/main.scss +++ b/plutus-playground-client/static/main.scss @@ -135,6 +135,9 @@ table.balance-map { margin-left: 1rem; } } + .action-invalid-wallet { + border: solid 1px $red; + } } .logs {