Conform to the messaging spec

Still no visible outputs.
This commit is contained in:
Sumit Sahrawat 2015-06-04 12:39:16 +05:30
parent 67406e3031
commit 42907a5bb4
5 changed files with 16 additions and 17 deletions

View File

@ -44,19 +44,13 @@ mkButton = do
let b = Button uuid desc ttip dis sty
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen b $ toJSON ButtonInitData
-- Initial state update
widgetSendUpdate b . toJSON . UpdateState . toJSON $ b
-- DEBUG: Try to display it too
widgetSendView b
widgetSendOpen b (toJSON ButtonInitData) (toJSON b)
-- Return the button widget
return b
update :: Button -> [Pair] -> IO ()
update b v = widgetSendUpdate b . toJSON . UpdateState . object $ v
update b v = widgetSendUpdate b . toJSON . object $ v
-- | Set the button style
setButtonStyle :: ButtonStyle -> Button -> IO ()

View File

@ -294,7 +294,7 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
else sendOutput $ Display pager
handleMessage :: KernelState -> WidgetMsg -> IO KernelState
handleMessage state (Open widget value) = do
handleMessage state (Open widget initVal stateVal) = do
-- Check whether the widget is already present in the state
let oldComms = openComms state
uuid = getCommUUID widget
@ -305,15 +305,18 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
target = targetName widget
communicate value = do
communicate val = do
head <- dupHeader replyHeader CommDataMessage
writeChan (iopubChannel interface) $ CommData head uuid value
writeChan (iopubChannel interface) $ CommData head uuid val
if present
then return state
else do -- Send the comm open
header <- dupHeader replyHeader CommOpenMessage
send $ CommOpen header target uuid value
send $ CommOpen header target uuid initVal
-- Initial state update
communicate . toJSON $ UpdateState stateVal
-- Send anything else the widget requires.
open widget communicate

View File

@ -918,7 +918,7 @@ evalCommand output (Expression expr) state = do
uuid = getCommUUID widget
case Map.lookup uuid oldComms of
Nothing -> error "Unregistered widget"
Just w -> do
Just _ -> do
liftIO $ widgetSendView widget
return evalOut

View File

@ -41,8 +41,9 @@ widgetSend :: IHaskellWidget a
-> a -> Value -> IO ()
widgetSend msgType widget value = queue $ msgType (Widget widget) value
widgetSendOpen :: IHaskellWidget a => a -> Value -> IO ()
widgetSendOpen = widgetSend Open
widgetSendOpen :: IHaskellWidget a => a -> Value -> Value -> IO ()
widgetSendOpen widget initVal stateVal =
queue $ Open (Widget widget) initVal stateVal
widgetSendUpdate :: IHaskellWidget a => a -> Value -> IO ()
widgetSendUpdate = widgetSend Update

View File

@ -182,10 +182,11 @@ data LintStatus = LintOn
| LintOff
deriving (Eq, Show)
data WidgetMsg = Open Widget Value
data WidgetMsg = Open Widget Value Value
-- ^ Cause the interpreter to open a new comm, and
-- register the associated widget in the
-- kernelState.
-- kernelState. Also sends a Value with comm_open,
-- and then sends an initial state update Value.
| Update Widget Value
-- ^ Cause the interpreter to send a comm_msg
-- containing a state update for the widget.