Skip to content

Commit

Permalink
SCP-884 - Some editor updates
Browse files Browse the repository at this point in the history
* Don't insert a hole when creating a When
* Improve messages for missing bounds and choice validation
* Fix type-ahead for empty array
  • Loading branch information
shmish111 committed Jul 10, 2020
1 parent 416acf5 commit 5d2113d
Show file tree
Hide file tree
Showing 5 changed files with 19 additions and 9 deletions.
2 changes: 1 addition & 1 deletion marlowe-playground-client/src/Marlowe/Blockly.purs
Expand Up @@ -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)
Expand Down
5 changes: 4 additions & 1 deletion marlowe-playground-client/src/Marlowe/Holes.purs
Expand Up @@ -109,6 +109,7 @@ mkArgName t = case splitAt 1 (show t) of

data Argument
= ArrayArg String
| EmptyArrayArg
| DataArg MarloweType
| NamedDataArg String
| DataArgIndexed Int MarloweType
Expand Down Expand Up @@ -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 ])
]
Expand Down Expand Up @@ -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
Expand Down
11 changes: 7 additions & 4 deletions marlowe-playground-client/src/Marlowe/Monaco.ts
Expand Up @@ -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,
Expand All @@ -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;
Expand Down
6 changes: 5 additions & 1 deletion marlowe-playground-client/src/Simulation.purs
Expand Up @@ -650,7 +650,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

Expand Down
4 changes: 2 additions & 2 deletions marlowe-playground-client/test/Marlowe/LintTests.purs
Expand Up @@ -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
Expand Down Expand Up @@ -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"
Expand Down

0 comments on commit 5d2113d

Please sign in to comment.