Merge pull request #2418 from input-output-hk/SCP-1223-prereq

A few small tweaks that have dropped out of my SCP-1223 work.
IntersectMBO · Oct 29, 2020 · 61e5a82 · 61e5a82
2 parents a1c7e15 + 95d1897
commit 61e5a82
Show file tree

Hide file tree

Showing 6 changed files with 26 additions and 29 deletions.
diff --git a/marlowe-playground-client/src/Halogen/Monaco.purs b/marlowe-playground-client/src/Halogen/Monaco.purs
@@ -58,9 +58,12 @@ type Objects
     , completionItemProvider :: Maybe CompletionItemProvider
     }
 
+newtype CancelBindings
+  = CancelBindings (Effect Unit)
+
 type State
   = { editor :: Maybe Editor
-    , deactivateBindings :: Effect Unit
+    , deactivateBindings :: CancelBindings
     , objects :: Objects
     }
 
@@ -103,7 +106,7 @@ monacoComponent settings =
     { initialState:
       const
         { editor: Nothing
-        , deactivateBindings: pure unit
+        , deactivateBindings: CancelBindings $ pure unit
         , objects:
           { codeActionProvider: settings.codeActionProvider
           , completionItemProvider: settings.completionItemProvider
@@ -229,28 +232,26 @@ handleQuery (SetModelMarkers markersData f) = do
       markers <- Monaco.getModelMarkers monaco model
       pure $ f markers
 
-handleQuery (SetKeyBindings DefaultBindings next) =
-  withEditor \editor -> do
-    { deactivateBindings } <- get
-    liftEffect deactivateBindings
-    pure next
-
-handleQuery (SetKeyBindings Emacs next) =
-  withEditor \editor -> do
-    { deactivateBindings } <- get
-    liftEffect deactivateBindings
-    disableEmacsMode <- liftEffect $ Monaco.enableEmacsBindings editor
-    modify_ (_ { deactivateBindings = disableEmacsMode })
-    pure next
-
-handleQuery (SetKeyBindings Vim next) =
+handleQuery (SetKeyBindings bindings next) =
   withEditor \editor -> do
     { deactivateBindings } <- get
-    liftEffect deactivateBindings
-    disableVimMode <- liftEffect $ Monaco.enableVimBindings editor
-    modify_ (_ { deactivateBindings = disableVimMode })
+    newDeactivateBindings <- liftEffect $ replaceKeyBindings bindings editor deactivateBindings
+    modify_ (_ { deactivateBindings = newDeactivateBindings })
     pure next
 
 handleQuery (GetObjects f) = do
   { objects } <- get
   pure $ Just $ f objects
+
+replaceKeyBindings :: KeyBindings -> Editor -> CancelBindings -> Effect (CancelBindings)
+replaceKeyBindings bindings editor (CancelBindings deactivateOldBindings) = do
+  let
+    enableFn :: KeyBindings -> Editor -> Effect (Effect Unit)
+    enableFn DefaultBindings = pure $ pure $ pure unit
+
+    enableFn Vim = Monaco.enableVimBindings
+
+    enableFn Emacs = Monaco.enableEmacsBindings
+  deactivateOldBindings
+  deactivateNewBindings <- enableFn bindings editor
+  pure $ CancelBindings deactivateNewBindings
diff --git a/marlowe-playground-client/src/Monaco.js b/marlowe-playground-client/src/Monaco.js
@@ -131,7 +131,7 @@ exports.enableEmacsBindings_ = function (editor) {
 }
 
 exports.completionItemKindEq_ = function (a, b) {
-  a == b
+  return a == b;
 }
 
 exports.completionItemKindOrd_ = function (lt, eq, gt, a, b) {

diff --git a/playground-common/src/Auth.hs b/playground-common/src/Auth.hs
@@ -208,7 +208,7 @@ authStatus cookieHeader = do
                     "Failed to extract github token at step: " <> showText err
                 pure Anonymous
     let authStatusResult = AuthStatus {..}
-    logDebugN $ "Authentication status is:" <> showText authStatusResult
+    logDebugN $ "Authentication status is: " <> showText authStatusResult
     pure authStatusResult
 
 extractGithubToken ::
@@ -233,7 +233,7 @@ extractGithubToken signer now cookieHeader =
             Map.lookup githubTokenClaim .
             JWT.unClaimsMap . JWT.unregisteredClaims $
             claims
-        attempt $ "Extracting token as a string:" <> showText json
+        attempt $ "Extracting token as a string: " <> showText json
         withTrace $
             case json of
                 String token -> pure $ Token token

diff --git a/plutus-playground-client/src/Chain.purs b/plutus-playground-client/src/Chain.purs
@@ -104,7 +104,7 @@ emulatorEventPane (ChainEvent (TxnValidate (TxId txId))) =
 
 emulatorEventPane (NotificationEvent notificationEvent) =
   div_
-    [ text $ "Notification event:" <> show notificationEvent ]
+    [ text $ "Notification event: " <> show notificationEvent ]
 
 emulatorEventPane (ChainEvent (TxnValidationFail (TxId txId) error)) =
   div [ class_ $ ClassName "error" ]

diff --git a/plutus-playground-client/webpack.config.js b/plutus-playground-client/webpack.config.js
@@ -3,7 +3,6 @@
 const ExtractTextPlugin = require("extract-text-webpack-plugin");
 const HtmlWebpackPlugin = require('html-webpack-plugin');
 const path = require('path');
-const webpack = require('webpack');
 
 const isWebpackDevServer = process.argv.some(a => path.basename(a) === 'webpack-dev-server');
 
@@ -94,9 +93,6 @@ module.exports = {
     },
 
     plugins: [
-        new webpack.LoaderOptionsPlugin({
-            debug: true
-        }),
         new HtmlWebpackPlugin({
             template: '../web-common/static/index.html',
             favicon: 'static/favicon.ico',

diff --git a/plutus-scb/test/Plutus/SCB/CoreSpec.hs b/plutus-scb/test/Plutus/SCB/CoreSpec.hs
@@ -315,7 +315,7 @@ assertEqual msg expected actual =
         $ Text.unwords
             [ msg
             , "Expected: " <> tshow expected
-            , "Actual:" <> tshow actual
+            , "Actual: " <> tshow actual
             ]
 
 assertBool ::