Disable send to simulator if blockly has holes

marlowe-playground-client/src/BlocklyEditor/State.purs

@@ -1,18 +1,21 @@
 module BlocklyEditor.State where
 
 import Prelude
-import BlocklyEditor.Types (Action(..), State, _errorMessage, _marloweCode)
+import BlocklyEditor.Types (Action(..), State, _errorMessage, _hasHoles, _marloweCode)
 import Control.Monad.Except (ExceptT(..), except, runExceptT)
 import Data.Bifunctor (lmap)
-import Data.Either (note, Either(..))
-import Data.Lens (assign)
+import Data.Either (Either(..), either, note)
+import Data.Lens (set)
+import Data.List (List(..))
 import Data.Maybe (Maybe(..))
-import Debug.Trace (spy)
+import Data.Tuple (Tuple(..))
+import Data.Tuple.Nested ((/\))
 import Effect.Aff.Class (class MonadAff)
-import Halogen (HalogenM, query)
+import Halogen (HalogenM, modify_, query)
 import Halogen as H
 import Halogen.Blockly as Blockly
 import MainFrame.Types (ChildSlots, _blocklySlot)
+import Marlowe.Linter as Linter
 import Marlowe.Parser as Parser
 import Text.Extra as Text
 import Text.Pretty (pretty)
@@ -26,20 +29,33 @@ handleAction (HandleBlocklyMessage Blockly.CodeChange) = do
   eContract <-
     runExceptT do
       code <- ExceptT <<< map (note "Blockly Workspace is empty") $ query _blocklySlot unit $ H.request Blockly.GetCode
-      except <<< lmap (unexpected <<< show) $ Parser.parseContract (Text.stripParens code)
+      contract <- except <<< lmap (unexpected <<< show) $ Parser.parseContract (Text.stripParens code)
+      let
+        hasHoles = Linter.hasHoles $ Linter.lint Nil contract
+      pure $ Tuple contract hasHoles
   case eContract of
-    Left e -> do
-      assign _errorMessage $ Just e
-      assign _marloweCode Nothing
-    Right contract -> do
-      assign _errorMessage Nothing
-      assign _marloweCode $ Just $ show $ pretty contract
+    Left e ->
+      modify_
+        ( set _errorMessage (Just e)
+            <<< set _marloweCode Nothing
+        )
+    Right (contract /\ hasHoles) ->
+      modify_
+        ( set _errorMessage Nothing
+            <<< set _marloweCode (Just $ show $ pretty contract)
+            <<< set _hasHoles hasHoles
+        )
   where
   unexpected s = "An unexpected error has occurred, please raise a support issue at https://github.com/input-output-hk/plutus/issues/new: " <> s
 
 handleAction (InitBlocklyProject code) = do
-  assign _marloweCode $ Just code
   void $ query _blocklySlot unit $ H.tell (Blockly.SetCode code)
+  let
+    hasHoles = either (const false) identity $ (Linter.hasHoles <<< Linter.lint Nil) <$> Parser.parseContract code
+  modify_
+    ( set _marloweCode (Just code)
+        <<< set _hasHoles hasHoles
+    )
 
 handleAction SendToSimulator = pure unit
 

marlowe-playground-client/src/BlocklyEditor/Types.purs

@@ -25,6 +25,7 @@ instance blocklyActionIsEvent :: IsEvent Action where
 type State
   = { errorMessage :: Maybe String
     , marloweCode :: Maybe String
+    , hasHoles :: Boolean
     }
 
 _errorMessage :: Lens' State (Maybe String)
@@ -33,8 +34,12 @@ _errorMessage = prop (SProxy :: SProxy "errorMessage")
 _marloweCode :: Lens' State (Maybe String)
 _marloweCode = prop (SProxy :: SProxy "marloweCode")
 
+_hasHoles :: Lens' State Boolean
+_hasHoles = prop (SProxy :: SProxy "hasHoles")
+
 initialState :: State
 initialState =
   { errorMessage: Nothing
   , marloweCode: Nothing
+  , hasHoles: false
   }

marlowe-playground-client/src/BlocklyEditor/View.purs

@@ -1,16 +1,16 @@
 module BlocklyEditor.View where
 
 import Prelude hiding (div)
-import BlocklyEditor.Types (Action(..), State, _marloweCode)
+import BlocklyEditor.Types (Action(..), State, _hasHoles, _marloweCode)
 import Data.Lens ((^.))
 import Data.Maybe (Maybe(..), isJust)
 import Effect.Aff.Class (class MonadAff)
 import Halogen (ComponentHTML)
 import Halogen.Blockly as Blockly
-import Halogen.Classes (disabled, group)
+import Halogen.Classes (group)
 import Halogen.HTML (HTML, button, div, slot, text, div_)
 import Halogen.HTML.Events (onClick)
-import Halogen.HTML.Properties (classes, enabled)
+import Halogen.HTML.Properties (classes, disabled, enabled)
 import MainFrame.Types (ChildSlots, _blocklySlot)
 import Marlowe.Blockly as MB
 
@@ -34,15 +34,15 @@ otherActions state =
     [ button
         [ onClick $ const $ Just ViewAsMarlowe
         , enabled hasCode
-        , classes [ disabled hasCode ]
         ]
         [ text "View as Marlowe" ]
     , button
         [ onClick $ const $ Just SendToSimulator
-        , enabled hasCode
-        , classes [ disabled hasCode ]
+        , enabled (hasCode && not hasHoles)
         ]
         [ text "Send To Simulator" ]
     ]
   where
   hasCode = isJust $ state ^. _marloweCode
+
+  hasHoles = state ^. _hasHoles

marlowe-playground-client/src/Marlowe/Holes.purs

@@ -18,7 +18,7 @@ import Data.List.NonEmpty as NEL
 import Data.Map (Map)
 import Data.Map as Map
 import Data.Maybe (Maybe(..), fromMaybe)
-import Data.Newtype (class Newtype)
+import Data.Newtype (class Newtype, unwrap)
 import Data.Set (Set)
 import Data.Set as Set
 import Data.String (Pattern(..), contains, splitAt, toLower)
@@ -476,6 +476,9 @@ instance encodeHoles :: Encode Holes where
 instance decodeHoles :: Decode Holes where
   decode f = Holes <$> decode f
 
+isEmpty :: Holes -> Boolean
+isEmpty = Map.isEmpty <<< unwrap
+
 insertHole :: forall a. IsMarloweType a => Term a -> Holes -> Holes
 insertHole (Term _ _) m = m
 

marlowe-playground-client/src/Marlowe/Linter.purs

@@ -6,6 +6,7 @@ module Marlowe.Linter
   , WarningDetail(..)
   , AdditionalContext
   , _holes
+  , hasHoles
   , _warnings
   , suggestions
   , markers
@@ -48,6 +49,7 @@ import Data.Tuple (Tuple(..))
 import Data.Tuple.Nested (type (/\), (/\))
 import Help (holeText)
 import Marlowe.Holes (Action(..), Argument, Bound(..), Case(..), Contract(..), Holes(..), MarloweHole(..), MarloweType, Observation(..), Term(..), TermWrapper(..), Value(..), Range, constructMarloweType, fromTerm, getHoles, getMarloweConstructors, getRange, holeSuggestions, insertHole, readMarloweType)
+import Marlowe.Holes as Holes
 import Marlowe.Parser (ContractParseError(..), parseContract)
 import Marlowe.Semantics (Rational(..), Slot(..), emptyState, evalValue, makeEnvironment)
 import Marlowe.Semantics as Semantics
@@ -218,6 +220,9 @@ _holes = _Newtype <<< prop (SProxy :: SProxy "holes")
 _warnings :: Lens' State (Set Warning)
 _warnings = _Newtype <<< prop (SProxy :: SProxy "warnings")
 
+hasHoles :: State -> Boolean
+hasHoles = not Holes.isEmpty <<< view _holes
+
 newtype LintEnv
   = LintEnv
   { choicesMade :: Set Semantics.ChoiceId