Add CommInfoRequest and CommInfoReply

ipython-kernel/src/IHaskell/IPython/EasyKernel.hs

@@ -174,6 +174,12 @@ replyTo config _ _ KernelInfoRequest{} replyHeader =
       , protocolVersion = kernelProtocolVersion config
       }
 
+replyTo config _ _ CommInfoRequest{} replyHeader =
+  return
+    CommInfoReply
+      { header = replyHeader
+      , commInfo = Map.empty }
+
 replyTo config _ interface ShutdownRequest { restartPending = pending } replyHeader = do
   liftIO $ writeChan (shellReplyChannel interface) $ ShutdownReply replyHeader pending
   liftIO exitSuccess

ipython-kernel/src/IHaskell/IPython/Message/Parser.hs

@@ -90,6 +90,7 @@ parser ShutdownRequestMessage = shutdownRequestParser
 parser InputReplyMessage = inputReplyParser
 parser CommOpenMessage = commOpenParser
 parser CommDataMessage = commDataParser
+parser CommInfoRequestMessage = commInfoRequestParser
 parser CommCloseMessage = commCloseParser
 parser HistoryRequestMessage = historyRequestParser
 parser StatusMessage = statusMessageParser
@@ -104,6 +105,11 @@ parser other = error $ "Unknown message type " ++ show other
 kernelInfoRequestParser :: LByteString -> Message
 kernelInfoRequestParser _ = KernelInfoRequest { header = noHeader }
 
+-- | Parse a comm info request. A comm info request has no auxiliary information, so ignore the
+-- body.
+commInfoRequestParser :: LByteString -> Message
+commInfoRequestParser _ = CommInfoRequest { header = noHeader }
+
 -- | Parse an execute_input response. Fields used are:
 executeInputParser :: LByteString -> Message
 executeInputParser = requestParser $ \obj -> do

ipython-kernel/src/IHaskell/IPython/Message/Writer.hs

@@ -11,6 +11,7 @@ import           Data.Aeson.Types (Pair)
 import           Data.Map (Map)
 import           Data.Monoid (mempty)
 import           Data.Text (Text, pack)
+import qualified Data.Map               as Map
 import           IHaskell.IPython.Types
 
 instance ToJSON LanguageInfo where
@@ -32,6 +33,13 @@ instance ToJSON Message where
       , "language_info" .= languageInfo rep
       ]
 
+  toJSON CommInfoReply
+    { header = header
+    , commInfo = commInfo
+    } =
+    object
+      [ "comms" .= Map.map (\comm -> object ["target_name" .= comm]) commInfo ]
+
   toJSON ExecuteRequest
     { getCode = code
     , getSilent = silent

ipython-kernel/src/IHaskell/IPython/Types.hs

@@ -193,6 +193,8 @@ data MessageType = KernelInfoReplyMessage
                  | InputReplyMessage
                  | CommOpenMessage
                  | CommDataMessage
+                 | CommInfoRequestMessage
+                 | CommInfoReplyMessage
                  | CommCloseMessage
                  | HistoryRequestMessage
                  | HistoryReplyMessage
@@ -224,6 +226,8 @@ showMessageType InputRequestMessage = "input_request"
 showMessageType InputReplyMessage = "input_reply"
 showMessageType CommOpenMessage = "comm_open"
 showMessageType CommDataMessage = "comm_msg"
+showMessageType CommInfoRequestMessage = "comm_info_request"
+showMessageType CommInfoReplyMessage = "comm_info_reply"
 showMessageType CommCloseMessage = "comm_close"
 showMessageType HistoryRequestMessage = "history_request"
 showMessageType HistoryReplyMessage = "history_reply"
@@ -256,6 +260,8 @@ instance FromJSON MessageType where
       "input_reply"         -> return InputReplyMessage
       "comm_open"           -> return CommOpenMessage
       "comm_msg"            -> return CommDataMessage
+      "comm_info_request"   -> return CommInfoRequestMessage
+      "comm_info_reply"     -> return CommInfoReplyMessage
       "comm_close"          -> return CommCloseMessage
       "history_request"     -> return HistoryRequestMessage
       "history_reply"       -> return HistoryReplyMessage
@@ -295,6 +301,15 @@ data Message =
                  , languageInfo :: LanguageInfo
                  }
              |
+             -- | A request from a frontend for information about the comms.
+               CommInfoRequest { header :: MessageHeader }
+             |
+             -- | A response to a CommInfoRequest.
+               CommInfoReply
+                 { header   :: MessageHeader
+                 , commInfo :: Map String String -- ^ A dictionary of the comms, indexed by uuids.
+                 }
+             |
              -- | A request from a frontend to execute some code.
                ExecuteInput
                  { header :: MessageHeader
@@ -519,6 +534,7 @@ replyType InspectRequestMessage = Just InspectReplyMessage
 replyType ShutdownRequestMessage = Just ShutdownReplyMessage
 replyType HistoryRequestMessage = Just HistoryReplyMessage
 replyType CommOpenMessage = Just CommDataMessage
+replyType CommInfoRequestMessage = Just CommInfoReplyMessage
 replyType _ = Nothing
 
 -- | Data for display: a string with associated MIME type.

main/Main.hs

@@ -263,6 +263,14 @@ replyTo _ KernelInfoRequest{} replyHeader state =
                 }
               })
 
+replyTo _ CommInfoRequest{} replyHeader state =
+  let comms = Map.mapKeys (UUID.uuidToString) (openComms state) in
+  return
+    (state, CommInfoReply
+              { header = replyHeader
+              , commInfo = Map.map (\(Widget w) -> targetName w) comms
+              })
+
 -- Reply to a shutdown request by exiting the main thread. Before shutdown, reply to the request to
 -- let the frontend know shutdown is happening.
 replyTo interface ShutdownRequest { restartPending = restartPending } replyHeader _ = liftIO $ do