Widgets: Metadata now carries version of widget

.gitignore

@@ -24,3 +24,6 @@ cabal.sandbox.config
 .tmp3
 stack.yaml.lock
 result
+default.nix
+dist-*/
+cabal.project.local

ihaskell-display/ihaskell-widgets/ChangeLog.md

@@ -1,5 +1,8 @@
 # ChangeLog for `ihaskell-widgets`
 
+## `v0.3.0.0`
+> Revamped to be compatible with Widget Messaging Protocol, version 2
+
 ## `v0.2.2.1`
 
 + The `properties` function now prints types associated with widget fields.

ihaskell-display/ihaskell-widgets/MsgSpec.md

@@ -14,6 +14,8 @@ the widget.
 
 > The comm should be opened with a `target_name` of `"ipython.widget"`.
 
+> The comm_open message's metadata gives the version of the widget messaging protocol, i.e., `{'version': '2.0.0'}`
+
 Any *numeric* property initialized with the empty string is provided the default value by the
 frontend. Some numbers need to be sent as actual numbers (when non-null), whereas the ones representing
 lengths in CSS units need to be sent as strings.

ihaskell-display/ihaskell-widgets/ihaskell-widgets.cabal

@@ -10,7 +10,7 @@ name:                ihaskell-widgets
 -- PVP summary:      +-+------- breaking API changes
 --                   | | +----- non-breaking API additions
 --                   | | | +--- code changes with no API change
-version:             0.2.3.3
+version:             0.3.0.0
 
 -- A short (one-line) description of the package.
 synopsis:            IPython standard widgets for IHaskell.

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

@@ -62,6 +62,7 @@ instance IHaskellDisplay IntSlider where
 
 instance IHaskellWidget IntSlider where
   getCommUUID = uuid
+  getVersion _ = "2.0.0"
   comm widget val _ =
     case nestedObjectLookup val ["sync_data", "value"] of
       Just (Number value) -> do

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs

@@ -13,7 +13,6 @@
 {-# LANGUAGE ConstraintKinds #-}
 {-# LANGUAGE ExistentialQuantification #-}
 {-# LANGUAGE GADTs #-}
-{-# LANGUAGE AutoDeriveTypeable #-}
 {-# LANGUAGE CPP #-}
 
 -- | This module houses all the type-trickery needed to make widgets happen.

src/IHaskell/Eval/Widgets.hs

@@ -109,7 +109,8 @@ handleMessage send replyHeader state msg = do
         else do
           -- Send the comm open, with the initial state
           hdr <- dupHeader replyHeader CommOpenMessage
-          send $ CommOpen hdr target_name target_module uuid value
+          let hdrV = setVersion hdr $ getVersion widget
+          send $ CommOpen hdrV target_name target_module uuid value
 
           -- Send anything else the widget requires.
           open widget communicate
@@ -189,7 +190,7 @@ instance ToJSON IPythonMessage where
     object
       [ "header" .= replyHeader
       , "parent_header" .= str ""
-      , "metadata" .= str "{}"
+      , "metadata" .= object []
       , "content" .= val
       , "msg_type" .= (toJSON . showMessageType $ mtype)
       ]

src/IHaskell/Types.hs

@@ -11,6 +11,7 @@ module IHaskell.Types (
     MessageHeader(..),
     MessageType(..),
     dupHeader,
+    setVersion,
     Username,
     Metadata,
     replyType,
@@ -41,8 +42,10 @@ module IHaskell.Types (
 
 import           IHaskellPrelude
 
-import           Data.Aeson (ToJSON (..), Value, (.=), object)
+import qualified Data.HashMap.Strict as HashMap
+import           Data.Aeson (ToJSON (..), Value, (.=), object, Object, Value(String))
 import           Data.Function (on)
+import           Data.Text (pack)
 import           Data.Serialize
 import           GHC.Generics
 
@@ -73,6 +76,9 @@ class IHaskellDisplay a => IHaskellWidget a where
   -- UUID during initialization.
   getCommUUID :: a -> UUID
 
+  -- | Get the version for this widget. Sent as metadata during comm_open.
+  getVersion :: a -> String
+
   -- | Called when the comm is opened. Allows additional messages to be sent after comm open.
   open :: a                -- ^ Widget to open a comm port with.
        -> (Value -> IO ()) -- ^ A function for sending messages.
@@ -125,6 +131,7 @@ instance IHaskellWidget Widget where
   targetName (Widget widget) = targetName widget
   targetModule (Widget widget) = targetModule widget
   getCommUUID (Widget widget) = getCommUUID widget
+  getVersion (Widget widget) = getVersion widget
   open (Widget widget) = open widget
   comm (Widget widget) = comm widget
   close (Widget widget) = close widget
@@ -277,6 +284,12 @@ dupHeader hdr messageType = do
   uuid <- liftIO random
   return hdr { mhMessageId = uuid, mhMsgType = messageType }
 
+-- | Modyfies a header and appends the version as metadata
+setVersion :: MessageHeader  -- ^ The header to modify
+           -> String         -- ^ The version to set
+           -> MessageHeader  -- ^ The modified header
+setVersion hdr v = hdr { mhMetadata = Metadata (HashMap.fromList [("version", String $ pack v)]) } 
+
 -- | Whether or not an error occurred.
 data ErrorOccurred = Success
                    | Failure