Progress on adding comms. Added things to Evaluate.hs; incomplete!!!

ihaskell-display/ihaskell-parsec/IHaskell/Display/Parsec.hs

@@ -8,6 +8,7 @@ import Data.String.Here
 import Text.Parsec.String
 
 import IHaskell.Display
+import IHaskell.Display (IHaskellWidget)
 
 instance IHaskellDisplay (Parser a) where
   display renderable = do
@@ -42,3 +43,8 @@ instance IHaskellDisplay (Parser a) where
           });
         </script>
         |]
+
+instance IHaskellWidget (Parser a) where
+  open widget value publisher = return ()
+  comm widget value publisher = return ()
+  close widget value = return ()

notebooks/Test.ipynb

@@ -16,32 +16,22 @@
       "import Text.Parsec\n",
       "import Text.Parsec.String\n",
       "import Text.Parsec.Prim\n",
-      "import Text.Parsec.Char\n",
-      "\n",
-      "oneOf \"Hello\"C :: Parser Char"
+      "import Text.Parsec.Char"
      ],
      "language": "python",
      "metadata": {},
-     "outputs": [
-      {
-       "html": [
-        "\n",
-        "        <form><textarea id=\"text79438521894\">Hello!</textarea></form>\n",
-        "        <script>\n",
-        "          var textarea = document.getElementById(\"text79438521894\");\n",
-        "          var editor = CodeMirror.fromTextArea(textarea);\n",
-        "          editor.on(\"change\", function() {\n",
-        "            var text = editor.getDoc().getValue();\n",
-        "            console.log(\"New text: \" + text);\n",
-        "          });\n",
-        "        </script>\n",
-        "        "
-       ],
-       "metadata": {},
-       "output_type": "display_data"
-      }
+     "outputs": [],
+     "prompt_number": 1
+    },
+    {
+     "cell_type": "code",
+     "collapsed": false,
+     "input": [
+      "oneOf \"Hello\" :: Parser Char"
      ],
-     "prompt_number": 2
+     "language": "python",
+     "metadata": {},
+     "outputs": []
     },
     {
      "cell_type": "code",
@@ -107,30 +97,26 @@
      "cell_type": "code",
      "collapsed": false,
      "input": [
-      "x"
+      "oneOf \"Hello\" :: Parser Char"
      ],
      "language": "python",
      "metadata": {},
      "outputs": [
       {
        "html": [
-        "\n",
-        "        <form><textarea id=\"text33712347157\">Hello!</textarea></form>\n",
-        "        <script>\n",
-        "          var textarea = document.getElementById(\"text33712347157\");\n",
-        "          var editor = CodeMirror.fromTextArea(textarea);\n",
-        "          editor.on(\"change\", function() {\n",
-        "            var text = editor.textContent;\n",
-        "            console.log(\"New text: \" + text);\n",
-        "          });\n",
-        "        </script>\n",
-        "        "
+        "<span class='err-msg'>Not in scope: type constructor or class `Parser'<br/><br/><br/>Not in scope: `oneOf'</span>"
        ],
        "metadata": {},
-       "output_type": "display_data"
+       "output_type": "display_data",
+       "text": [
+        "Not in scope: type constructor or class `Parser'\n",
+        "\n",
+        "\n",
+        "Not in scope: `oneOf'"
+       ]
       }
      ],
-     "prompt_number": 4
+     "prompt_number": 1
     },
     {
      "cell_type": "code",

src/IHaskell/Display.hs

 {-# LANGUAGE NoImplicitPrelude, OverloadedStrings, FlexibleInstances #-}
 module IHaskell.Display (
   IHaskellDisplay(..),
+  IHaskellWidget(..),
   plain, html, png, jpg, svg, latex,
   serializeDisplay,
   Width, Height, Base64(..),
@@ -10,7 +11,8 @@ module IHaskell.Display (
   printDisplay,
 
   -- Internal only use
-  displayFromChan
+  displayFromChan,
+  Widget(..),
   ) where
 
 import ClassyPrelude

src/IHaskell/Eval/Evaluate.hs

@@ -69,6 +69,7 @@ import IHaskell.Display
 import qualified IHaskell.Eval.Hoogle as Hoogle
 import IHaskell.Eval.Util
 import IHaskell.BrokenPackages
+import qualified  IPython.Message.UUID      as UUID
 
 import Paths_ihaskell (version)
 import Data.Version (versionBranch)
@@ -680,8 +681,21 @@ evalCommand output (Expression expr) state = do
   let displayExpr = printf "(IHaskell.Display.display (%s))" expr :: String
   canRunDisplay <- attempt $ exprType displayExpr
 
+  -- Check if this is a widget.
+  let widgetExpr = printf "(IHaskell.Display.Widget (%s))" expr :: String
+  isWidget <- attempt $ exprType displayExpr
+
   if canRunDisplay
-  then useDisplay displayExpr
+  then do
+    -- Use the display. As a result, `it` is set to the output.
+    out <- useDisplay displayExpr
+
+    -- Register the `it` object as a widget.
+    newState <- if isWidget
+               then registerWidget out
+               else return state
+    return out { evalState = newState }
+
   else do
     -- Evaluate this expression as though it's just a statement.
     -- The output is bound to 'it', so we can then use it.
@@ -756,6 +770,31 @@ evalCommand output (Expression expr) state = do
                     then display :: Display
                     else removeSvg display
 
+    registerWidget state evalOut =
+      when (evalStatus evalOut == Success) $ do
+        element <- dynCompileExpr "IHaskell.Display.Widget it"
+        case fromDynamic element of
+          Nothing -> error "Expecting widget"
+          Just widget -> do
+            -- Stick the widget in the kernel state.
+            uuid <- UUID.random
+            let newComms = Map.insert uuid widget $ openComms state
+                newState = state { openComms = newComms }
+
+            -- Start the comm.
+            startComm uuid widget
+            -- HOW DO WE START A COMM?
+            -- 1. Add field to EvalOut
+            -- that describes commes to start
+            -- 2. Add method to IHaskellWidget that describes the
+            -- target_name.
+            -- 3. Store UUID and target_name in EvalOut field.
+            -- 4. When EvalOut is returned, have Main.hs start the comm.
+            -- 5. Have JS receive the comm and create a widget, just like
+            -- it does in the real IPython example.
+
+            return newState
+
     isIO expr = attempt $ exprType $ printf "((\\x -> x) :: IO a -> IO a) (%s)" expr
 
     postprocessShowError :: EvalOut -> EvalOut

src/IHaskell/Types.hs

@@ -97,6 +97,7 @@ class IHaskellDisplay a => IHaskellWidget a where
         -> IO ()
 
 data Widget = forall a. IHaskellWidget a => Widget a
+            deriving Typeable
 
 instance Show Widget where
   show _ = "<Widget>"