SCP-2062 - Separate SlotParam from Slot in Blockly (#3021)

* Add dropdown to choose between slot number and parameter in Blockly
* Implement custom validation of timeouts
* Modify validator to remove commas, spaces, and leading zeroes

marlowe-playground-client/src/Blockly/Internal.js

@@ -6,7 +6,7 @@ var JSONbig = require("json-bigint");
 exports.createBlocklyInstance_ = function () {
   return require("blockly");
 };
-exports.debugBlockly_ = function debugBlockly_ (name, state) {
+exports.debugBlockly_ = function debugBlockly_(name, state) {
   if (typeof window.blockly === 'undefined') {
     window.blockly = {};
   }
@@ -17,6 +17,46 @@ exports.getElementById_ = function (id) {
 };
 
 exports.createWorkspace_ = function (blockly, workspaceDiv, config) {
+  /* Register extensions */
+  /* Silently clean if already registered */
+  try { blockly.Extensions.register('timeout_validator', function () { }); } catch(err) { }
+  blockly.Extensions.unregister('timeout_validator');
+
+  /* Timeout extension (advanced validation for the timeout field) */
+  blockly.Extensions.register('timeout_validator',
+    function () {
+      var thisBlock = this;
+
+      /* Validator for timeout */
+      var timeoutValidator = function (input) {
+        if (thisBlock.getFieldValue('timeout_type') == 'slot') {
+          var cleanedInput = input.replace(new RegExp('[,]+', 'g'), '').trim();
+          if ((new RegExp('^(-[0-9])?[0-9]*$', 'g')).test(cleanedInput)) {
+            return BigInt(cleanedInput).toString();
+          } else {
+            return null;
+          }
+        } else {
+          return input;
+        }
+      };
+
+      thisBlock.getField('timeout').setValidator(timeoutValidator);
+
+      /* This sets the timeout to zero when switching to slot in the dropdown */
+      this.setOnChange(function (event) {
+        if (event.blockId == thisBlock.id &&
+          event.name == 'timeout_type' &&
+          event.element == 'field' &&
+          event.oldValue != event.newValue) {
+          if (timeoutValidator(thisBlock.getFieldValue('timeout')) === null) {
+              thisBlock.setFieldValue('0', 'timeout');
+          }
+        }
+      });
+    });
+
+  /* Inject workspace */
   var workspace = blockly.inject(workspaceDiv, config);
   blockly.svgResize(workspace);
   return workspace;
@@ -124,3 +164,4 @@ exports.updateToolbox_ = function (toolboxJson, workspace) {
   workspace.updateToolbox(toolboxJson);
 }
 
+

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

@@ -3,9 +3,8 @@ module Marlowe.Blockly where
 import Prelude
 import Blockly.Dom as BDom
 import Blockly.Generator (Connection, Input, NewBlockFunction, clearWorkspace, connect, connectToOutput, connectToPrevious, fieldName, fieldRow, getInputWithName, inputList, inputName, inputType, nextConnection, previousConnection, setFieldText)
-import Blockly.Internal (AlignDirection(..), Arg(..), BlockDefinition(..), defaultBlockDefinition, getBlockById, initializeWorkspace, render, typedArguments)
-import Blockly.Toolbox (Category(..), Toolbox(..), category, defaultCategoryFields, leaf, rename, separator)
-import Blockly.Toolbox as Toolbox
+import Blockly.Internal (AlignDirection(..), Arg(..), BlockDefinition(..), Pair(..), defaultBlockDefinition, getBlockById, initializeWorkspace, render, typedArguments)
+import Blockly.Toolbox (Category, Toolbox(..), category, leaf, rename, separator)
 import Blockly.Types (Block, BlocklyState, Workspace)
 import Control.Monad.Error.Class (catchError)
 import Control.Monad.Error.Extra (toMonadThrow)
@@ -608,10 +607,11 @@ toDefinition blockType@(ContractType WhenContractType) =
   BlockDefinition
     $ merge
         { type: show WhenContractType
-        , message0: "When %1 %2 after slot %3 %4 continue as %5 %6"
+        , message0: "When %1 %2 after %3 %4 %5 continue as %6 %7"
         , args0:
             [ DummyCentre
             , Statement { name: "case", check: "ActionType", align: Left }
+            , Dropdown { name: "timeout_type", options: [ Pair "slot number" "slot", Pair "slot parameter" "slot_param" ] }
             , Input { name: "timeout", text: "0", spellcheck: false }
             , DummyLeft
             , DummyLeft
@@ -620,6 +620,7 @@ toDefinition blockType@(ContractType WhenContractType) =
         , colour: blockColour blockType
         , previousStatement: Just (show BaseContractType)
         , inputsInline: Just false
+        , extensions: [ "timeout_validator" ]
         }
         defaultBlockDefinition
 
@@ -1239,14 +1240,18 @@ instance blockToTermContract :: BlockToTerm Contract where
     contract2 <- singleStatementToTerm "contract2" b
     pure $ Term (If observation contract1 contract2) (BlockId id)
   blockToTerm b@({ type: "WhenContractType", id, children }) = do
-    timeoutField <- fieldAsString "timeout" b
+    timeoutType <- fieldAsString "timeout_type" b
     cases <- statementsToTerms "case" b
     let
       location = (BlockId id)
-
-      timeout = case BigInteger.fromString timeoutField of
-        Just slotNumber -> Term (Slot slotNumber) location
-        Nothing -> Term (SlotParam timeoutField) location
+    timeout <- case timeoutType of
+      "slot" -> do
+        slot <- fieldAsBigInteger "timeout" b
+        pure $ Term (Slot slot) location
+      "slot_param" -> do
+        slotParam <- fieldAsString "timeout" b
+        pure $ Term (SlotParam slotParam) location
+      _ -> throwError $ ErrorInChild b "timeout_type" (InvalidChildType "Timeout")
     contract <- singleStatementToTerm "contract" b
     pure $ Term (When cases timeout contract) location
   blockToTerm b@({ type: "LetContractType", id }) = do
@@ -1608,6 +1613,11 @@ instance toBlocklyContract :: ToBlockly Contract where
     block <- newBlock workspace (show WhenContractType)
     connectToPrevious block input
     inputToBlockly newBlock workspace block "case" cases
+    setField block "timeout_type"
+      ( case timeout of
+          Term (SlotParam _) _ -> "slot_param"
+          _ -> "slot"
+      )
     setField block "timeout"
       ( case timeout of
           Term (Slot slotNum) _ -> show slotNum

marlowe-playground-client/test/Blockly/Headless.js

@@ -10,6 +10,7 @@ exports.createWorkspace_ = function(blockly) {
 }
 
 exports.initializeWorkspace_ = function(blockly, workspace) {
+    try { blockly.Extensions.register('timeout_validator', function () { }); } catch(err) { }
     var xmlText = '<xml id="workspaceBlocks" style="display:none"><block type="BaseContractType" x="13" y="187" id="root_contract"></block></xml>';
     var workspaceBlocks = blockly.Xml.textToDom(xmlText);
     blockly.Xml.domToWorkspace(workspaceBlocks, workspace);