Merge pull request #2155 from input-output-hk/SCP-884

SCP-884 - Some editor updates

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

@@ -1162,7 +1162,7 @@ instance hasBlockDefinitionContract :: HasBlockDefinition ContractType (Term Con
       eTopCaseBlock = getBlockInputConnectedTo casesInput
     cases <- case eTopCaseBlock of
       Either.Right topCaseBlock -> casesDefinition g topCaseBlock
-      Either.Left _ -> pure [ Hole "case" Proxy { row: 0, column: 0 } ]
+      Either.Left _ -> pure []
     slot <- parse Parser.timeout =<< getFieldValue block "timeout"
     contract <- statementToTerm g block "contract" Parser.contract
     pure $ mkDefaultTerm (When cases slot contract)

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

@@ -109,6 +109,7 @@ mkArgName t = case splitAt 1 (show t) of
 
 data Argument
   = ArrayArg String
+  | EmptyArrayArg
   | DataArg MarloweType
   | NamedDataArg String
   | DataArgIndexed Int MarloweType
@@ -176,7 +177,7 @@ getMarloweConstructors ContractType =
     [ (Tuple "Close" [])
     , (Tuple "Pay" [ GenArg AccountIdType, DataArg PayeeType, DataArg TokenType, DataArg ValueType, DataArg ContractType ])
     , (Tuple "If" [ DataArg ObservationType, DataArgIndexed 1 ContractType, DataArgIndexed 2 ContractType ])
-    , (Tuple "When" [ ArrayArg "case", DefaultNumber zero, DataArg ContractType ])
+    , (Tuple "When" [ EmptyArrayArg, DefaultNumber zero, DataArg ContractType ])
     , (Tuple "Let" [ DefaultString "valueId", DataArg ValueType, DataArg ContractType ])
     , (Tuple "Assert" [ DataArg ObservationType, DataArg ContractType ])
     ]
@@ -231,6 +232,8 @@ constructMarloweType constructorName (MarloweHole { row, column }) m = case Map.
   Just [] -> constructorName
   Just vs -> parens row column $ constructorName <> " " <> intercalate " " (map showArgument vs)
   where
+  showArgument EmptyArrayArg = "[]"
+
   showArgument (ArrayArg arg) = "[ ?" <> arg <> " ]"
 
   showArgument (DataArg arg) = "?" <> mkArgName arg

marlowe-playground-client/src/Marlowe/Monaco.ts

@@ -27,10 +27,12 @@ export class MarloweCompletionItemProvider implements monaco.languages.Completio
 
   provideCompletionItems(model: monaco.editor.ITextModel, position: monaco.Position, context: monaco.languages.CompletionContext, token: monaco.CancellationToken): monaco.languages.ProviderResult<monaco.languages.CompletionList> {
     var word = model.getWordAtPosition(position);
+    const isEmptyWord = word == null;
     // if the word is empty then we need an extra space in the contract that we generate
-    const emptyWordHack = word == null ? " " : ""
-    if (word == null) {
+    const emptyWordHack = isEmptyWord ? " " : ""
+    if (isEmptyWord) {
       word = {
+        // for some reason an empty string here doesn't work so we give it a dummy value
         word: "*",
         startColumn: position.column,
         endColumn: position.column,
@@ -39,9 +41,10 @@ export class MarloweCompletionItemProvider implements monaco.languages.Completio
     const stripParens = word.startColumn == 1 && position.lineNumber == 1;
     const wordStart = model.getOffsetAt(position);
     const wordEnd = wordStart + word.word.length;
-    const startOfContract = model.getValue().substring(0, wordStart - 1);
+    // because of the dummy * value we need to mess with the substring lengths
+    const offset = isEmptyWord ? 0 : word.word.length;
+    const startOfContract = model.getValue().substring(0, wordStart - offset);
     const endOfContract = model.getValue().substring(wordEnd - 1);
-
     // we replace the word at the cursor with a hole with a special name so that the contract is parsable
     // if the contract is not valid then we won't get any suggestions
     const contract = startOfContract + emptyWordHack + "?monaco_suggestions" + endOfContract;

marlowe-playground-client/src/Simulation.purs

@@ -14,7 +14,6 @@ import Data.BigInteger (BigInteger, fromString, fromInt)
 import Data.Either (Either(..), note)
 import Data.Enum (toEnum, upFromIncluding)
 import Data.HeytingAlgebra (not, (&&))
-import Data.Int (toNumber)
 import Data.Lens (_Just, assign, modifying, over, preview, to, use, view, (^.))
 import Data.Lens.Index (ix)
 import Data.Lens.NonEmptyList (_Head)
@@ -27,7 +26,6 @@ import Data.String (Pattern(..), codePointFromChar, stripPrefix, stripSuffix, tr
 import Data.String as String
 import Data.Traversable (traverse)
 import Data.Tuple (Tuple(..), fst, snd)
-import Debug.Trace (trace)
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect, liftEffect)
 import FileEvents (readFileFromDragEvent)
@@ -84,7 +82,6 @@ import Web.DOM.HTMLCollection as WC
 import Web.HTML as Web
 import Web.HTML.HTMLDocument (toDocument)
 import Web.HTML.Window as W
-import Web.HTML.Window as Window
 import WebSocket (WebSocketRequestMessage(..))
 
 mkComponent :: forall m. MonadEffect m => MonadAff m => SPSettings_ SPParams_ -> H.Component HTML Query Unit Message m
@@ -650,7 +647,11 @@ inputItem isEnabled person (ChoiceInput choiceId@(ChoiceId choiceName choiceOwne
 
   error = if inBounds chosenNum bounds then [] else [ text boundsError ]
 
-  boundsError = "Choice must be between " <> intercalate " or " (map boundError bounds)
+  boundsError =
+    if Array.null bounds then
+      "A choice must have set bounds, please fix the contract"
+    else
+      "Choice must be between " <> intercalate " or " (map boundError bounds)
 
   boundError (Bound from to) = show from <> " and " <> show to
 

marlowe-playground-client/test/Marlowe/LintTests.purs

@@ -8,7 +8,7 @@ import Data.Map as Map
 import Data.Set (toUnfoldable)
 import Data.Tuple (Tuple(..), fst)
 import Data.Tuple.Nested (type (/\), (/\))
-import Marlowe.Linter (lint, State(..))
+import Marlowe.Linter (State(..), WarningDetail(..), lint)
 import Marlowe.Parser (parseContract)
 import Marlowe.Semantics (AccountId(..), Party(..), Token(..))
 import Marlowe.Semantics as S
@@ -312,7 +312,7 @@ unreachableCaseNotify =
 unreachableCaseEmptyChoiceList :: Test
 unreachableCaseEmptyChoiceList =
   testWarningSimple "When [Case (Choice (ChoiceId \"choice\" (Role \"alice\")) []) Close] 10 Close"
-    "This case will never be used, because there are no options to choose"
+    $ show UnreachableCaseEmptyChoice
 
 undefinedLet :: Test
 undefinedLet = testWarningSimple (letContract "(UseValue \"simplifiableValue\")") "The contract tries to Use a ValueId that has not been defined in a Let"