Commit 0a181a17 authored by Andrew Gibiansky's avatar Andrew Gibiansky

Merge pull request #526 from sumitsahrawat/num-widgets

WIP: Rest of the widgets: Num + Box
parents 1c2265b6 36a30fdc
This diff is collapsed.
This diff is collapsed.
This diff is collapsed.
{
"cells": [
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### The Numeric Widgets\n",
"\n",
"#### `Int` Widgets\n",
"\n",
"+ IntText\n",
"+ BoundedIntText\n",
"+ IntProgress\n",
"+ IntSlider\n",
"+ IntRangeSlider\n",
"\n",
"#### `Float` Widgets\n",
"\n",
"+ FloatText\n",
"+ BoundedFloatText\n",
"+ FloatProgress\n",
"+ FloatSlider\n",
"+ FloatRangeSlider\n",
"\n",
"**NOTE**: Only the `Int` widgets are shown in this notebook. The `Float` widgets are the same as their `Int` counterparts, but hold `Float`s instead of `Int`s."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `IntText` and `BoundedIntText`"
]
},
{
"cell_type": "code",
"execution_count": 1,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"int <- mkIntText\n",
"int"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"bit <- mkBoundedIntText\n",
"bit"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Both the widgets are similar, but the second one possesses some additional properties."
]
},
{
"cell_type": "code",
"execution_count": 29,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField bit SMaxInt 20\n",
"setField bit SMinInt 10\n",
"setField bit SChangeHandler (getField bit SIntValue >>= print)"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now, the first widget will accept arbitrary input whereas the second one wil accept input the the 10-20 range. For example, try entering large values and hitting return/enter in the second widget."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `IntSlider` and `IntRangeSlider`"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Both these widgets are sliders (duh!). `IntSlider` represents a single value, whereas `IntRangeSlider` represents a pair (range) of values."
]
},
{
"cell_type": "code",
"execution_count": 30,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"ins <- mkIntSlider\n",
"irs <- mkIntRangeSlider"
]
},
{
"cell_type": "code",
"execution_count": 31,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"ins\n",
"irs"
]
},
{
"cell_type": "code",
"execution_count": 32,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": [
"(25,75)"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"getField irs SIntPairValue"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `IntProgress`"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"This widget is meant to be used as a progress bar."
]
},
{
"cell_type": "code",
"execution_count": 33,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"inp <- mkIntProgress\n",
"inp"
]
},
{
"cell_type": "code",
"execution_count": 34,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField inp SIntValue 42"
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Haskell",
"language": "haskell",
"name": "haskell"
}
},
"nbformat": 4,
"nbformat_minor": 0
}
This diff is collapsed.
{
"cells": [
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### The `Selection` Widgets\n",
"\n",
"+ Dropdown\n",
"+ RadioButtons\n",
"+ ToggleButtons\n",
"+ Select\n",
"+ SelectMultiple"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"These widgets can be used to choose between multiple alternatives. The `SelectMultiple` widget allows multiple selections, whereas `Dropdown`, `RadioButtons`, `ToggleButtons`, and `Select` only allow one selection."
]
},
{
"cell_type": "code",
"execution_count": 1,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"{-# LANGUAGE OverloadedStrings #-}\n",
"import IHaskell.Display.Widgets"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"-- Allows single selection\n",
"tgbs <- mkToggleButtons\n",
"\n",
"-- Allows multiple selections\n",
"msel <- mkSelectMultiple"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField msel SDescription \"Functions to show (One or more)\"\n",
"setField msel SOptions (OptionLabels [\"sin\", \"cos\"])\n",
"\n",
"setField tgbs SDescription \"Plot style\"\n",
"setField tgbs SOptions (OptionLabels [\"line\", \"point\"])"
]
},
{
"cell_type": "code",
"execution_count": 7,
"metadata": {
"collapsed": false,
"scrolled": true
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Graphics.Rendering.Chart.Easy hiding (tan)\n",
"import Graphics.Rendering.Chart.Backend.Cairo\n",
"import qualified Data.ByteString as B\n",
"import Data.Text (pack, unpack)\n",
"import IHaskell.Display (base64)\n",
"import Control.Applicative ((<$>))\n",
"\n",
"import Control.Monad (when, forM)\n",
"import Data.Maybe (fromJust)\n",
"\n",
"dset :: [(String, [(Double, Double)])]\n",
"dset = [(\"sin\", zmap sin r), (\"cos\", zmap cos r)]\n",
" where zmap f xs = zip xs (map f xs)\n",
" r = [0, 0.1 .. 6.3]\n",
"\n",
"i <- mkImageWidget\n",
"setField i SWidth 500\n",
"setField i SHeight 500\n",
"\n",
"-- Redraw the plot based on values from the widgets\n",
"refresh = do\n",
" -- Read values from the widgets\n",
" funs <- map unpack <$> getField msel SSelectedValues\n",
" sty <- unpack <$> getField tgbs SSelectedValue\n",
" \n",
" let pts = zip funs (map (fromJust . flip lookup dset) funs)\n",
" opts = def { _fo_size = (500, 500) }\n",
" toFile opts \".chart\" $ do\n",
" layout_title .= \"Plotting: \" ++ unwords funs\n",
" if sty == \"line\"\n",
" then mapM_ (\\(s, ps) -> plot (line s [ps])) pts\n",
" else mapM_ (\\(s, ps) -> plot (points s ps)) pts\n",
"\n",
" img <- B.readFile \".chart\"\n",
" setField i SB64Value (base64 img)\n",
" \n",
"-- Add event handlers to make widgets work\n",
"setField msel SSelectionHandler refresh\n",
"setField tgbs SSelectionHandler refresh"
]
},
{
"cell_type": "code",
"execution_count": 8,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
},
{
"data": {},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- Display the widgets\n",
"msel\n",
"tgbs\n",
"i"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The `Dropdown`, `RadioButtons` and `Select` widgets behave just like the `ToggleButtons` widget. They have the same properties, and the same functionality."
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Haskell",
"language": "haskell",
"name": "haskell"
}
},
"nbformat": 4,
"nbformat_minor": 0
}
......@@ -2,14 +2,15 @@
> Largely based on: https://github.com/ipython/ipython/wiki/IPEP-23:-Backbone.js-Widgets
> The messaging specification as detailed is riddled with the assumptions IHaskell's widget
> The messaging specification as detailed is riddled with assumptions IHaskell's widget
> implementation makes. It works for us, so it should work for everyone.
## Creating widgets
Let's say the user types in some code, and the only effect of that code is the creation of a widget.
The kernel will open a comm for the widget, and store a reference to that comm inside it. Then, to
notify the frontend about the creation of a widget, an initial state update is sent on the widget's comm.
notify the frontend about the creation of a widget, an initial state update is sent on the widget's
comm.
> The comm should be opened with a `target_name` of `"ipython.widget"`.
......@@ -22,7 +23,9 @@ The initial state update message looks like this:
}
```
Any *numeric* property initialized with the empty string is provided the default value by the frontend.
Any *numeric* property initialized with the empty string is provided the default value by the
frontend. Some numbers need to be sent as actual numbers (when non-null), whereas some (especially
those used by sliders) need to be sent as strings.
The initial state update must *at least* have the following fields:
......
......@@ -55,8 +55,22 @@ library
-- Modules included in this library but not exported.
other-modules: IHaskell.Display.Widgets.Button
IHaskell.Display.Widgets.Box.Box
IHaskell.Display.Widgets.Box.FlexBox
IHaskell.Display.Widgets.Box.SelectionContainer.Accordion
IHaskell.Display.Widgets.Box.SelectionContainer.Tab
IHaskell.Display.Widgets.Bool.CheckBox
IHaskell.Display.Widgets.Bool.ToggleButton
IHaskell.Display.Widgets.Int.IntText
IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText
IHaskell.Display.Widgets.Int.BoundedInt.IntProgress
IHaskell.Display.Widgets.Int.BoundedInt.IntSlider
IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider
IHaskell.Display.Widgets.Float.FloatText
IHaskell.Display.Widgets.Float.BoundedFloat.BoundedFloatText
IHaskell.Display.Widgets.Float.BoundedFloat.FloatProgress
IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider
IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider
IHaskell.Display.Widgets.Image
IHaskell.Display.Widgets.Output
IHaskell.Display.Widgets.Selection.Dropdown
......@@ -86,6 +100,7 @@ library
, vinyl >= 0.5
, vector -any
, singletons >= 0.9.0
, scientific -any
-- Waiting for the next release
, ihaskell -any
......
......@@ -2,9 +2,26 @@ module IHaskell.Display.Widgets (module X) where
import IHaskell.Display.Widgets.Button as X
import IHaskell.Display.Widgets.Box.Box 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
import IHaskell.Display.Widgets.Bool.CheckBox as X
import IHaskell.Display.Widgets.Bool.ToggleButton as X
import IHaskell.Display.Widgets.Int.IntText as X
import IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText as X
import IHaskell.Display.Widgets.Int.BoundedInt.IntProgress as X
import IHaskell.Display.Widgets.Int.BoundedInt.IntSlider as X
import IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider as X
import IHaskell.Display.Widgets.Float.FloatText as X
import IHaskell.Display.Widgets.Float.BoundedFloat.BoundedFloatText as X
import IHaskell.Display.Widgets.Float.BoundedFloat.FloatProgress as X
import IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider as X
import IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider as X
import IHaskell.Display.Widgets.Image as X
import IHaskell.Display.Widgets.Output as X
......@@ -21,4 +38,8 @@ import IHaskell.Display.Widgets.String.Text as X
import IHaskell.Display.Widgets.String.TextArea as X
import IHaskell.Display.Widgets.Common as X
import IHaskell.Display.Widgets.Types as X (setField, getField)
import IHaskell.Display.Widgets.Types as X (setField, getField, properties)
import IHaskell.Display.Widgets.Types as X (triggerDisplay, triggerChange, triggerClick,
triggerSelection, triggerSubmit,
ChildWidget(..))
......@@ -5,14 +5,14 @@
module IHaskell.Display.Widgets.Bool.CheckBox (
-- * The CheckBox Widget
CheckBoxWidget,
CheckBox,
-- * Constructor
mkCheckBoxWidget) where
mkCheckBox) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join)
import Control.Monad (when, join, void)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
......@@ -26,12 +26,12 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'CheckBoxWidget' represents a Checkbox widget from IPython.html.widgets.
type CheckBoxWidget = IPythonWidget CheckBoxType
-- | A 'CheckBox' represents a Checkbox widget from IPython.html.widgets.
type CheckBox = IPythonWidget CheckBoxType
-- | Create a new output widget
mkCheckBoxWidget :: IO CheckBoxWidget
mkCheckBoxWidget = do
mkCheckBox :: IO CheckBox
mkCheckBox = do
-- Default properties, with a random uuid
uuid <- U.random
......@@ -49,12 +49,12 @@ mkCheckBoxWidget = do
-- Return the image widget
return widget
instance IHaskellDisplay CheckBoxWidget where
instance IHaskellDisplay CheckBox where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget CheckBoxWidget where
instance IHaskellWidget CheckBox where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
......@@ -62,3 +62,4 @@ instance IHaskellWidget CheckBoxWidget where
Just (Object dict2) = HM.lookup key1 dict1
Just (Bool value) = HM.lookup key2 dict2
setField' widget SBoolValue value
triggerChange widget
......@@ -12,7 +12,7 @@ ToggleButton,
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join)
import Control.Monad (when, join, void)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
......@@ -67,3 +67,4 @@ instance IHaskellWidget ToggleButton where
Just (Object dict2) = HM.lookup key1 dict1
Just (Bool value) = HM.lookup key2 dict2
setField' widget SBoolValue value
triggerChange widget
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Box.Box (
-- * The Box widget
Box,
-- * Constructor
mkBox) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
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 'Box' represents a Box widget from IPython.html.widgets.
type Box = IPythonWidget BoxType
-- | Create a new box
mkBox :: IO Box
mkBox = do
-- Default properties, with a random uuid
uuid <- U.random
let widgetState = WidgetState $ defaultBoxWidget "BoxView"
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
-- Return the widget
return box
instance IHaskellDisplay Box where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget Box where
getCommUUID = uuid
{-# 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 Control.Monad (when, join)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import Data.Text (Text)
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 = (SOrientation =:: HorizontalOrientation)
:& (SFlex =:: 0)
:& (SPack =:: StartLocation)
:& (SAlign =:: StartLocation)
:& RNil
widgetState = WidgetState $ boxAttrs <+> flxAttrs
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
-- Return the widget
return box
instance IHaskellDisplay FlexBox where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget FlexBox where
getCommUUID = uuid
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Box.SelectionContainer.Accordion (
-- * The Accordion widget
Accordion,
-- * Constructor
mkAccordion) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
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 'Accordion' represents a Accordion widget from IPython.html.widgets.
type Accordion = IPythonWidget AccordionType
-- | Create a new box
mkAccordion :: IO Accordion
mkAccordion = do
-- Default properties, with a random uuid
uuid <- U.random
let widgetState = WidgetState $ defaultSelectionContainerWidget "AccordionView"
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
-- Return the widget
return box
instance IHaskellDisplay Accordion where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget Accordion where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "selected_index" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number num) = HM.lookup key2 dict2
setField' widget SSelectedIndex (Sci.coefficient num)
triggerChange widget
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Box.SelectionContainer.Tab (
-- * The Tab widget
TabWidget,
-- * Constructor
mkTabWidget) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join)
import Data.Aeson
import Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
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 'TabWidget' represents a Tab widget from IPython.html.widgets.
type TabWidget = IPythonWidget TabType
-- | Create a new box
mkTabWidget :: IO TabWidget
mkTabWidget = do
-- Default properties, with a random uuid
uuid <- U.random
let widgetState = WidgetState $ defaultSelectionContainerWidget "TabView"
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
-- Return the widget
return box
instance IHaskellDisplay TabWidget where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget TabWidget where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "selected_index" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number num) = HM.lookup key2 dict2
setField' widget SSelectedIndex (Sci.coefficient num)
triggerChange widget
......@@ -7,9 +7,7 @@ module IHaskell.Display.Widgets.Button (
-- * The Button Widget
Button,
-- * Create a new button
mkButton,
-- * Click manipulation
triggerClick) where
mkButton) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
......@@ -59,10 +57,6 @@ mkButton = do
-- Return the button widget
return button
-- | Artificially trigger a button click
triggerClick :: Button -> IO ()
triggerClick button = join $ getField button SClickHandler
instance IHaskellDisplay Button where
display b = do
widgetSendView b
......
......@@ -12,7 +12,7 @@ Dropdown,
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join)
import Control.Monad (when, join, void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
......@@ -50,10 +50,6 @@ mkDropdown = do
-- Return the widget
return widget
-- | Artificially trigger a selection
triggerSelection :: Dropdown -> IO ()
triggerSelection widget = join $ getField widget SSelectionHandler
instance IHaskellDisplay Dropdown where
display b = do
widgetSendView b
......@@ -68,13 +64,13 @@ instance IHaskellWidget Dropdown where
Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions
case opts of
OptionLabels _ -> do
OptionLabels _ -> void $ do
setField' widget SSelectedLabel label
setField' widget SSelectedValue label
OptionDict ps ->
case lookup label ps of
Nothing -> return ()
Just value -> do
Just value -> void $ do
setField' widget SSelectedLabel label
setField' widget SSelectedValue value
triggerSelection 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