Implements Monaco Editor

one-sided-web/spago.yaml

@@ -12,4 +12,6 @@ package:
     - effect
     - console
     - transformers
+    - record
+    - aff-promise
 

one-sided-web/src/Definitions.purs

@@ -11,6 +11,7 @@ import Data.Either (Either(..))
 import Data.Tuple (Tuple(..),snd)
 import Data.List (List,intercalate)
 import Data.Map (lookup,toUnfoldable)
+import Data.Maybe (Maybe(..))
 
 import Driver.Definition (DriverState(..),initialDriverState, runDriverM)
 import Driver.Driver (runStr)
@@ -22,17 +23,19 @@ import Syntax.Kinded.Terms (getType,getPrdCns)
 import Syntax.Kinded.Program (Program(..),VarDecl(..),emptyProg)
 import Eval.Definition (EvalTrace(..))
 import StandardLib (libMap)
+import Types (Editor)
 
-data Input = ProgramInput String | RunProg
+data Input = ProgramInput String | RunProg | InitEditor
 data RunResult = 
   ResErr {errMsg :: String,  errDebug::String, errTypes::String} 
   | ResSucc {succCmd::String, succTrace::String, succDebug::String, succTypes::String}
-type State = {progSrc::String, runRes::RunResult}
+type State = {progSrc::String, runRes::RunResult, monEditor:: Maybe Editor}
 
 initialState :: Input -> State
 initialState _ = {
   progSrc:intercalate "\n" (lookup (Modulename "Bool") libMap), 
-  runRes:ResSucc {succCmd:"", succTrace:"", succDebug:"", succTypes:""}
+  runRes:ResSucc {succCmd:"", succTrace:"", succDebug:"", succTypes:""},
+  monEditor: Nothing
   }
 
 runProg :: String -> RunResult  

one-sided-web/src/EditorMod.js

@@ -0,0 +1,50 @@
+"use strict";
+
+
+//new options mapping function, based on what options looks like
+var mapMaybes = function (options) {
+    var newObj = {};
+    for (prop in options) {
+        var propKey = prop;
+        var propValue = options[prop];
+        var newValue = undefined;
+        if (Object.keys(propValue).length != 0) {
+            newValue = propValue["value0"]
+            newObj[propKey] = newValue;
+        }
+    }
+    return newObj;
+}
+
+
+//here is the new implementation using getElementbyId
+export const createImpl = function (options) {
+    return function (el) {
+        return function () {
+            return new Promise(function (resolve, reject) {               
+                // make it happy for browser env
+                monacoRequire.config({ paths: { 'vs': 'monaco-editor/min/vs' } });
+
+                monacoRequire(['vs/editor/editor.main'], function () {
+                    //console.log(options);
+                    const mappedOpts = mapMaybes(options);
+                    //console.log(mappedOpts);
+                    //console.log(el);
+                    window.editorVar = monaco.editor.create(document.getElementById(el), mappedOpts);
+                    //console.log(editor);
+                    resolve(window.editorVar);
+                });
+            });
+        };
+    };
+};
+
+
+//2 new functions to import that get/set values for the editor
+export const readEditorValue = function (){
+    return window.editorVar.getValue()
+}
+
+export const setEditorValue = function (strValue){
+    window.editorVar.setValue(strValue)
+}

one-sided-web/src/EditorMod.purs

@@ -0,0 +1,38 @@
+module EditorMod
+  ( create
+  , readEditorValue
+  , setEditorValue
+  )
+  where
+
+import Prelude
+
+import Control.Promise (Promise, toAffE)
+import Data.Maybe (Maybe(..))
+import Effect (Effect)
+import Effect.Aff (Aff)
+import Foreign (Foreign, unsafeToForeign)
+import Types (Editor, defaultConstuctorOptions)
+
+foreign import createImpl
+  :: Foreign
+  -> String
+  -> Effect (Promise Editor)
+
+create
+  :: String
+  -> String
+  -> Aff Editor
+create textValue elementIdString = do
+  let opts = defaultConstuctorOptions 
+                  { value = Just textValue 
+                      , language = Just "one-sided-sequent-calculus"
+                      , theme = Just "custom-vs-dark"
+                  }
+  let effProm = createImpl (unsafeToForeign opts) elementIdString
+  toAffE effProm
+
+foreign import readEditorValue :: Effect String
+
+foreign import setEditorValue :: String -> Unit
+

one-sided-web/src/Events.purs

@@ -4,13 +4,16 @@ import Definitions (Input(..),State, runProg)
 import StandardLib (libMap) 
 import Common (Modulename(..))
 
-import Halogen (modify_)
+import Halogen (modify_, liftAff)
 
 import Prelude (bind)
 import Data.Unit (Unit)
 import Data.Maybe (Maybe(..))
 import Data.Map (lookup)
 import Control.Monad.State (class MonadState, gets)
+import Effect.Aff.Class (class MonadAff)
+import Effect.Unsafe (unsafePerformEffect)
+import EditorMod (create, readEditorValue, setEditorValue)
 
 getSrc :: String -> Input 
 getSrc newSrc = ProgramInput newSrc 
@@ -23,10 +26,20 @@ selectExample nm = case lookup (Modulename nm) libMap of
   Just src -> ProgramInput src 
   Nothing -> ProgramInput ""
 
-handleAction :: forall m. MonadState State m => Input -> m Unit
+handleAction :: forall m. MonadAff m => MonadState State m => Input -> m Unit
 handleAction inp = case inp of 
-  ProgramInput src -> modify_ (\st -> st {progSrc=src})
+  ProgramInput src -> do
+    -- dont know how to call the setEditorValue function by itself (without using let or something)
+    -- setEditorValue has no return and only needs to be called for the editor value to change
+    let _ = setEditorValue src 
+    modify_ (\st -> st {progSrc=src})
   RunProg -> do
-    src <- gets (\st -> st.progSrc)
+    -- read directly from the editor and write it in the state after
+    let src = unsafePerformEffect readEditorValue
     let res = runProg src
-    modify_ (\st -> st {runRes=res})
+    modify_ (\st -> st {runRes=res, progSrc=src})
+  InitEditor -> do
+    src <- gets (\st -> st.progSrc)
+    let editorInst = create src "container"
+    x <- liftAff editorInst
+    modify_ (\st -> st {monEditor = Just x})

one-sided-web/src/Layout.purs

@@ -1,7 +1,7 @@
 module Layout (render) where 
 
 import Definitions (RunResult(..),Input, State)
-import Events (runSrc, selectExample,getSrc)
+import Events (runSrc, selectExample)
 import StandardLib (libMap)
 
 import Prelude (($),(<>),(<$>),(+),show)
@@ -21,16 +21,12 @@ getHTMLHeight str = let nlines = length (split (Pattern "\n") str)  in
   "height: " <> show (nlines +3) <> "em;"
 
 render :: forall w. State -> HTML w Input
-render {progSrc:src,runRes:res} = layout src res
+render {runRes:res} = layout res
 
-progDiv :: forall w. String -> HTML w Input
-progDiv src = div 
-  [ class_ $ ClassName "prog" ]
-  [
-    textarea [id "progInput", value src, onValueChange getSrc, style  $ getHTMLHeight src],
-    br_,
-    button [id "runButton", onClick runSrc] [text "Run"]
-  ]
+progDiv :: forall w. HTML w Input
+progDiv = div 
+  [ id "container", class_ $ ClassName "prog"]
+  []
 
 
 getArea :: forall w. String -> ClassName -> String -> HTML w Input 
@@ -73,11 +69,13 @@ exSelect = div_ [
   br_
   ]
 
-layout :: forall w. String -> RunResult -> HTML w Input
-layout src res = body  []
+layout :: forall w. RunResult -> HTML w Input
+layout res = body  []
   [
     h1_ [text "One Sided Sequent Calculus"],
     exSelect,
-    progDiv src,
+    progDiv ,
+    button [id "runButton", onClick runSrc] [text "Run"],
     resDiv res
   ]
+

one-sided-web/src/Runner.purs

@@ -3,22 +3,24 @@ module Runner where
 import Prelude (bind)
 import Data.Unit (Unit)
 import Effect (Effect)
+import Data.Maybe (Maybe(..))
 
 import Halogen (Component,mkComponent,mkEval, defaultEval)
 import Halogen.Aff (awaitBody,runHalogenAff)
 import Halogen.VDom.Driver (runUI)
 import Halogen.Query.HalogenQ (HalogenQ)
 import Halogen.Query.HalogenM (HalogenM)
+import Effect.Aff.Class (class MonadAff)
 
 import Definitions (Input(..),State, initialState)
 import Layout (render)
 import Events (handleAction)
 
-component :: forall output m t. Component t Input output m
+component :: forall output m t. MonadAff m => Component t Input output m
 component = mkComponent { initialState:initialState, render:render, eval:eval}
 
-eval :: forall slots output m a t t2. HalogenQ t Input t2 a -> HalogenM State Input slots output m a
-eval = mkEval defaultEval {handleAction=handleAction}
+eval :: forall slots output m a t t2. MonadAff m => HalogenQ t Input t2 a -> HalogenM State Input slots output m a
+eval = mkEval defaultEval {handleAction=handleAction, initialize = Just InitEditor}
 
 uiRunner :: Effect Unit
 uiRunner = runHalogenAff do