ihaskell 0.7.1.0 → 0.8.0.0

raw patch · 4 files changed

+57/−18 lines, 4 files

Files

• ihaskell.cabal +1/−1
• main/Main.hs +39/−0
• src/IHaskell/Eval/Widgets.hs +8/−12
• src/IHaskell/Types.hs +9/−5

@@ -7,7 +7,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.7.1.0+version:             0.8.0.0  -- A short (one-line) description of the package. synopsis:            A Haskell backend kernel for the IPython project.

@@ -14,6 +14,7 @@ -- Standard library imports. import           Control.Concurrent (threadDelay) import           Control.Concurrent.Chan+import           Control.Arrow (second) import           Data.Aeson import           System.Directory import           System.Process (readProcess, readProcessWithExitCode)@@ -332,6 +333,44 @@         , historyReply = []         }   return (state, reply)++-- Accomodating the workaround for retrieving list of open comms from the kernel+--+-- The main idea is that the frontend opens a comm at kernel startup, whose target is a widget that+-- sends back the list of live comms and commits suicide.+--+-- The message needs to be written to the iopub channel, and not returned from here. If returned,+-- the same message also gets written to the shell channel, which causes issues due to two messages+-- having the same identifiers in their headers.+--+-- Sending the message only on the shell_reply channel doesn't work, so we send it as a comm message+-- on the iopub channel and return the SendNothing message.+replyTo interface open@CommOpen{} replyHeader state = do+  let send msg = liftIO $ writeChan (iopubChannel interface) msg++      incomingUuid = commUuid open+      target = commTargetName open++      targetMatches = target == "ipython.widget"+      valueMatches = commData open == object ["widget_class" .= "ipywidgets.CommInfo"]++      commMap = openComms state+      uuidTargetPairs = map (second targetName) $ Map.toList commMap++      pairProcessor (x, y) = T.pack (UUID.uuidToString x) .= object ["target_name" .= T.pack y]++      currentComms = object $ map pairProcessor $ (incomingUuid, "comm") : uuidTargetPairs++      replyValue = object [ "method" .= "custom"+                          , "content" .= object ["comms" .= currentComms]+                          ]++      msg = CommData replyHeader (commUuid open) replyValue++  -- To the iopub channel you go+  when (targetMatches && valueMatches) $ send msg++  return (state, SendNothing)  -- TODO: What else can be implemented? replyTo _ message _ state = do

@@ -52,9 +52,8 @@ widgetSend msgType widget value = queue $ msgType (Widget widget) value  -- | Send a message to open a comm-widgetSendOpen :: IHaskellWidget a => a -> Value -> Value -> IO ()-widgetSendOpen widget initVal stateVal =-  queue $ Open (Widget widget) initVal stateVal+widgetSendOpen :: IHaskellWidget a => a -> Value -> IO ()+widgetSendOpen = widgetSend Open  -- | Send a state update message widgetSendUpdate :: IHaskellWidget a => a -> Value -> IO ()@@ -93,8 +92,9 @@               -> IO KernelState handleMessage send replyHeader state msg = do   case msg of-    Open widget initVal stateVal -> do-      let target = targetName widget+    Open widget value -> do+      let target_name = targetName widget+          target_module = targetModule widget           uuid = getCommUUID widget           present = isJust $ Map.lookup uuid oldComms @@ -109,12 +109,9 @@       if present         then return state         else do-          -- Send the comm open+          -- Send the comm open, with the initial state           header <- dupHeader replyHeader CommOpenMessage-          send $ CommOpen header target uuid initVal--          -- Initial state update-          communicate . toJSON $ UpdateState stateVal+          send $ CommOpen header target_name target_module uuid value            -- Send anything else the widget requires.           open widget communicate@@ -123,8 +120,7 @@           return newState      Close widget value -> do-      let target = targetName widget-          uuid = getCommUUID widget+      let uuid = getCommUUID widget           present = isJust $ Map.lookup uuid oldComms            newComms = Map.delete uuid $ openComms state

@@ -65,11 +65,15 @@  -- | Display as an interactive widget. class IHaskellDisplay a => IHaskellWidget a where-  -- | Output target name for this widget. The actual input parameter should be ignored. By default-  -- evaluate to "ipython.widget", which is used by IPython for its backbone widgets.+  -- | Target name for this widget. The actual input parameter should be ignored. By default evaluate+  -- to "ipython.widget", which is used by IPython for its backbone widgets.   targetName :: a -> String   targetName _ = "ipython.widget" +  -- | Target module for this widget. Evaluates to an empty string by default.+  targetModule :: a -> String+  targetModule _ = ""+   -- | Get the uuid for comm associated with this widget. The widget is responsible for storing the   -- UUID during initialization.   getCommUUID :: a -> UUID@@ -102,6 +106,7 @@  instance IHaskellWidget Widget where   targetName (Widget widget) = targetName widget+  targetModule (Widget widget) = targetModule widget   getCommUUID (Widget widget) = getCommUUID widget   open (Widget widget) = open widget   comm (Widget widget) = comm widget@@ -185,11 +190,10 @@   deriving (Eq, Show)  -- | Send JSON objects with specific formats-data WidgetMsg = Open Widget Value Value+data WidgetMsg = Open Widget Value                |                -- ^ Cause the interpreter to open a new comm, and register the associated widget in-               -- the kernelState. Also sends a Value with comm_open, and then sends an initial-               -- state update Value.+               -- the kernelState. Also sends an initial state Value with comm_open.                 Update Widget Value                |                -- ^ Cause the interpreter to send a comm_msg containing a state update for the