cleaned things up, and initial version of stuff works!!

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

-{-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, QuasiQuotes, FlexibleInstances #-}
+{-# LANGUAGE NoImplicitPrelude, TypeSynonymInstances, QuasiQuotes, FlexibleInstances, OverloadedStrings #-}
 module IHaskell.Display.Parsec () where
 
-import ClassyPrelude
+import ClassyPrelude hiding (fromList)
 import System.Random
 import Data.String.Here
+import Data.HashMap.Strict as Map
 
+import Text.Parsec
+import Text.Parsec.Prim
 import Text.Parsec.String
+import Text.Parsec.Error
+
+import Data.Aeson
 
 import IHaskell.Display
 
-instance IHaskellDisplay (Parser a) where
-  display renderable = do
-    key <- randomRIO (1, 100000000000) :: IO Int
-    return $ Display [html $ dom key]
+instance Show a => IHaskellDisplay (Parser a) where
+  display renderable = return $ Display [html dom]
     where 
-      dom key = 
-        let divId = "text" ++ show key ++ "" in
+      dom = 
         [i|
-        <form><textarea id="parsec-editor">Hello!</textarea></form>
-        <!--
-        <script>
-          // Register the comm target.
-          var ParsecWidget = function (comm) {
-              this.comm = comm;
-              this.comm.on_msg($.proxy(this.handler, this));
-
-              // get the cell that was probably executed
-              // msg_id:cell mapping will make this possible without guessing
-              this.cell = IPython.notebook.get_cell(IPython.notebook.get_selected_index()-1);
-              this.callbacks = {
-                  iopub : {
-                      output : function () {
-                          console.log("Iopub output", arguments);
-                      }
-                  }
-              };
-
-              // Create the editor.
-              console.log("Editoring");
-              var out = this.cell.output_area.element;
-              var textarea = output_area.find("#parsec-editor")[0];
-              var editor = CodeMirror.fromTextArea(textarea);
-              editor.on("change", function() {
-                var text = editor.getDoc().getValue();
-                console.log("New text: " + text);
-                comm.send({"text": text}, function () {
-                    console.log("Got response!", arguments);
-                });
-              });
-          };
-
-          ParsecWidget.prototype.handler = function(msg) {
-              console.log('handle', this, msg, this.cell.output_area);
-          };
-
-          IPython.notebook.kernel.comm_manager.register_target('parsec', IPython.utils.always_new(ParsecWidget));
-        </script>
-        -->
+        <script src="/static/components/codemirror/addon/lint/lint.js" charset="utf-8"></script>
+        <form><textarea id="parsec-editor">Insert parser text here...</textarea></form>
+        <pre id="parsec-output"></pre>
         |]
 
-instance IHaskellWidget (Parser a) where
+-- | Text to parse.
+data ParseText = ParseText String
+
+instance FromJSON ParseText where
+  parseJSON (Object v) = ParseText <$> v .: "text"
+  parseJSON _          = fail "Expecting object"
+
+-- | Output of parsing.
+instance Show a => ToJSON (Either ParseError a) where
+  toJSON (Left err) = object [
+                        "status" .= ("error" :: String),
+                        "line" .= sourceLine (errorPos err),
+                        "col" .= sourceColumn (errorPos err),
+                        "msg" .= show err
+                      ]
+  toJSON (Right result) = object [
+                               "status" .= ("success" :: String),
+                               "result" .= show result
+                            ]
+
+instance Show a => IHaskellWidget (Parser a) where
+  -- Name for this widget.
   targetName _ = "parsec"
-  open widget value publisher = return ()
-  comm widget value publisher = do
-    DEAL WITH ACTUAL PARSECS
-    publisher value
+
+  -- When we rece
+  comm widget (Object dict) publisher = do
+    let key = "text" :: Text
+        Just (String text) = Map.lookup key dict
+        result = parse widget "<interactive>" $ unpack text
+    publisher $ toJSON result
+
+  -- We have no resources to close.
   close widget value = return ()

ihaskell-display/ihaskell-parsec/ihaskell-parsec.cabal

@@ -58,6 +58,8 @@ library
              
   -- Other library packages from which modules are imported.
   build-depends:       base ==4.6.*,
+                       aeson ==0.7.*,
+                       unordered-containers,
                        classy-prelude,
                        random >= 1,
                        parsec,

ipython-kernel/src/IPython/Types.hs

@@ -342,6 +342,8 @@ data Message
       commUuid :: UUID,
       commData :: Value
   }
+
+  | SendNothing -- Dummy message; nothing is sent.
     deriving Show
 
 -- | Possible statuses in the execution reply messages.

ipython-kernel/src/IPython/ZeroMQ.hs

@@ -179,6 +179,7 @@ receiveMessage socket = do
 -- | Encode a message in the IPython ZeroMQ communication protocol 
 -- | and send it through the provided socket.
 sendMessage :: Sender a => Socket a -> Message -> IO ()
+sendMessage _ SendNothing = return ()
 sendMessage socket message = do
   let head = header message
       parentHeaderStr = maybe "{}" encodeStrict $ parentHeader head

src/IHaskell/Types.hs

@@ -109,7 +109,6 @@ instance IHaskellDisplay Widget where
 
 instance IHaskellWidget Widget where
   targetName (Widget widget) = targetName widget
-  open (Widget widget) = open widget
   comm (Widget widget) = comm widget
   close (Widget widget) = close widget
 

src/Main.hs

@@ -189,6 +189,7 @@ runKernel profileSrc initInfo = do
         let replier = writeChan (iopubChannel interface)
         newState <- handleComm replier oldState request replyHeader
         putMVar state newState
+        writeChan (shellReplyChannel interface) SendNothing
       else do
         -- Create the reply, possibly modifying kernel state.
         oldState <- liftIO $ takeMVar state
@@ -201,7 +202,7 @@ runKernel profileSrc initInfo = do
     ignoreCtrlC =
       installHandler keyboardSignal (CatchOnce $ putStrLn "Press Ctrl-C again to quit kernel.") Nothing
 
-    isCommMessage req = msgType (header req) `elem` [CommOpenMessage, CommDataMessage, CommCloseMessage]
+    isCommMessage req = msgType (header req) `elem` [CommDataMessage, CommCloseMessage]
 
 -- Initial kernel state.
 initialKernelState :: IO (MVar KernelState)
@@ -373,25 +374,18 @@ replyTo _ ObjectInfoRequest{objectName = oname} replyHeader state = do
 
 handleComm :: (Message -> IO ()) -> KernelState -> Message -> MessageHeader -> IO KernelState
 handleComm replier kernelState req replyHeader = do
-  putStrLn "Handle comm"
   print req
   let widgets = openComms kernelState
       uuid = commUuid req
       dat = commData req
       communicate value = do
         head <- dupHeader replyHeader CommDataMessage
-        putStrLn "Sending back data:"
-        print value
         replier $ CommData head uuid value
   case lookup uuid widgets of
     Nothing -> fail $ "no widget with uuid " ++ show uuid
     Just (Widget widget) ->
       case msgType $ header req of
-        CommOpenMessage -> do
-          open widget dat communicate
-          return kernelState
         CommDataMessage -> do
-          putStrLn "comm data"
           comm widget dat communicate
           return kernelState
         CommCloseMessage -> do