From 9168aa5bef81ae15e4a82ef424f609d72427b33e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?David=20Dav=C3=B3?= Date: Sat, 12 Jun 2021 16:42:31 +0200 Subject: [PATCH] Widgets: Metadata now carries version of widget --- .gitignore | 3 +++ ihaskell-display/ihaskell-widgets/ChangeLog.md | 3 +++ ihaskell-display/ihaskell-widgets/MsgSpec.md | 2 ++ .../ihaskell-widgets/ihaskell-widgets.cabal | 2 +- .../Display/Widgets/Int/BoundedInt/IntSlider.hs | 1 + .../src/IHaskell/Display/Widgets/Types.hs | 1 - src/IHaskell/Eval/Widgets.hs | 5 +++-- src/IHaskell/Types.hs | 15 ++++++++++++++- 8 files changed, 27 insertions(+), 5 deletions(-) diff --git a/.gitignore b/.gitignore index 2f573123..fd3bb465 100644 --- a/.gitignore +++ b/.gitignore @@ -24,3 +24,6 @@ cabal.sandbox.config .tmp3 stack.yaml.lock result +default.nix +dist-*/ +cabal.project.local \ No newline at end of file diff --git a/ihaskell-display/ihaskell-widgets/ChangeLog.md b/ihaskell-display/ihaskell-widgets/ChangeLog.md index fff0c97d..56a9cf93 100644 --- a/ihaskell-display/ihaskell-widgets/ChangeLog.md +++ b/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. diff --git a/ihaskell-display/ihaskell-widgets/MsgSpec.md b/ihaskell-display/ihaskell-widgets/MsgSpec.md index 6ce9ca60..fb20be72 100644 --- a/ihaskell-display/ihaskell-widgets/MsgSpec.md +++ b/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. diff --git a/ihaskell-display/ihaskell-widgets/ihaskell-widgets.cabal b/ihaskell-display/ihaskell-widgets/ihaskell-widgets.cabal index 87cc3406..c2724af5 100644 --- a/ihaskell-display/ihaskell-widgets/ihaskell-widgets.cabal +++ b/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. diff --git a/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs b/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs index f9bbb2ee..a705f57e 100644 --- a/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs +++ b/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 diff --git a/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs b/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs index b58cfb2d..d2e99703 100644 --- a/ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs +++ b/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. diff --git a/src/IHaskell/Eval/Widgets.hs b/src/IHaskell/Eval/Widgets.hs index 77748874..5bf587d7 100644 --- a/src/IHaskell/Eval/Widgets.hs +++ b/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) ] diff --git a/src/IHaskell/Types.hs b/src/IHaskell/Types.hs index 03a20a96..7caa87a7 100644 --- a/src/IHaskell/Types.hs +++ b/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