Commit 42907a5b authored by Sumit Sahrawat's avatar Sumit Sahrawat

Conform to the messaging spec

Still no visible outputs.
parent 67406e30
...@@ -44,19 +44,13 @@ mkButton = do ...@@ -44,19 +44,13 @@ mkButton = do
let b = Button uuid desc ttip dis sty let b = Button uuid desc ttip dis sty
-- Open a comm for this widget, and store it in the kernel state -- Open a comm for this widget, and store it in the kernel state
widgetSendOpen b $ toJSON ButtonInitData widgetSendOpen b (toJSON ButtonInitData) (toJSON b)
-- Initial state update
widgetSendUpdate b . toJSON . UpdateState . toJSON $ b
-- DEBUG: Try to display it too
widgetSendView b
-- Return the button widget -- Return the button widget
return b return b
update :: Button -> [Pair] -> IO () 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 -- | Set the button style
setButtonStyle :: ButtonStyle -> Button -> IO () setButtonStyle :: ButtonStyle -> Button -> IO ()
......
...@@ -294,7 +294,7 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do ...@@ -294,7 +294,7 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
else sendOutput $ Display pager else sendOutput $ Display pager
handleMessage :: KernelState -> WidgetMsg -> IO KernelState 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 -- Check whether the widget is already present in the state
let oldComms = openComms state let oldComms = openComms state
uuid = getCommUUID widget uuid = getCommUUID widget
...@@ -305,15 +305,18 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do ...@@ -305,15 +305,18 @@ replyTo interface req@ExecuteRequest { getCode = code } replyHeader state = do
target = targetName widget target = targetName widget
communicate value = do communicate val = do
head <- dupHeader replyHeader CommDataMessage head <- dupHeader replyHeader CommDataMessage
writeChan (iopubChannel interface) $ CommData head uuid value writeChan (iopubChannel interface) $ CommData head uuid val
if present if present
then return state then return state
else do -- Send the comm open else do -- Send the comm open
header <- dupHeader replyHeader CommOpenMessage 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. -- Send anything else the widget requires.
open widget communicate open widget communicate
......
...@@ -918,7 +918,7 @@ evalCommand output (Expression expr) state = do ...@@ -918,7 +918,7 @@ evalCommand output (Expression expr) state = do
uuid = getCommUUID widget uuid = getCommUUID widget
case Map.lookup uuid oldComms of case Map.lookup uuid oldComms of
Nothing -> error "Unregistered widget" Nothing -> error "Unregistered widget"
Just w -> do Just _ -> do
liftIO $ widgetSendView widget liftIO $ widgetSendView widget
return evalOut return evalOut
......
...@@ -41,8 +41,9 @@ widgetSend :: IHaskellWidget a ...@@ -41,8 +41,9 @@ widgetSend :: IHaskellWidget a
-> a -> Value -> IO () -> a -> Value -> IO ()
widgetSend msgType widget value = queue $ msgType (Widget widget) value widgetSend msgType widget value = queue $ msgType (Widget widget) value
widgetSendOpen :: IHaskellWidget a => a -> Value -> IO () widgetSendOpen :: IHaskellWidget a => a -> Value -> Value -> IO ()
widgetSendOpen = widgetSend Open widgetSendOpen widget initVal stateVal =
queue $ Open (Widget widget) initVal stateVal
widgetSendUpdate :: IHaskellWidget a => a -> Value -> IO () widgetSendUpdate :: IHaskellWidget a => a -> Value -> IO ()
widgetSendUpdate = widgetSend Update widgetSendUpdate = widgetSend Update
......
...@@ -182,10 +182,11 @@ data LintStatus = LintOn ...@@ -182,10 +182,11 @@ data LintStatus = LintOn
| LintOff | LintOff
deriving (Eq, Show) deriving (Eq, Show)
data WidgetMsg = Open Widget Value data WidgetMsg = Open Widget Value Value
-- ^ Cause the interpreter to open a new comm, and -- ^ Cause the interpreter to open a new comm, and
-- register the associated widget in the -- 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 | Update Widget Value
-- ^ Cause the interpreter to send a comm_msg -- ^ Cause the interpreter to send a comm_msg
-- containing a state update for the widget. -- containing a state update for the widget.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment