Merge pull request #526 from sumitsahrawat/num-widgets

WIP: Rest of the widgets: Num + Box

ihaskell-display/ihaskell-widgets/Examples/Numeric Widgets.ipynb

+{
+ "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
+}

ihaskell-display/ihaskell-widgets/Examples/Selection Widgets.ipynb

+{
+ "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
+}

ihaskell-display/ihaskell-widgets/MsgSpec.md

@@ -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:
 

ihaskell-display/ihaskell-widgets/ihaskell-widgets.cabal

@@ -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

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets.hs

@@ -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(..))

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

@@ -5,14 +5,14 @@
 
 module IHaskell.Display.Widgets.Bool.CheckBox (
 -- * The CheckBox Widget
-CheckBoxWidget, 
-                -- * Constructor
-                mkCheckBoxWidget) where
+CheckBox, 
+          -- * Constructor
+          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

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

@@ -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

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

+{-# 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

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

+{-# 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

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

+{-# 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

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

+{-# 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

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

@@ -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

ipython-kernel/src/IHaskell/IPython/Message/UUID.hs

 -- | Description : UUID generator and data structure
 --
 -- Generate, parse, and pretty print UUIDs for use with IPython.
-module IHaskell.IPython.Message.UUID (UUID, random, randoms) where
+module IHaskell.IPython.Message.UUID (UUID, random, randoms, uuidToString) where
 
 import           Control.Monad (mzero, replicateM)
 import           Control.Applicative ((<$>))
@@ -16,7 +16,7 @@ data UUID =
      -- present in the correct locations. For the purposes of new UUIDs, it does not matter,
      -- but IPython expects UUIDs passed to kernels to be returned unchanged, so we cannot
      -- actually parse them.
-      UUID String
+      UUID { uuidToString :: String }
   deriving (Show, Read, Eq, Ord)
 
 -- | Generate a list of random UUIDs.
@@ -28,7 +28,7 @@ randoms n = replicateM n random
 random :: IO UUID
 random = UUID <$> show <$> nextRandom
 
--- Allows reading and writing UUIDs as Strings in JSON. 
+-- Allows reading and writing UUIDs as Strings in JSON.
 instance FromJSON UUID where
   parseJSON val@(String _) = UUID <$> parseJSON val