Started with display_data

ihaskell-display/ihaskell-widgets/MsgSpec.md

@@ -39,11 +39,17 @@ the kernel.
 ## Displaying widgets
 
 The creation of a widget does not display it. To display a widget, the kernel sends a display
-message to the frontend on the widget's comm.
+message to the frontend on the widget's iopub, with a custom mimetype instead of text/plain.
 
 ```json
-{
-    "method": "display"
+method = "display_data",
+content = {
+    "data": {
+      "application/vnd.jupyter.widget-view+json": {
+      "model_id": "u-u-i-d",
+      "version_major": 2,
+      "version_minor": 0,
+    }
 }
 ```
 

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs

@@ -17,6 +17,8 @@ import           Prelude
 
 import           Control.Monad (void)
 import           Data.Aeson
+import           Data.Text.Lazy (unpack)
+import           Data.Text.Lazy.Encoding
 import           Data.IORef (newIORef)
 import qualified Data.Scientific as Sci
 import           Data.Vinyl (Rec(..), (<+>))
@@ -58,7 +60,7 @@ mkIntSlider = do
 instance IHaskellDisplay IntSlider where
   display b = do
     widgetSendView b
-    return $ Display []
+    return $ Display [ widgetdisplay $ unpack $ decodeUtf8 $ encode $ object [ "model_id" .= getCommUUID b, "version_major" .= toInteger 2, "version_minor" .= toInteger 0] ]
 
 instance IHaskellWidget IntSlider where
   getCommUUID = uuid

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

@@ -789,6 +789,7 @@ data MimeType = PlainText
               | MimeVega
               | MimeVegalite
               | MimeVdom
+              | MimeWidget
               | MimeCustom Text
   deriving (Eq, Typeable, Generic)
 
@@ -817,6 +818,7 @@ instance Show MimeType where
   show MimeVega = "application/vnd.vega.v5+json"
   show MimeVegalite = "application/vnd.vegalite.v4+json"
   show MimeVdom = "application/vdom.v1+json"
+  show MimeWidget = "application/vnd.jupyter.widget-view+json"
   show (MimeCustom custom) = Text.unpack custom
 
 instance Read MimeType where
@@ -834,6 +836,7 @@ instance Read MimeType where
   readsPrec _ "application/vnd.vega.v5+json" = [(MimeVega, "")]
   readsPrec _ "application/vnd.vegalite.v4+json" = [(MimeVegalite, "")]
   readsPrec _ "application/vdom.v1+json" = [(MimeVdom, "")]
+  readsPrec _ "application/vnd.jupyter.widget-view+json" = [(MimeWidget, "")]
   readsPrec _ t = [(MimeCustom (Text.pack t), "")]
 
 -- | Convert a MIME type and value into a JSON dictionary pair.
@@ -844,6 +847,8 @@ displayDataToJson (DisplayData MimeVegalite dataStr) =
     pack (show MimeVegalite) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value)
 displayDataToJson (DisplayData MimeVega dataStr) =
     pack (show MimeVega) .= fromMaybe (String "") (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value)
+displayDataToJson (DisplayData MimeWidget dataStr) =
+    pack (show MimeWidget) .= fromMaybe (object []) (decodeStrict (Text.encodeUtf8 dataStr) :: Maybe Value)
 displayDataToJson (DisplayData mimeType dataStr) =
   pack (show mimeType) .= String dataStr
 

src/IHaskell/Display.hs

@@ -37,6 +37,7 @@ module IHaskell.Display (
     vega,
     vegalite,
     vdom,
+    widgetdisplay,
     custom,
     many,
 
@@ -150,6 +151,10 @@ png width height = DisplayData (MimePng width height)
 jpg :: Width -> Height -> Base64 -> DisplayData
 jpg width height = DisplayData (MimeJpg width height)
 
+-- | Generate a Widget display given the uuid and the view version
+widgetdisplay :: String -> DisplayData
+widgetdisplay = DisplayData MimeWidget .T.pack
+
 -- | Convert from a string into base 64 encoded data.
 encode64 :: String -> Base64
 encode64 str = base64 $ CBS.pack str

src/IHaskell/Types.hs

@@ -280,7 +280,7 @@ dupHeader hdr messageType = do
   uuid <- liftIO random
   return hdr { mhMessageId = uuid, mhMsgType = messageType }
 
--- | Modyfies a header and appends the version as metadata
+-- | Modyfies a header and appends the version of the Widget Messaging Protocol as metadata
 setVersion :: MessageHeader  -- ^ The header to modify
            -> String         -- ^ The version to set
            -> MessageHeader  -- ^ The modified header