Preserving simulation state after a failed compilation.

plutus-playground-client/src/MainFrame/Lenses.purs

@@ -12,6 +12,7 @@ module MainFrame.Lenses
   , _lastEvaluatedSimulation
   , _compilationResult
   , _successfulCompilationResult
+  , _lastSuccessfulCompilationResult
   , _authStatus
   , _createGistResult
   , _gistUrl
@@ -45,8 +46,8 @@ import Data.Maybe (Maybe, fromMaybe)
 import Data.Symbol (SProxy(..))
 import Editor.Types (State) as Editor
 import Gist (Gist)
-import Language.Haskell.Interpreter (InterpreterError, InterpreterResult, SourceCode, _InterpreterResult)
-import MainFrame.Types (State, View, WebData)
+import Language.Haskell.Interpreter (InterpreterResult, SourceCode, _InterpreterResult)
+import MainFrame.Types (State, View, WebCompilationResult, WebData)
 import Network.RemoteData (_Success)
 import Playground.Types (CompilationResult, ContractCall, ContractDemo, EvaluationResult, FunctionSchema, KnownCurrency, PlaygroundError, Simulation, SimulatorWallet)
 import Plutus.V1.Ledger.Crypto (PubKeyHash)
@@ -89,12 +90,15 @@ _successfulEvaluationResult = _evaluationResult <<< _Success <<< _Right
 _lastEvaluatedSimulation :: Lens' State (Maybe Simulation)
 _lastEvaluatedSimulation = _Newtype <<< prop (SProxy :: SProxy "lastEvaluatedSimulation")
 
-_compilationResult :: Lens' State (WebData (Either InterpreterError (InterpreterResult CompilationResult)))
+_compilationResult :: Lens' State WebCompilationResult
 _compilationResult = _Newtype <<< prop (SProxy :: SProxy "compilationResult")
 
 _successfulCompilationResult :: Traversal' State CompilationResult
 _successfulCompilationResult = _compilationResult <<< _Success <<< _Right <<< _InterpreterResult <<< _result
 
+_lastSuccessfulCompilationResult :: Lens' State WebCompilationResult
+_lastSuccessfulCompilationResult = _Newtype <<< prop (SProxy :: SProxy "lastSuccessfulCompilationResult")
+
 _authStatus :: Lens' State (WebData AuthStatus)
 _authStatus = _Newtype <<< prop (SProxy :: SProxy "authStatus")
 

plutus-playground-client/src/MainFrame/State.purs

@@ -55,7 +55,7 @@ import Halogen as H
 import Halogen.HTML (HTML)
 import Halogen.Query (HalogenM)
 import Language.Haskell.Interpreter (CompilationError(..), InterpreterError(..), InterpreterResult, SourceCode(..), _InterpreterResult)
-import MainFrame.Lenses (_actionDrag, _authStatus, _blockchainVisualisationState, _compilationResult, _contractDemos, _createGistResult, _currentDemoName, _currentView, _demoFilesMenuVisible, _editorState, _evaluationResult, _functionSchema, _gistErrorPaneVisible, _gistUrl, _lastEvaluatedSimulation, _knownCurrencies, _result, _resultRollup, _simulationActions, _simulationId, _simulationWallets, _simulations, _successfulCompilationResult, _successfulEvaluationResult, getKnownCurrencies)
+import MainFrame.Lenses (_actionDrag, _authStatus, _blockchainVisualisationState, _compilationResult, _contractDemos, _createGistResult, _currentDemoName, _currentView, _demoFilesMenuVisible, _editorState, _evaluationResult, _functionSchema, _gistErrorPaneVisible, _gistUrl, _lastEvaluatedSimulation, _lastSuccessfulCompilationResult, _knownCurrencies, _result, _resultRollup, _simulationActions, _simulationId, _simulationWallets, _simulations, _successfulCompilationResult, _successfulEvaluationResult, getKnownCurrencies)
 import MainFrame.MonadApp (class MonadApp, editorGetContents, editorHandleAction, editorSetAnnotations, editorSetContents, getGistByGistId, getOauthStatus, patchGistByGistId, postContract, postEvaluation, postGist, preventDefault, resizeBalancesChart, resizeEditor, runHalogenApp, saveBuffer, scrollIntoView, setDataTransferData, setDropEffect)
 import MainFrame.Types (ChildSlots, DragAndDropEventType(..), HAction(..), Query, State(..), View(..), WalletEvent(..), WebData)
 import MainFrame.View (render)
@@ -104,6 +104,7 @@ mkInitialState editorState = do
         , contractDemos
         , currentDemoName: Nothing
         , compilationResult: NotAsked
+        , lastSuccessfulCompilationResult: NotAsked
         , simulations: Cursor.empty
         , actionDrag: Nothing
         , evaluationResult: NotAsked
@@ -256,6 +257,7 @@ handleAction (LoadScript key) = do
       assign (_editorState <<< _lastCompiledCode) (Just contractDemoEditorContents)
       assign (_editorState <<< _currentCodeIsCompiled) true
       assign _compilationResult (Success <<< Right $ contractDemoContext)
+      assign _lastSuccessfulCompilationResult (Success <<< Right $ contractDemoContext)
       assign _evaluationResult NotAsked
       assign _createGistResult NotAsked
 
@@ -331,46 +333,45 @@ handleAction CompileProgram = do
   case mContents of
     Nothing -> pure unit
     Just contents -> do
-      oldCompilationResult <- use _compilationResult
+      assign (_editorState <<< _feedbackPaneMinimised) true
       assign _compilationResult Loading
+      lastSuccessfulCompilationResult <- use _lastSuccessfulCompilationResult
       newCompilationResult <- postContract contents
       assign _compilationResult newCompilationResult
-      -- If we got a successful result, update lastCompiledCode and switch tab.
       case newCompilationResult of
-        Success (Left _) -> assign (_editorState <<< _feedbackPaneMinimised) false
-        _ ->
+        Success (Left errors) -> do
+          -- If there are compilation errors, add editor annotations and expand the feedback pane.
+          editorSetAnnotations $ toAnnotations errors
+          assign (_editorState <<< _feedbackPaneMinimised) false
+        Success (Right _) ->
+          -- If compilation was successful, clear editor annotations and save the successful result.
           when (isSuccess newCompilationResult) do
-            assign (_editorState <<< _lastCompiledCode) (Just contents)
+            editorSetAnnotations []
             assign (_editorState <<< _currentCodeIsCompiled) true
-      -- Update the error display.
-      editorSetAnnotations
-        $ case newCompilationResult of
-            Success (Left errors) -> toAnnotations errors
-            _ -> []
-      -- If we have a result with new signatures, we can only hold
-      -- onto the old actions if the signatures still match. Any
-      -- change means we'll have to clear out the existing simulation.
-      -- Same thing for currencies.
-      -- Potentially we could be smarter about this. But for now,
-      -- let's at least be correct.
-      let
-        oldSignatures = preview (_details <<< _functionSchema) oldCompilationResult
-
-        newSignatures = preview (_details <<< _functionSchema) newCompilationResult
-
-        oldCurrencies = preview (_details <<< _knownCurrencies) oldCompilationResult
-
-        newCurrencies = preview (_details <<< _knownCurrencies) newCompilationResult
-      unless
-        ( oldSignatures == newSignatures
-            && oldCurrencies
-            == newCurrencies
-        )
-        ( assign _simulations
-            $ case newCurrencies of
-                Just currencies -> Cursor.singleton $ mkSimulation currencies 1
-                Nothing -> Cursor.empty
-        )
+            assign (_editorState <<< _lastCompiledCode) (Just contents)
+            assign _lastSuccessfulCompilationResult newCompilationResult
+            -- If we have a result with new signatures, we can only hold onto the old actions if
+            -- the signatures still match. Any change means we'll have to clear out the existing
+            -- simulation. Same thing for currencies. Potentially we could be smarter about this.
+            -- But for now, let's at least be correct.
+            -- Note we test against the last _successful_ compilation result, so that a failed
+            -- compilation in between times doesn't unnecessarily wipe the old actions.
+            let
+              oldSignatures = preview (_details <<< _functionSchema) lastSuccessfulCompilationResult
+
+              newSignatures = preview (_details <<< _functionSchema) newCompilationResult
+
+              oldCurrencies = preview (_details <<< _knownCurrencies) lastSuccessfulCompilationResult
+
+              newCurrencies = preview (_details <<< _knownCurrencies) newCompilationResult
+            unless
+              (oldSignatures == newSignatures && oldCurrencies == newCurrencies)
+              ( assign _simulations
+                  $ case newCurrencies of
+                      Just currencies -> Cursor.singleton $ mkSimulation currencies 1
+                      Nothing -> Cursor.empty
+              )
+        _ -> pure unit
       pure unit
 
 handleSimulationAction ::

plutus-playground-client/src/MainFrame/Types.purs

@@ -52,6 +52,7 @@ newtype State
   , currentDemoName :: Maybe String
   , editorState :: Editor.State
   , compilationResult :: WebCompilationResult
+  , lastSuccessfulCompilationResult :: WebCompilationResult
   , simulations :: Cursor Simulation
   , actionDrag :: Maybe Int
   , evaluationResult :: WebEvaluationResult