diff --git a/ihaskell-widgets.cabal b/ihaskell-widgets.cabal --- a/ihaskell-widgets.cabal +++ b/ihaskell-widgets.cabal @@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change -version: 0.2.3.1 +version: 0.2.3.2 -- A short (one-line) description of the package. synopsis: IPython standard widgets for IHaskell. @@ -57,9 +57,6 @@ -- Modules included in this library but not exported. other-modules: IHaskell.Display.Widgets.Button IHaskell.Display.Widgets.Box.Box - IHaskell.Display.Widgets.Box.Proxy - IHaskell.Display.Widgets.Box.PlaceProxy - IHaskell.Display.Widgets.Box.FlexBox IHaskell.Display.Widgets.Box.SelectionContainer.Accordion IHaskell.Display.Widgets.Box.SelectionContainer.Tab IHaskell.Display.Widgets.Bool.CheckBox @@ -83,7 +80,7 @@ IHaskell.Display.Widgets.Selection.ToggleButtons IHaskell.Display.Widgets.Selection.SelectMultiple IHaskell.Display.Widgets.String.HTML - IHaskell.Display.Widgets.String.Latex + IHaskell.Display.Widgets.String.Label IHaskell.Display.Widgets.String.Text IHaskell.Display.Widgets.String.TextArea @@ -96,8 +93,8 @@ -- Other library packages from which modules are imported. -- singletons 2.* require ghc 7.10.2 - build-depends: aeson >=0.7 && < 0.12 - , base >=4.7 && <4.9 + build-depends: aeson >=0.7 + , base >=4.7 && <5 , containers >= 0.5 , ipython-kernel >= 0.6.1.2 , text >= 0.11 diff --git a/src/IHaskell/Display/Widgets.hs b/src/IHaskell/Display/Widgets.hs --- a/src/IHaskell/Display/Widgets.hs +++ b/src/IHaskell/Display/Widgets.hs @@ -3,9 +3,6 @@ import IHaskell.Display.Widgets.Button as X import IHaskell.Display.Widgets.Box.Box as X -import IHaskell.Display.Widgets.Box.Proxy as X -import IHaskell.Display.Widgets.Box.PlaceProxy as X -import IHaskell.Display.Widgets.Box.FlexBox as X import IHaskell.Display.Widgets.Box.SelectionContainer.Accordion as X import IHaskell.Display.Widgets.Box.SelectionContainer.Tab as X @@ -36,7 +33,7 @@ import IHaskell.Display.Widgets.Selection.SelectMultiple as X import IHaskell.Display.Widgets.String.HTML as X -import IHaskell.Display.Widgets.String.Latex as X +import IHaskell.Display.Widgets.String.Label as X import IHaskell.Display.Widgets.String.Text as X import IHaskell.Display.Widgets.String.TextArea as X diff --git a/src/IHaskell/Display/Widgets/Bool/CheckBox.hs b/src/IHaskell/Display/Widgets/Bool/CheckBox.hs --- a/src/IHaskell/Display/Widgets/Bool/CheckBox.hs +++ b/src/IHaskell/Display/Widgets/Bool/CheckBox.hs @@ -33,7 +33,7 @@ -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultBoolWidget "CheckboxView" + let widgetState = WidgetState $ defaultBoolWidget "CheckboxView" "CheckboxModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Bool/ToggleButton.hs b/src/IHaskell/Display/Widgets/Bool/ToggleButton.hs --- a/src/IHaskell/Display/Widgets/Bool/ToggleButton.hs +++ b/src/IHaskell/Display/Widgets/Bool/ToggleButton.hs @@ -34,7 +34,7 @@ -- Default properties, with a random uuid uuid <- U.random - let boolState = defaultBoolWidget "ToggleButtonView" + let boolState = defaultBoolWidget "ToggleButtonView" "ToggleButtonModel" toggleState = (Tooltip =:: "") :& (Icon =:: "") :& (ButtonStyle =:: DefaultButton) diff --git a/src/IHaskell/Display/Widgets/Bool/Valid.hs b/src/IHaskell/Display/Widgets/Bool/Valid.hs --- a/src/IHaskell/Display/Widgets/Bool/Valid.hs +++ b/src/IHaskell/Display/Widgets/Bool/Valid.hs @@ -32,7 +32,7 @@ -- Default properties, with a random uuid uuid <- U.random - let boolState = defaultBoolWidget "ValidView" + let boolState = defaultBoolWidget "ValidView" "ValidModel" validState = (ReadOutMsg =:: "") :& RNil widgetState = WidgetState $ boolState <+> validState diff --git a/src/IHaskell/Display/Widgets/Box/Box.hs b/src/IHaskell/Display/Widgets/Box/Box.hs --- a/src/IHaskell/Display/Widgets/Box/Box.hs +++ b/src/IHaskell/Display/Widgets/Box/Box.hs @@ -30,7 +30,7 @@ -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultBoxWidget "BoxView" + let widgetState = WidgetState $ defaultBoxWidget "BoxView" "BoxModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Box/FlexBox.hs b/src/IHaskell/Display/Widgets/Box/FlexBox.hs deleted file mode 100644 --- a/src/IHaskell/Display/Widgets/Box/FlexBox.hs +++ /dev/null @@ -1,59 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module IHaskell.Display.Widgets.Box.FlexBox ( --- * The FlexBox widget -FlexBox, - -- * Constructor - mkFlexBox) where - --- To keep `cabal repl` happy when running from the ihaskell repo -import Prelude - -import Data.Aeson -import Data.IORef (newIORef) -import Data.Vinyl (Rec(..), (<+>)) - -import IHaskell.Display -import IHaskell.Eval.Widgets -import IHaskell.IPython.Message.UUID as U - -import IHaskell.Display.Widgets.Types -import IHaskell.Display.Widgets.Common - --- | A 'FlexBox' represents a FlexBox widget from IPython.html.widgets. -type FlexBox = IPythonWidget FlexBoxType - --- | Create a new box -mkFlexBox :: IO FlexBox -mkFlexBox = do - -- Default properties, with a random uuid - uuid <- U.random - - let boxAttrs = defaultBoxWidget "FlexBoxView" - flxAttrs = (Orientation =:: HorizontalOrientation) - :& (Flex =:: 0) - :& (Pack =:: StartLocation) - :& (Align =:: StartLocation) - :& RNil - widgetState = WidgetState $ boxAttrs <+> flxAttrs - - stateIO <- newIORef widgetState - - let box = IPythonWidget uuid stateIO - - -- Open a comm for this widget, and store it in the kernel state - widgetSendOpen box $ toJSON widgetState - - -- Return the widget - return box - -instance IHaskellDisplay FlexBox where - display b = do - widgetSendView b - return $ Display [] - -instance IHaskellWidget FlexBox where - getCommUUID = uuid diff --git a/src/IHaskell/Display/Widgets/Box/PlaceProxy.hs b/src/IHaskell/Display/Widgets/Box/PlaceProxy.hs deleted file mode 100644 --- a/src/IHaskell/Display/Widgets/Box/PlaceProxy.hs +++ /dev/null @@ -1,57 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module IHaskell.Display.Widgets.Box.PlaceProxy ( --- * The PlaceProxy widget -PlaceProxy, - -- * Constructor - mkPlaceProxy) where - --- To keep `cabal repl` happy when running from the ihaskell repo -import Prelude - -import Data.Aeson -import Data.IORef (newIORef) -import Data.Vinyl (Rec(..), (<+>)) -import Data.Vinyl.Lens (rput) - -import IHaskell.Display -import IHaskell.Eval.Widgets -import IHaskell.IPython.Message.UUID as U - -import IHaskell.Display.Widgets.Types -import IHaskell.Display.Widgets.Common - --- | A 'Box' represents a Box widget from IPython.html.widgets. -type PlaceProxy = IPythonWidget PlaceProxyType - --- | Create a new box -mkPlaceProxy :: IO PlaceProxy -mkPlaceProxy = do - -- Default properties, with a random uuid - uuid <- U.random - - let widgetClassState = defaultWidget "PlaceProxyView" - baseState = rput (ModelName =:: "ProxyModel") widgetClassState - proxyState = (Child =:: Nothing) :& (Selector =:: "") :& RNil - widgetState = WidgetState $ baseState <+> proxyState - - stateIO <- newIORef widgetState - - let widget = IPythonWidget uuid stateIO - - -- Open a comm for this widget, and store it in the kernel state - widgetSendOpen widget $ toJSON widgetState - - -- Return the widget - return widget - -instance IHaskellDisplay PlaceProxy where - display b = do - widgetSendView b - return $ Display [] - -instance IHaskellWidget PlaceProxy where - getCommUUID = uuid diff --git a/src/IHaskell/Display/Widgets/Box/Proxy.hs b/src/IHaskell/Display/Widgets/Box/Proxy.hs deleted file mode 100644 --- a/src/IHaskell/Display/Widgets/Box/Proxy.hs +++ /dev/null @@ -1,57 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module IHaskell.Display.Widgets.Box.Proxy ( --- * The Proxy widget -ProxyWidget, - -- * Constructor - mkProxyWidget) where - --- To keep `cabal repl` happy when running from the ihaskell repo -import Prelude - -import Data.Aeson -import Data.IORef (newIORef) -import Data.Vinyl (Rec(..), (<+>)) -import Data.Vinyl.Lens (rput) - -import IHaskell.Display -import IHaskell.Eval.Widgets -import IHaskell.IPython.Message.UUID as U - -import IHaskell.Display.Widgets.Types -import IHaskell.Display.Widgets.Common - --- | A 'Box' represents a Box widget from IPython.html.widgets. -type ProxyWidget = IPythonWidget ProxyType - --- | Create a new box -mkProxyWidget :: IO ProxyWidget -mkProxyWidget = do - -- Default properties, with a random uuid - uuid <- U.random - - let widgetClassState = defaultWidget "ProxyView" - baseState = rput (ModelName =:: "ProxyModel") widgetClassState - proxyState = (Child =:: Nothing) :& RNil - widgetState = WidgetState $ baseState <+> proxyState - - stateIO <- newIORef widgetState - - let proxy = IPythonWidget uuid stateIO - - -- Open a comm for this widget, and store it in the kernel state - widgetSendOpen proxy $ toJSON widgetState - - -- Return the widget - return proxy - -instance IHaskellDisplay ProxyWidget where - display b = do - widgetSendView b - return $ Display [] - -instance IHaskellWidget ProxyWidget where - getCommUUID = uuid diff --git a/src/IHaskell/Display/Widgets/Box/SelectionContainer/Accordion.hs b/src/IHaskell/Display/Widgets/Box/SelectionContainer/Accordion.hs --- a/src/IHaskell/Display/Widgets/Box/SelectionContainer/Accordion.hs +++ b/src/IHaskell/Display/Widgets/Box/SelectionContainer/Accordion.hs @@ -34,7 +34,7 @@ -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultSelectionContainerWidget "AccordionView" + let widgetState = WidgetState $ defaultSelectionContainerWidget "AccordionView" "AccordionModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Box/SelectionContainer/Tab.hs b/src/IHaskell/Display/Widgets/Box/SelectionContainer/Tab.hs --- a/src/IHaskell/Display/Widgets/Box/SelectionContainer/Tab.hs +++ b/src/IHaskell/Display/Widgets/Box/SelectionContainer/Tab.hs @@ -34,7 +34,7 @@ -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultSelectionContainerWidget "TabView" + let widgetState = WidgetState $ defaultSelectionContainerWidget "TabView" "TabModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Button.hs b/src/IHaskell/Display/Widgets/Button.hs --- a/src/IHaskell/Display/Widgets/Button.hs +++ b/src/IHaskell/Display/Widgets/Button.hs @@ -35,7 +35,7 @@ -- Default properties, with a random uuid uuid <- U.random - let dom = defaultDOMWidget "ButtonView" + let dom = defaultDOMWidget "ButtonView" "ButtonModel" but = (Description =:: "") :& (Tooltip =:: "") :& (Disabled =:: False) diff --git a/src/IHaskell/Display/Widgets/Float/BoundedFloat/BoundedFloatText.hs b/src/IHaskell/Display/Widgets/Float/BoundedFloat/BoundedFloatText.hs --- a/src/IHaskell/Display/Widgets/Float/BoundedFloat/BoundedFloatText.hs +++ b/src/IHaskell/Display/Widgets/Float/BoundedFloat/BoundedFloatText.hs @@ -35,7 +35,7 @@ -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultBoundedFloatWidget "FloatTextView" + let widgetState = WidgetState $ defaultBoundedFloatWidget "FloatTextView" "FloatTextModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatProgress.hs b/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatProgress.hs --- a/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatProgress.hs +++ b/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatProgress.hs @@ -32,7 +32,7 @@ -- Default properties, with a random uuid uuid <- U.random - let boundedFloatAttrs = defaultBoundedFloatWidget "ProgressView" + let boundedFloatAttrs = defaultBoundedFloatWidget "ProgressView" "ProgressModel" progressAttrs = (Orientation =:: HorizontalOrientation) :& (BarStyle =:: DefaultBar) :& RNil diff --git a/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatSlider.hs b/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatSlider.hs --- a/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatSlider.hs +++ b/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatSlider.hs @@ -35,7 +35,7 @@ -- Default properties, with a random uuid uuid <- U.random - let boundedFloatAttrs = defaultBoundedFloatWidget "FloatSliderView" + let boundedFloatAttrs = defaultBoundedFloatWidget "FloatSliderView" "FloatSliderModel" sliderAttrs = (Orientation =:: HorizontalOrientation) :& (ShowRange =:: False) :& (ReadOut =:: True) diff --git a/src/IHaskell/Display/Widgets/Float/BoundedFloatRange/FloatRangeSlider.hs b/src/IHaskell/Display/Widgets/Float/BoundedFloatRange/FloatRangeSlider.hs --- a/src/IHaskell/Display/Widgets/Float/BoundedFloatRange/FloatRangeSlider.hs +++ b/src/IHaskell/Display/Widgets/Float/BoundedFloatRange/FloatRangeSlider.hs @@ -37,7 +37,7 @@ -- Default properties, with a random uuid uuid <- U.random - let boundedFloatAttrs = defaultBoundedFloatRangeWidget "FloatSliderView" + let boundedFloatAttrs = defaultBoundedFloatRangeWidget "FloatSliderView" "FloatSliderModel" sliderAttrs = (Orientation =:: HorizontalOrientation) :& (ShowRange =:: True) :& (ReadOut =:: True) diff --git a/src/IHaskell/Display/Widgets/Float/FloatText.hs b/src/IHaskell/Display/Widgets/Float/FloatText.hs --- a/src/IHaskell/Display/Widgets/Float/FloatText.hs +++ b/src/IHaskell/Display/Widgets/Float/FloatText.hs @@ -34,7 +34,7 @@ -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultFloatWidget "FloatTextView" + let widgetState = WidgetState $ defaultFloatWidget "FloatTextView" "FloatTextModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Image.hs b/src/IHaskell/Display/Widgets/Image.hs --- a/src/IHaskell/Display/Widgets/Image.hs +++ b/src/IHaskell/Display/Widgets/Image.hs @@ -33,7 +33,7 @@ -- Default properties, with a random uuid uuid <- U.random - let dom = defaultDOMWidget "ImageView" + let dom = defaultDOMWidget "ImageView" "ImageModel" img = (ImageFormat =:: PNG) :& (Width =:+ 0) :& (Height =:+ 0) diff --git a/src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs b/src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs --- a/src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs +++ b/src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs @@ -34,7 +34,7 @@ -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultBoundedIntWidget "IntTextView" + let widgetState = WidgetState $ defaultBoundedIntWidget "IntTextView" "IntTextModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs b/src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs --- a/src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs +++ b/src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs @@ -32,7 +32,7 @@ -- Default properties, with a random uuid uuid <- U.random - let boundedIntAttrs = defaultBoundedIntWidget "ProgressView" + let boundedIntAttrs = defaultBoundedIntWidget "ProgressView" "ProgressModel" progressAttrs = (Orientation =:: HorizontalOrientation) :& (BarStyle =:: DefaultBar) :& RNil diff --git a/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs b/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs --- a/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs +++ b/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs @@ -35,7 +35,7 @@ -- Default properties, with a random uuid uuid <- U.random - let boundedIntAttrs = defaultBoundedIntWidget "IntSliderView" + let boundedIntAttrs = defaultBoundedIntWidget "IntSliderView" "IntSliderModel" sliderAttrs = (Orientation =:: HorizontalOrientation) :& (ShowRange =:: False) :& (ReadOut =:: True) diff --git a/src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs b/src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs --- a/src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs +++ b/src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs @@ -36,7 +36,7 @@ -- Default properties, with a random uuid uuid <- U.random - let boundedIntAttrs = defaultBoundedIntRangeWidget "IntSliderView" + let boundedIntAttrs = defaultBoundedIntRangeWidget "IntSliderView" "IntSliderModel" sliderAttrs = (Orientation =:: HorizontalOrientation) :& (ShowRange =:: True) :& (ReadOut =:: True) diff --git a/src/IHaskell/Display/Widgets/Int/IntText.hs b/src/IHaskell/Display/Widgets/Int/IntText.hs --- a/src/IHaskell/Display/Widgets/Int/IntText.hs +++ b/src/IHaskell/Display/Widgets/Int/IntText.hs @@ -34,7 +34,7 @@ -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultIntWidget "IntTextView" + let widgetState = WidgetState $ defaultIntWidget "IntTextView" "IntTextModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Interactive.hs b/src/IHaskell/Display/Widgets/Interactive.hs --- a/src/IHaskell/Display/Widgets/Interactive.hs +++ b/src/IHaskell/Display/Widgets/Interactive.hs @@ -5,6 +5,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE UndecidableSuperClasses #-} {-# LANGUAGE PolyKinds #-} module IHaskell.Display.Widgets.Interactive (interactive, uncurryHList, Rec(..), Argument(..)) where @@ -24,7 +25,7 @@ import IHaskell.Display.Widgets.Common import qualified IHaskell.Display.Widgets.Singletons as S (SField, Field(..)) -import IHaskell.Display.Widgets.Box.FlexBox +import IHaskell.Display.Widgets.Box.Box import IHaskell.Display.Widgets.Bool.CheckBox import IHaskell.Display.Widgets.String.Text import IHaskell.Display.Widgets.Int.BoundedInt.IntSlider @@ -119,23 +120,23 @@ mkConfs _ = WidgetConf wrapped :& mkConfs (Proxy :: Proxy ts) interactive :: (IHaskellDisplay r, MakeConfs ts) - => (HList ts -> r) -> Rec Argument ts -> IO FlexBox + => (HList ts -> r) -> Rec Argument ts -> IO Box interactive func = let confs = mkConfs Proxy in liftToWidgets func confs -- | Transform a function (HList ts -> r) to one which: 1) Uses widgets to accept the arguments 2) --- Accepts initial values for the arguments 3) Creates a compound FlexBox widget with an embedded +-- Accepts initial values for the arguments 3) Creates a compound Box widget with an embedded -- OutputWidget for display liftToWidgets :: IHaskellDisplay r - => (HList ts -> r) -> Rec WidgetConf ts -> Rec Argument ts -> IO FlexBox + => (HList ts -> r) -> Rec WidgetConf ts -> Rec Argument ts -> IO Box liftToWidgets func rc initvals = do let constructors = rmap extractConstructor rc getters = rmap extractGetter rc eventSetters = rmap extractEventSetter rc initializers = rmap extractInitializer rc - bx <- mkFlexBox + bx <- mkBox out <- mkOutputWidget -- Create a list of widgets @@ -152,9 +153,11 @@ setInitialValues initializers widgets initvals -- applyValueSetters valueSetters widgets $ getList defvals setField out Width 500 - setField bx Orientation VerticalOrientation + -- TODO This can't be set right now since we switched FlexBox to a regular + -- Box. This is a styling/layout parameter now but these haven't been implemented yet. + -- setField bx Orientation VerticalOrientation - -- Set children for the FlexBox + -- Set children for the Box let children = mkChildren widgets setField bx Children $ children ++ [ChildWidget out] diff --git a/src/IHaskell/Display/Widgets/Output.hs b/src/IHaskell/Display/Widgets/Output.hs --- a/src/IHaskell/Display/Widgets/Output.hs +++ b/src/IHaskell/Display/Widgets/Output.hs @@ -36,7 +36,7 @@ -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultDOMWidget "OutputView" + let widgetState = WidgetState $ defaultDOMWidget "OutputView" "OutputModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Selection/Dropdown.hs b/src/IHaskell/Display/Widgets/Selection/Dropdown.hs --- a/src/IHaskell/Display/Widgets/Selection/Dropdown.hs +++ b/src/IHaskell/Display/Widgets/Selection/Dropdown.hs @@ -34,7 +34,7 @@ mkDropdown = do -- Default properties, with a random uuid uuid <- U.random - let selectionAttrs = defaultSelectionWidget "DropdownView" + let selectionAttrs = defaultSelectionWidget "DropdownView" "DropdownModel" dropdownAttrs = (ButtonStyle =:: DefaultButton) :& RNil widgetState = WidgetState $ selectionAttrs <+> dropdownAttrs diff --git a/src/IHaskell/Display/Widgets/Selection/RadioButtons.hs b/src/IHaskell/Display/Widgets/Selection/RadioButtons.hs --- a/src/IHaskell/Display/Widgets/Selection/RadioButtons.hs +++ b/src/IHaskell/Display/Widgets/Selection/RadioButtons.hs @@ -33,7 +33,7 @@ mkRadioButtons = do -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultSelectionWidget "RadioButtonsView" + let widgetState = WidgetState $ defaultSelectionWidget "RadioButtonsView" "RadioButtonsModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Selection/Select.hs b/src/IHaskell/Display/Widgets/Selection/Select.hs --- a/src/IHaskell/Display/Widgets/Selection/Select.hs +++ b/src/IHaskell/Display/Widgets/Selection/Select.hs @@ -34,7 +34,7 @@ mkSelect = do -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultSelectionWidget "SelectView" + let widgetState = WidgetState $ defaultSelectionWidget "SelectView" "SelectModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Selection/SelectMultiple.hs b/src/IHaskell/Display/Widgets/Selection/SelectMultiple.hs --- a/src/IHaskell/Display/Widgets/Selection/SelectMultiple.hs +++ b/src/IHaskell/Display/Widgets/Selection/SelectMultiple.hs @@ -34,7 +34,7 @@ mkSelectMultiple = do -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultMultipleSelectionWidget "SelectMultipleView" + let widgetState = WidgetState $ defaultMultipleSelectionWidget "SelectMultipleView" "SelectMultipleModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/Selection/ToggleButtons.hs b/src/IHaskell/Display/Widgets/Selection/ToggleButtons.hs --- a/src/IHaskell/Display/Widgets/Selection/ToggleButtons.hs +++ b/src/IHaskell/Display/Widgets/Selection/ToggleButtons.hs @@ -34,7 +34,7 @@ mkToggleButtons = do -- Default properties, with a random uuid uuid <- U.random - let selectionAttrs = defaultSelectionWidget "ToggleButtonsView" + let selectionAttrs = defaultSelectionWidget "ToggleButtonsView" "ToggleButtonsModel" toggleButtonsAttrs = (Tooltips =:: []) :& (Icons =:: []) :& (ButtonStyle =:: DefaultButton) diff --git a/src/IHaskell/Display/Widgets/String/HTML.hs b/src/IHaskell/Display/Widgets/String/HTML.hs --- a/src/IHaskell/Display/Widgets/String/HTML.hs +++ b/src/IHaskell/Display/Widgets/String/HTML.hs @@ -29,7 +29,7 @@ mkHTMLWidget = do -- Default properties, with a random uuid uuid <- U.random - let widgetState = WidgetState $ defaultStringWidget "HTMLView" + let widgetState = WidgetState $ defaultStringWidget "HTMLView" "HTMLModel" stateIO <- newIORef widgetState diff --git a/src/IHaskell/Display/Widgets/String/Label.hs b/src/IHaskell/Display/Widgets/String/Label.hs new file mode 100644 --- /dev/null +++ b/src/IHaskell/Display/Widgets/String/Label.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeSynonymInstances #-} + +module IHaskell.Display.Widgets.String.Label ( +-- * The Label Widget +LabelWidget, + -- * Constructor + mkLabelWidget) where + +-- To keep `cabal repl` happy when running from the ihaskell repo +import Prelude + +import Data.Aeson +import Data.IORef (newIORef) + +import IHaskell.Display +import IHaskell.Eval.Widgets +import IHaskell.IPython.Message.UUID as U + +import IHaskell.Display.Widgets.Types + +-- | A 'LabelWidget' represents a Label widget from IPython.html.widgets. +type LabelWidget = IPythonWidget LabelType + +-- | Create a new Label widget +mkLabelWidget :: IO LabelWidget +mkLabelWidget = do + -- Default properties, with a random uuid + uuid <- U.random + let widgetState = WidgetState $ defaultStringWidget "LabelView" "LabelModel" + + stateIO <- newIORef widgetState + + let widget = IPythonWidget uuid stateIO + + -- Open a comm for this widget, and store it in the kernel state + widgetSendOpen widget $ toJSON widgetState + + -- Return the widget + return widget + +instance IHaskellDisplay LabelWidget where + display b = do + widgetSendView b + return $ Display [] + +instance IHaskellWidget LabelWidget where + getCommUUID = uuid diff --git a/src/IHaskell/Display/Widgets/String/Latex.hs b/src/IHaskell/Display/Widgets/String/Latex.hs deleted file mode 100644 --- a/src/IHaskell/Display/Widgets/String/Latex.hs +++ /dev/null @@ -1,50 +0,0 @@ -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE DataKinds #-} -{-# LANGUAGE TypeSynonymInstances #-} - -module IHaskell.Display.Widgets.String.Latex ( --- * The Latex Widget -LatexWidget, - -- * Constructor - mkLatexWidget) where - --- To keep `cabal repl` happy when running from the ihaskell repo -import Prelude - -import Data.Aeson -import Data.IORef (newIORef) - -import IHaskell.Display -import IHaskell.Eval.Widgets -import IHaskell.IPython.Message.UUID as U - -import IHaskell.Display.Widgets.Types - --- | A 'LatexWidget' represents a Latex widget from IPython.html.widgets. -type LatexWidget = IPythonWidget LatexType - --- | Create a new Latex widget -mkLatexWidget :: IO LatexWidget -mkLatexWidget = do - -- Default properties, with a random uuid - uuid <- U.random - let widgetState = WidgetState $ defaultStringWidget "LatexView" - - stateIO <- newIORef widgetState - - let widget = IPythonWidget uuid stateIO - - -- Open a comm for this widget, and store it in the kernel state - widgetSendOpen widget $ toJSON widgetState - - -- Return the widget - return widget - -instance IHaskellDisplay LatexWidget where - display b = do - widgetSendView b - return $ Display [] - -instance IHaskellWidget LatexWidget where - getCommUUID = uuid diff --git a/src/IHaskell/Display/Widgets/String/Text.hs b/src/IHaskell/Display/Widgets/String/Text.hs --- a/src/IHaskell/Display/Widgets/String/Text.hs +++ b/src/IHaskell/Display/Widgets/String/Text.hs @@ -33,7 +33,7 @@ mkTextWidget = do -- Default properties, with a random uuid uuid <- U.random - let strWidget = defaultStringWidget "TextView" + let strWidget = defaultStringWidget "TextView" "TextModel" txtWidget = (SubmitHandler =:: return ()) :& (ChangeHandler =:: return ()) :& RNil widgetState = WidgetState $ strWidget <+> txtWidget diff --git a/src/IHaskell/Display/Widgets/String/TextArea.hs b/src/IHaskell/Display/Widgets/String/TextArea.hs --- a/src/IHaskell/Display/Widgets/String/TextArea.hs +++ b/src/IHaskell/Display/Widgets/String/TextArea.hs @@ -33,7 +33,7 @@ mkTextArea = do -- Default properties, with a random uuid uuid <- U.random - let strAttrs = defaultStringWidget "TextareaView" + let strAttrs = defaultStringWidget "TextareaView" "TextareaModel" wgtAttrs = (ChangeHandler =:: return ()) :& RNil widgetState = WidgetState $ strAttrs <+> wgtAttrs diff --git a/src/IHaskell/Display/Widgets/Types.hs b/src/IHaskell/Display/Widgets/Types.hs --- a/src/IHaskell/Display/Widgets/Types.hs +++ b/src/IHaskell/Display/Widgets/Types.hs @@ -15,8 +15,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE AutoDeriveTypeable #-} -module IHaskell.Display.Widgets.Types where - -- | This module houses all the type-trickery needed to make widgets happen. -- -- All widgets have a corresponding 'WidgetType', and some fields/attributes/properties as defined @@ -61,6 +59,8 @@ -- -- Widgets are not able to do console input, the reason for that can be found in the messaging -- specification. +module IHaskell.Display.Widgets.Types where + import Control.Monad (unless, join, when, void) import Control.Applicative ((<$>)) import qualified Control.Exception as Ex @@ -241,7 +241,7 @@ | ImageType | OutputType | HTMLType - | LatexType + | LabelType | TextType | TextAreaType | CheckBoxType @@ -263,9 +263,6 @@ | FloatProgressType | FloatRangeSliderType | BoxType - | ProxyType - | PlaceProxyType - | FlexBoxType | AccordionType | TabType @@ -280,7 +277,7 @@ DOMWidgetClass :++ '[S.ImageFormat, S.Width, S.Height, S.B64Value] WidgetFields OutputType = DOMWidgetClass WidgetFields HTMLType = StringClass - WidgetFields LatexType = StringClass + WidgetFields LabelType = StringClass WidgetFields TextType = StringClass :++ '[S.SubmitHandler, S.ChangeHandler] WidgetFields TextAreaType = StringClass :++ '[S.ChangeHandler] @@ -315,11 +312,6 @@ BoundedFloatRangeClass :++ '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor] WidgetFields BoxType = BoxClass - WidgetFields ProxyType = WidgetClass :++ '[S.Child] - WidgetFields PlaceProxyType = - WidgetFields ProxyType :++ '[S.Selector] - WidgetFields FlexBoxType = - BoxClass :++ '[S.Orientation, S.Flex, S.Pack, S.Align] WidgetFields AccordionType = SelectionContainerClass WidgetFields TabType = SelectionContainerClass @@ -619,23 +611,23 @@ (reflect s) -- | Get a field from a singleton Adapted from: http://stackoverflow.com/a/28033250/2388535 -reflect :: forall (f :: Field). (SingI f, SingKind ('KProxy :: KProxy Field)) => Sing f -> Field +reflect :: forall (f :: Field). (SingI f) => Sing f -> Field reflect = fromSing -- | A record representing an object of the Widget class from IPython -defaultWidget :: FieldType S.ViewName -> Rec Attr WidgetClass -defaultWidget viewName = (ViewModule =:: "") - :& (ViewName =:: viewName) - :& (ModelModule =:: "") - :& (ModelName =:: "WidgetModel") - :& (MsgThrottle =:+ 3) - :& (Version =:: 0) - :& (DisplayHandler =:: return ()) - :& RNil +defaultWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr WidgetClass +defaultWidget viewName modelName = (ViewModule =:: "jupyter-js-widgets") + :& (ViewName =:: viewName) + :& (ModelModule =:: "jupyter-js-widgets") + :& (ModelName =:: modelName) + :& (MsgThrottle =:+ 3) + :& (Version =:: 0) + :& (DisplayHandler =:: return ()) + :& RNil -- | A record representing an object of the DOMWidget class from IPython -defaultDOMWidget :: FieldType S.ViewName -> Rec Attr DOMWidgetClass -defaultDOMWidget viewName = defaultWidget viewName <+> domAttrs +defaultDOMWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr DOMWidgetClass +defaultDOMWidget viewName modelName = defaultWidget viewName modelName <+> domAttrs where domAttrs = (Visible =:: True) :& (CSS =:: []) @@ -657,8 +649,8 @@ :& RNil -- | A record representing a widget of the _String class from IPython -defaultStringWidget :: FieldType S.ViewName -> Rec Attr StringClass -defaultStringWidget viewName = defaultDOMWidget viewName <+> strAttrs +defaultStringWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr StringClass +defaultStringWidget viewName modelName = defaultDOMWidget viewName modelName <+> strAttrs where strAttrs = (StringValue =:: "") :& (Disabled =:: False) @@ -667,8 +659,8 @@ :& RNil -- | A record representing a widget of the _Bool class from IPython -defaultBoolWidget :: FieldType S.ViewName -> Rec Attr BoolClass -defaultBoolWidget viewName = defaultDOMWidget viewName <+> boolAttrs +defaultBoolWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoolClass +defaultBoolWidget viewName modelName = defaultDOMWidget viewName modelName <+> boolAttrs where boolAttrs = (BoolValue =:: False) :& (Disabled =:: False) @@ -677,8 +669,8 @@ :& RNil -- | A record representing a widget of the _Selection class from IPython -defaultSelectionWidget :: FieldType S.ViewName -> Rec Attr SelectionClass -defaultSelectionWidget viewName = defaultDOMWidget viewName <+> selectionAttrs +defaultSelectionWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr SelectionClass +defaultSelectionWidget viewName modelName = defaultDOMWidget viewName modelName <+> selectionAttrs where selectionAttrs = (Options =:: OptionLabels []) :& (SelectedValue =:: "") @@ -689,8 +681,8 @@ :& RNil -- | A record representing a widget of the _MultipleSelection class from IPython -defaultMultipleSelectionWidget :: FieldType S.ViewName -> Rec Attr MultipleSelectionClass -defaultMultipleSelectionWidget viewName = defaultDOMWidget viewName <+> mulSelAttrs +defaultMultipleSelectionWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr MultipleSelectionClass +defaultMultipleSelectionWidget viewName modelName = defaultDOMWidget viewName modelName <+> mulSelAttrs where mulSelAttrs = (Options =:: OptionLabels []) :& (SelectedValues =:: []) @@ -701,8 +693,8 @@ :& RNil -- | A record representing a widget of the _Int class from IPython -defaultIntWidget :: FieldType S.ViewName -> Rec Attr IntClass -defaultIntWidget viewName = defaultDOMWidget viewName <+> intAttrs +defaultIntWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr IntClass +defaultIntWidget viewName modelName = defaultDOMWidget viewName modelName <+> intAttrs where intAttrs = (IntValue =:: 0) :& (Disabled =:: False) @@ -711,8 +703,8 @@ :& RNil -- | A record representing a widget of the _BoundedInt class from IPython -defaultBoundedIntWidget :: FieldType S.ViewName -> Rec Attr BoundedIntClass -defaultBoundedIntWidget viewName = defaultIntWidget viewName <+> boundedIntAttrs +defaultBoundedIntWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoundedIntClass +defaultBoundedIntWidget viewName modelName = defaultIntWidget viewName modelName <+> boundedIntAttrs where boundedIntAttrs = (StepInt =:: 1) :& (MinInt =:: 0) @@ -720,8 +712,8 @@ :& RNil -- | A record representing a widget of the _BoundedInt class from IPython -defaultIntRangeWidget :: FieldType S.ViewName -> Rec Attr IntRangeClass -defaultIntRangeWidget viewName = defaultIntWidget viewName <+> rangeAttrs +defaultIntRangeWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr IntRangeClass +defaultIntRangeWidget viewName modelName = defaultIntWidget viewName modelName <+> rangeAttrs where rangeAttrs = (IntPairValue =:: (25, 75)) :& (LowerInt =:: 0) @@ -729,8 +721,8 @@ :& RNil -- | A record representing a widget of the _BoundedIntRange class from IPython -defaultBoundedIntRangeWidget :: FieldType S.ViewName -> Rec Attr BoundedIntRangeClass -defaultBoundedIntRangeWidget viewName = defaultIntRangeWidget viewName <+> boundedIntRangeAttrs +defaultBoundedIntRangeWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoundedIntRangeClass +defaultBoundedIntRangeWidget viewName modelName = defaultIntRangeWidget viewName modelName <+> boundedIntRangeAttrs where boundedIntRangeAttrs = (StepInt =:+ 1) :& (MinInt =:: 0) @@ -738,8 +730,8 @@ :& RNil -- | A record representing a widget of the _Float class from IPython -defaultFloatWidget :: FieldType S.ViewName -> Rec Attr FloatClass -defaultFloatWidget viewName = defaultDOMWidget viewName <+> intAttrs +defaultFloatWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr FloatClass +defaultFloatWidget viewName modelName = defaultDOMWidget viewName modelName <+> intAttrs where intAttrs = (FloatValue =:: 0) :& (Disabled =:: False) @@ -748,8 +740,8 @@ :& RNil -- | A record representing a widget of the _BoundedFloat class from IPython -defaultBoundedFloatWidget :: FieldType S.ViewName -> Rec Attr BoundedFloatClass -defaultBoundedFloatWidget viewName = defaultFloatWidget viewName <+> boundedFloatAttrs +defaultBoundedFloatWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoundedFloatClass +defaultBoundedFloatWidget viewName modelName = defaultFloatWidget viewName modelName <+> boundedFloatAttrs where boundedFloatAttrs = (StepFloat =:+ 1) :& (MinFloat =:: 0) @@ -757,8 +749,8 @@ :& RNil -- | A record representing a widget of the _BoundedFloat class from IPython -defaultFloatRangeWidget :: FieldType S.ViewName -> Rec Attr FloatRangeClass -defaultFloatRangeWidget viewName = defaultFloatWidget viewName <+> rangeAttrs +defaultFloatRangeWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr FloatRangeClass +defaultFloatRangeWidget viewName modelName = defaultFloatWidget viewName modelName <+> rangeAttrs where rangeAttrs = (FloatPairValue =:: (25, 75)) :& (LowerFloat =:: 0) @@ -766,8 +758,8 @@ :& RNil -- | A record representing a widget of the _BoundedFloatRange class from IPython -defaultBoundedFloatRangeWidget :: FieldType S.ViewName -> Rec Attr BoundedFloatRangeClass -defaultBoundedFloatRangeWidget viewName = defaultFloatRangeWidget viewName <+> boundedFloatRangeAttrs +defaultBoundedFloatRangeWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoundedFloatRangeClass +defaultBoundedFloatRangeWidget viewName modelName = defaultFloatRangeWidget viewName modelName <+> boundedFloatRangeAttrs where boundedFloatRangeAttrs = (StepFloat =:+ 1) :& (MinFloat =:: 0) @@ -775,20 +767,18 @@ :& RNil -- | A record representing a widget of the _Box class from IPython -defaultBoxWidget :: FieldType S.ViewName -> Rec Attr BoxClass -defaultBoxWidget viewName = domAttrs <+> boxAttrs +defaultBoxWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoxClass +defaultBoxWidget viewName modelName = defaultDOMWidget viewName modelName <+> intAttrs where - defaultDOM = defaultDOMWidget viewName - domAttrs = rput (ModelName =:: "BoxModel") defaultDOM - boxAttrs = (Children =:: []) + intAttrs = (Children =:: []) :& (OverflowX =:: DefaultOverflow) :& (OverflowY =:: DefaultOverflow) :& (BoxStyle =:: DefaultBox) :& RNil -- | A record representing a widget of the _SelectionContainer class from IPython -defaultSelectionContainerWidget :: FieldType S.ViewName -> Rec Attr SelectionContainerClass -defaultSelectionContainerWidget viewName = defaultBoxWidget viewName <+> selAttrs +defaultSelectionContainerWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr SelectionContainerClass +defaultSelectionContainerWidget viewName modelName = defaultBoxWidget viewName modelName <+> selAttrs where selAttrs = (Titles =:: []) :& (SelectedIndex =:: 0)