Fix bug and make interpreter async

IntersectMBO · Sep 16, 2020 · 642f634 · 642f634
1 parent e631227
commit 642f634
Show file tree

Hide file tree

Showing 5 changed files with 33 additions and 13 deletions.
diff --git a/marlowe-playground-client/spago-packages.nix b/marlowe-playground-client/spago-packages.nix
@@ -17,6 +17,18 @@ let
         installPhase = "ln -s $src $out";
       };
 
+    "aff-promise" = pkgs.stdenv.mkDerivation {
+        name = "aff-promise";
+        version = "v2.1.0";
+        src = pkgs.fetchgit {
+          url = "https://github.com/nwolverson/purescript-aff-promise.git";
+          rev = "033d6b90252e0390b0de7845e21de919bc4c3a0e";
+          sha256 = "0khm53lvxgvc7fbsvcr2h2wlhcgay8vq45755f0w8vpk1441dvww";
+        };
+        phases = "installPhase";
+        installPhase = "ln -s $src $out";
+      };
+
     "affjax" = pkgs.stdenv.mkDerivation {
         name = "affjax";
         version = "v10.0.0";

diff --git a/marlowe-playground-client/spago.dhall b/marlowe-playground-client/spago.dhall
@@ -4,7 +4,8 @@ You can edit this file as you like.
 -}
 { name = "marlowe-playground-client"
 , dependencies =
-  [ "avar"
+  [ "aff-promise"
+  , "avar"
   , "bigints"
   , "concurrent-queues"
   , "console"

diff --git a/marlowe-playground-client/src/Language/Javascript/Interpreter.js b/marlowe-playground-client/src/Language/Javascript/Interpreter.js
@@ -2,13 +2,16 @@
 'use strict';
 const safeEval = require('notevil')
 
-exports.eval_ = function (left, right, javascript) {
+exports.eval_ = async function (left, right, javascript) {
   // include any libraries etc we want by providing a context. be careful!
   // here we can pass in our library for constructing contracts
   var context = require('src/Language/Javascript/MarloweJS.ts');
   context['bigInt'] = require('big-integer');
   try {
-    var justCode = javascript.split(/^.*\/\* === Code above this comment will be removed at compile time === \*\/$/gm).slice(1).join('');
+    var slices = javascript.split(/^.*\/\* === Code above this comment will be removed at compile time === \*\/$/gm);
+    var takeSlice = 0;
+    if (slices.length > 1) { takeSlice = 1 };
+    var justCode = slices.slice(takeSlice).join('');
     let res = safeEval(justCode, context);
     return right(JSON.stringify(res));
   } catch (error) {

diff --git a/marlowe-playground-client/src/Language/Javascript/Interpreter.purs b/marlowe-playground-client/src/Language/Javascript/Interpreter.purs
@@ -1,9 +1,12 @@
 module Language.Javascript.Interpreter where
 
 import Prelude
+
 import Control.Monad.Except (runExcept)
+import Control.Promise (Promise, toAffE)
 import Data.Either (Either(..))
-import Data.Function.Uncurried (Fn3, runFn3)
+import Effect.Aff (Aff)
+import Effect.Uncurried (EffectFn3, runEffectFn3)
 import Foreign.Generic (decodeJSON)
 import Marlowe.Semantics (Contract)
 
@@ -25,11 +28,12 @@ newtype InterpreterResult a
   , result :: a
   }
 
-foreign import eval_ :: forall a b. Fn3 (String -> Either a b) (String -> Either a b) String (Either a b)
+foreign import eval_ :: forall a b. EffectFn3 (String -> Either a b) (String -> Either a b) String (Promise (Either a b))
 
-eval :: String -> Either CompilationError (InterpreterResult Contract)
-eval js = case runFn3 eval_ Left Right js of
-  Left err -> Left (RawError err)
-  Right result -> case runExcept (decodeJSON result) of
-    Left err -> Left (RawError (show err))
-    Right contract -> Right (InterpreterResult { warnings: [], result: contract })
+eval :: String -> Aff (Either CompilationError (InterpreterResult Contract))
+eval js = do res <- toAffE (runEffectFn3 eval_ Left Right js)
+             pure (case res of
+                     Left err -> Left (RawError err)
+                     Right result -> case runExcept (decodeJSON result) of
+                       Left err -> Left (RawError (show err))
+                       Right contract -> Right (InterpreterResult { warnings: [], result: contract }))
diff --git a/marlowe-playground-client/src/MainFrame.purs b/marlowe-playground-client/src/MainFrame.purs
@@ -42,7 +42,6 @@ import JSEditor as JSEditor
 import Language.Haskell.Interpreter (_InterpreterResult)
 import Language.Haskell.Monaco as HM
 import Language.Javascript.Interpreter as JSI
-import Language.Javascript.Interpreter as JSInterpreter
 import LocalStorage as LocalStorage
 import Marlowe (SPParams_)
 import Marlowe as Server
@@ -246,7 +245,8 @@ handleAction _ CompileJSProgram = do
         $ affEventSource
             ( \emitter -> do
                 delay (Milliseconds 10.0) -- Small pause to allow UI to redraw
-                emit emitter (CompiledJSProgram (JSInterpreter.eval contents))
+                res <- JSI.eval contents
+                emit emitter (CompiledJSProgram res)
                 pure mempty
             )
       pure unit