mirror of
https://github.com/IHaskell/IHaskell.git
synced 2025-04-16 11:26:08 +00:00
Conform to the messaging spec
Still no visible outputs.
This commit is contained in:
parent
67406e3031
commit
42907a5bb4
@ -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 ()
|
||||
|
11
main/Main.hs
11
main/Main.hs
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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.
|
||||
|
Loading…
x
Reference in New Issue
Block a user