mirrors/IHaskell
1
0
Fork 0
mirror of https://github.com/IHaskell/IHaskell.git synced 2025-04-16 11:26:08 +00:00
Code Issues Packages Projects Releases Wiki Activity

Make widget messages match with IPywidgets

Browse Source 
The ihaskell-widgets should send messages identical to what the
IPywidgets send. This has not been tested as there are some unresolved
issues in IHaskell that surface only if ipywidgets is installed.
This commit is contained in:
Sumit Sahrawat 2015-09-02 01:06:54 +05:30
parent fe02d7db60
commit 48c3c1f689
36 changed files with 71 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Bool/CheckBox.hs
View File

@ -40,11 +40,9 @@ mkCheckBox = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Checkbox"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the image widget
return widget

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Bool/ToggleButton.hs
View File

@ -45,11 +45,9 @@ mkToggleButton = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.ToggleButton"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the image widget
return widget

3
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/Box.hs
View File

@ -40,10 +40,9 @@ mkBox = do
stateIO <- newIORef widgetState
let box = IPythonWidget uuid stateIO
initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Box"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen box initData $ toJSON widgetState
widgetSendOpen box $ toJSON widgetState
-- Return the widget
return box

3
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/FlexBox.hs
View File

@ -46,10 +46,9 @@ mkFlexBox = do
stateIO <- newIORef widgetState
let box = IPythonWidget uuid stateIO
initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.FlexBox"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen box initData $ toJSON widgetState
widgetSendOpen box $ toJSON widgetState
-- Return the widget
return box

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/SelectionContainer/Accordion.hs
View File

@ -41,11 +41,9 @@ mkAccordion = do
stateIO <- newIORef widgetState
let box = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Accordion"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen box initData $ toJSON widgetState
widgetSendOpen box $ toJSON widgetState
-- Return the widget
return box

3
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/SelectionContainer/Tab.hs
View File

@ -41,10 +41,9 @@ mkTabWidget = do
stateIO <- newIORef widgetState
let box = IPythonWidget uuid stateIO
initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Tab"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen box initData $ toJSON widgetState
widgetSendOpen box $ toJSON widgetState
-- Return the widget
return box

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Button.hs
View File

@ -49,10 +49,8 @@ mkButton = do
let button = IPythonWidget uuid stateIO
let initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Button"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen button initData $ toJSON buttonState
widgetSendOpen button $ toJSON buttonState
-- Return the button widget
return button

2
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Common.hs
View File

@ -18,6 +18,8 @@ import qualified IHaskell.Display.Widgets.Singletons as S
pattern ViewModule = S.SViewModule
pattern ViewName = S.SViewName
pattern ModelModule = S.SModelModule
pattern ModelName = S.SModelName
pattern MsgThrottle = S.SMsgThrottle
pattern Version = S.SVersion
pattern DisplayHandler = S.SDisplayHandler

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/BoundedFloatText.hs
View File

@ -42,13 +42,9 @@ mkBoundedFloatText = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
[ "model_name" .= str "WidgetModel"
, "widget_class" .= str "IPython.BoundedFloatText"
]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatProgress.hs
View File

@ -44,13 +44,9 @@ mkFloatProgress = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
[ "model_name" .= str "WidgetModel"
, "widget_class" .= str "IPython.FloatProgress"
]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatSlider.hs
View File

@ -47,11 +47,9 @@ mkFloatSlider = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.FloatSlider"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloatRange/FloatRangeSlider.hs
View File

@ -50,13 +50,9 @@ mkFloatRangeSlider = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
[ "model_name" .= str "WidgetModel"
, "widget_class" .= str "IPython.FloatRangeSlider"
]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/FloatText.hs
View File

@ -41,11 +41,9 @@ mkFloatText = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.FloatText"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Image.hs
View File

@ -46,10 +46,8 @@ mkImageWidget = do
let widget = IPythonWidget uuid stateIO
let initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Image"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the image widget
return widget

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs
View File

@ -41,13 +41,9 @@ mkBoundedIntText = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
[ "model_name" .= str "WidgetModel"
, "widget_class" .= str "IPython.BoundedIntText"
]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs
View File

@ -44,11 +44,9 @@ mkIntProgress = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.IntProgress"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

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

@ -47,11 +47,9 @@ mkIntSlider = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.IntSlider"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs
View File

@ -48,13 +48,9 @@ mkIntRangeSlider = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
[ "model_name" .= str "WidgetModel"
, "widget_class" .= str "IPython.IntRangeSlider"
]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

3
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/IntText.hs
View File

@ -41,10 +41,9 @@ mkIntText = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.IntText"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

3
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Output.hs
View File

@ -45,10 +45,9 @@ mkOutputWidget = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object ["model_name" .= str "WidgetModel"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the image widget
return widget

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/Dropdown.hs
View File

@ -41,11 +41,9 @@ mkDropdown = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Dropdown"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/RadioButtons.hs
View File

@ -39,11 +39,9 @@ mkRadioButtons = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.RadioButtons"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

3
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/Select.hs
View File

@ -39,10 +39,9 @@ mkSelect = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Select"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/SelectMultiple.hs
View File

@ -40,13 +40,9 @@ mkSelectMultiple = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
[ "model_name" .= str "WidgetModel"
, "widget_class" .= str "IPython.SelectMultiple"
]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

6
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/ToggleButtons.hs
View File

@ -44,13 +44,9 @@ mkToggleButtons = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
[ "model_name" .= str "WidgetModel"
, "widget_class" .= str "IPython.ToggleButtons"
]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Singletons.hs
View File

@ -13,9 +13,11 @@ import Data.Singletons.TH
-- Widget properties
singletons
[d|
data Field = ViewModule
| ViewName
| ModelModule
| ModelName
| MsgThrottle
| Version
| DisplayHandler

3
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/HTML.hs
View File

@ -37,10 +37,9 @@ mkHTMLWidget = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.HTML"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

3
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/Latex.hs
View File

@ -37,10 +37,9 @@ mkLatexWidget = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Latex"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

3
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/Text.hs
View File

@ -41,10 +41,9 @@ mkTextWidget = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Text"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

4
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/TextArea.hs
View File

@ -41,11 +41,9 @@ mkTextArea = do
stateIO <- newIORef widgetState
let widget = IPythonWidget uuid stateIO
initData = object
["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Textarea"]
-- Open a comm for this widget, and store it in the kernel state
widgetSendOpen widget initData $ toJSON widgetState
widgetSendOpen widget $ toJSON widgetState
-- Return the widget
return widget

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

@ -57,7 +57,7 @@ module IHaskell.Display.Widgets.Types where
-- To know more about the IPython messaging specification (as implemented in this package) take a
-- look at the supplied MsgSpec.md.
--
-- Widgets are not able to do console input, the reason for that can also be found in the messaging
-- Widgets are not able to do console input, the reason for that can be found in the messaging
-- specification
import Control.Monad (unless, join, when, void, mapM_)
import Control.Applicative ((<$>))
@ -89,7 +89,7 @@ import qualified IHaskell.Display.Widgets.Singletons as S
import IHaskell.Display.Widgets.Common
-- Classes from IPython's widget hierarchy. Defined as such to reduce code duplication.
type WidgetClass = '[S.ViewModule, S.ViewName, S.MsgThrottle, S.Version,
type WidgetClass = '[S.ViewModule, S.ViewName, S.ModelModule, S.ModelName, S.MsgThrottle, S.Version,
S.DisplayHandler]
type DOMWidgetClass = WidgetClass :++ '[S.Visible, S.CSS, S.DOMClasses, S.Width, S.Height, S.Padding,
@ -128,10 +128,12 @@ type BoxClass = DOMWidgetClass :++ '[S.Children, S.OverflowX, S.OverflowY, S.Box
type SelectionContainerClass = BoxClass :++ '[S.Titles, S.SelectedIndex, S.ChangeHandler]
-- Types associated with Fields.
type family FieldType (f :: Field) :: * where
FieldType S.ViewModule = Text
FieldType S.ViewName = Text
FieldType S.ModelModule = Text
FieldType S.ModelName = Text
FieldType S.MsgThrottle = Integer
FieldType S.Version = Integer
FieldType S.DisplayHandler = IO ()
@ -339,6 +341,12 @@ instance ToPairs (Attr S.ViewModule) where
instance ToPairs (Attr S.ViewName) where
toPairs x = ["_view_name" .= toJSON x]
instance ToPairs (Attr S.ModelModule) where
toPairs x = ["_model_module" .= toJSON x]
instance ToPairs (Attr S.ModelName) where
toPairs x = ["_model_name" .= toJSON x]
instance ToPairs (Attr S.MsgThrottle) where
toPairs x = ["msg_throttle" .= toJSON x]
@ -591,6 +599,8 @@ reflect = fromSing
defaultWidget :: FieldType S.ViewName -> Rec Attr WidgetClass
defaultWidget viewName = (ViewModule =:: "")
:& (ViewName =:: viewName)
:& (ModelModule =:: "")
:& (ModelName =:: "WidgetModel")
:& (MsgThrottle =:+ 3)
:& (Version =:: 0)
:& (DisplayHandler =:: return ())

5
ipython-kernel/src/IHaskell/IPython/Message/Parser.hs
View File

@ -159,9 +159,10 @@ inputReplyParser = requestParser $ \obj -> do
commOpenParser :: LByteString -> Message
commOpenParser = requestParser $ \obj -> do
uuid <- obj .: "comm_id"
name <- obj .: "target_name"
targetName <- obj .: "target_name"
targetModule <- obj .: "target_module"
value <- obj .: "data"
return $ CommOpen noHeader name uuid value
return $ CommOpen noHeader targetName targetModule uuid value
commDataParser :: LByteString -> Message
commDataParser = requestParser $ \obj -> do

6
ipython-kernel/src/IHaskell/IPython/Message/Writer.hs
View File

@ -97,7 +97,11 @@ instance ToJSON Message where
object ["prompt" .= prompt]
toJSON req@CommOpen{} =
object ["comm_id" .= commUuid req, "target_name" .= commTargetName req, "data" .= commData req]
object [ "comm_id" .= commUuid req
, "target_name" .= commTargetName req
, "target_module" .= commTargetModule req
, "data" .= commData req
]
toJSON req@CommData{} =
object ["comm_id" .= commUuid req, "data" .= commData req]

1
ipython-kernel/src/IHaskell/IPython/Types.hs
View File

@ -375,6 +375,7 @@ data Message =
CommOpen
{ header :: MessageHeader
, commTargetName :: String
, commTargetModule :: String
, commUuid :: UUID
, commData :: Value
}

20
src/IHaskell/Eval/Widgets.hs
View File

@ -52,9 +52,8 @@ widgetSend :: IHaskellWidget a
widgetSend msgType widget value = queue $ msgType (Widget widget) value
-- | Send a message to open a comm
widgetSendOpen :: IHaskellWidget a => a -> Value -> Value -> IO ()
widgetSendOpen widget initVal stateVal =
queue $ Open (Widget widget) initVal stateVal
widgetSendOpen :: IHaskellWidget a => a -> Value -> IO ()
widgetSendOpen = widgetSend Open
-- | Send a state update message
widgetSendUpdate :: IHaskellWidget a => a -> Value -> IO ()
@ -93,8 +92,9 @@ handleMessage :: (Message -> IO ())
-> IO KernelState
handleMessage send replyHeader state msg = do
case msg of
Open widget initVal stateVal -> do
let target = targetName widget
Open widget value -> do
let target_name = targetName widget
target_module = targetModule widget
uuid = getCommUUID widget
present = isJust $ Map.lookup uuid oldComms
@ -109,12 +109,9 @@ handleMessage send replyHeader state msg = do
if present
then return state
else do
-- Send the comm open
-- Send the comm open, with the initial state
header <- dupHeader replyHeader CommOpenMessage
send $ CommOpen header target uuid initVal
-- Initial state update
communicate . toJSON $ UpdateState stateVal
send $ CommOpen header target_name target_module uuid value
-- Send anything else the widget requires.
open widget communicate
@ -123,8 +120,7 @@ handleMessage send replyHeader state msg = do
return newState
Close widget value -> do
let target = targetName widget
uuid = getCommUUID widget
let uuid = getCommUUID widget
present = isJust $ Map.lookup uuid oldComms
newComms = Map.delete uuid $ openComms state

12
src/IHaskell/Types.hs
View File

@ -65,11 +65,15 @@ class IHaskellDisplay a where
-- | Display as an interactive widget.
class IHaskellDisplay a => IHaskellWidget a where
-- | Output target name for this widget. The actual input parameter should be ignored. By default
-- | Target name for this widget. The actual input parameter should be ignored. By default
-- evaluate to "ipython.widget", which is used by IPython for its backbone widgets.
targetName :: a -> String
targetName _ = "ipython.widget"
-- | Target module for this widget. Evaluates to an empty string by default.
targetModule :: a -> String
targetModule _ = ""
-- | Get the uuid for comm associated with this widget. The widget is responsible for storing the
-- UUID during initialization.
getCommUUID :: a -> UUID
@ -102,6 +106,7 @@ instance IHaskellDisplay Widget where
instance IHaskellWidget Widget where
targetName (Widget widget) = targetName widget
targetModule (Widget widget) = targetModule widget
getCommUUID (Widget widget) = getCommUUID widget
open (Widget widget) = open widget
comm (Widget widget) = comm widget
@ -185,11 +190,10 @@ data LintStatus = LintOn
deriving (Eq, Show)
-- | Send JSON objects with specific formats
data WidgetMsg = Open Widget Value Value
data WidgetMsg = Open Widget Value
|
-- ^ Cause the interpreter to open a new comm, and register the associated widget in
-- the kernelState. Also sends a Value with comm_open, and then sends an initial
-- state update Value.
-- the kernelState. Also sends an initial state Value with comm_open.
Update Widget Value
|
-- ^ Cause the interpreter to send a comm_msg containing a state update for the