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
{
"cells": [
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## The `Bool` Widgets\n",
"\n",
"+ CheckBox\n",
"+ ToggleButton"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"These widgets can be used to represent a Boolean value. The idea is pretty simple, the widget can be in one of two states which represent the two boolean values.\n",
"\n",
" Checked / On : True\n",
" Unchecked / Off : False"
]
},
{
"cell_type": "code",
"execution_count": 1,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"{-# LANGUAGE OverloadedStrings #-}\n",
"import IHaskell.Display.Widgets\n",
"import Data.Text (pack, unpack)\n",
"import Text.Printf (printf)"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Simple demonstration"
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- Constructors\n",
"chk <- mkCheckBox\n",
"tgb <- mkToggleButton\n",
"\n",
"-- For demonstration\n",
"o <- mkHTMLWidget"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Below, we represent one boolean using a checkbox, and the other using a toggle button. The logical and (`&&`) of the two is displayed below."
]
},
{
"cell_type": "code",
"execution_count": 3,
"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"
}
],
"source": [
"-- Display\n",
"chk\n",
"tgb\n",
"o"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The `BoolValue` field represents the underlying boolean value."
]
},
{
"cell_type": "code",
"execution_count": 4,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField chk SDescription \"Bool 1: \"\n",
"setField tgb SDescription \"Bool 2\"\n",
"\n",
"-- Helper function\n",
"refresh b =\n",
" let stat = if b then \"green\" else \"red\"\n",
" fmt = \"<div style=\\\"background:%s;color:#ffffff\\\"><b>%s</b></div>\"\n",
" in setField o SStringValue $ pack $ printf fmt stat (show b)\n",
"\n",
" -- Cosmetic changes\n",
"setField o SDescription \"Bool 1 && Bool 2\"\n",
"setField o SPadding 10\n",
"\n",
" -- And (&&) the two values, and send output to html widget\n",
"setHandler w = setField w SChangeHandler $ do\n",
" b1 <- getField chk SBoolValue\n",
" b2 <- getField tgb SBoolValue\n",
" refresh (b1 && b2)\n",
"\n",
"setHandler chk\n",
"setHandler tgb"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Extended example"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Let's try to create a graphical 8-bit-binary to decimal converter. We'll represent seven bits using `ToggleButton` widgets, and the negative bit using a `CheckBox`. The binary number is represented using 1+7-bit sign-and-magnitude representation for simplicity.\n",
"\n",
"Boxes are used to layout the widgets in an appealing manner, and the output widget is used to display the result."
]
},
{
"cell_type": "code",
"execution_count": 5,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"-- First, some library functions\n",
"import Control.Monad (replicateM, forM_)\n",
"import Data.IORef\n",
"import IHaskell.Display (plain)"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now, we create a `CheckBox` and seven `ToggleButton`s."
]
},
{
"cell_type": "code",
"execution_count": 6,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"sign <- mkCheckBox\n",
"bits <- replicateM 7 mkToggleButton\n",
"\n",
"setField sign SDescription \"Negative\"\n",
"forM_ bits $ \\t -> do\n",
" setField t SButtonStyle PrimaryButton\n",
" setField t SBorderRadius 20"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Then we create a `FlexBox` to hold the widgets, and an `HTMLWidget` to display the output."
]
},
{
"cell_type": "code",
"execution_count": 7,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"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"
},
{
"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"
},
{
"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"
},
{
"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"
},
{
"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"
},
{
"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"
},
{
"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"
},
{
"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"
},
{
"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"
},
{
"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"
},
{
"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"
},
{
"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": [
"box <- mkFlexBox\n",
"out <- mkHTMLWidget\n",
"\n",
"-- Sub-containers\n",
"box1 <- mkFlexBox\n",
"setField box1 SChildren [ChildWidget sign, ChildWidget out]\n",
"box2 <- mkFlexBox\n",
"setField box2 SChildren (map ChildWidget $ reverse bits)\n",
"\n",
"-- Add widgets to the container\n",
"setField box SChildren (map ChildWidget [box1, box2])\n",
"setField box SOrientation VerticalOrientation\n",
"\n",
"-- Add some UI chrome\n",
"setField box SBoxStyle InfoBox\n",
"setField box SBorderRadius 20\n",
"setField out SBorderStyle GrooveBorder\n",
"setField out SBorderRadius 20\n",
"setField out SBorderWidth 4\n",
"setField out SWidth 100\n",
"setField out SHeight 30\n",
"setField out SMargin 10\n",
"setField sign SPadding 10\n",
"setField box2 SPadding 10\n",
"setField box2 SPack BaselineLocation\n",
"\n",
"-- Display the container\n",
"box"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now, we implement the logic of our converter, and make it send the output to the `HTMLWidget` we created above."
]
},
{
"cell_type": "code",
"execution_count": 14,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Control.Arrow (first, second)\n",
"\n",
"-- Mutable value, with a sign bit\n",
"val <- newIORef (0 :: Int, False)\n",
"\n",
"-- Helper function to redraw output\n",
"refresh :: (Int, Bool) -> IO ()\n",
"refresh (x, b) = \n",
" let val = x * if b then (-1) else 1\n",
" fmt = \"<div align=\\\"center\\\"><b>%d</b></div>\"\n",
" in setField out SStringValue (pack $ printf fmt val)\n",
"\n",
"setField sign SChangeHandler $ do\n",
" -- Change sign for value\n",
" modifyIORef val (second not)\n",
" -- Redraw output\n",
" readIORef val >>= refresh\n",
"\n",
"forM_ (zip bits (iterate (*2) 1)) $ \\(t, n) -> do\n",
" setField t SDescription \"0\"\n",
" setField t SChangeHandler $ do\n",
" f <- getField t SBoolValue\n",
" setField t SDescription (if f then \"1\" else \"0\")\n",
" modifyIORef val (first $ if f then (+n) else (\\x->x-n))\n",
" readIORef val >>= refresh"
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Haskell",
"language": "haskell",
"name": "haskell"
}
},
"nbformat": 4,
"nbformat_minor": 0
}
{
"cells": [
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### The Box widgets\n",
"\n",
"+ Box\n",
"+ FlexBox\n",
"+ Accordion\n",
"+ TabWidget"
]
},
{
"cell_type": "markdown",
"metadata": {
"collapsed": true
},
"source": [
"These widgets are used to provide a layout for placing other widgets."
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"{-# LANGUAGE OverloadedStrings #-}\n",
"import IHaskell.Display.Widgets"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"These widgets have a `Children` field, which accepts a `[ChildWidget]`. A `ChildWidget` can be created using the `ChildWidget` constructor."
]
},
{
"cell_type": "code",
"execution_count": 5,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>Children :: Field</span>"
],
"text/plain": [
"Children :: Field"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>SChildren :: Sing 'Children</span>"
],
"text/plain": [
"SChildren :: Sing 'Children"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>ChildWidget :: forall (w :: WidgetType). (RecAll Attr (WidgetFields w) ToPairs) => IPythonWidget w -> ChildWidget</span>"
],
"text/plain": [
"ChildWidget :: forall (w :: WidgetType). (RecAll Attr (WidgetFields w) ToPairs) => IPythonWidget w -> ChildWidget"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
":t Children\n",
":t SChildren\n",
":t ChildWidget"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `Box` and `FlexBox`"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- Create new Box and FlexBox\n",
"box <- mkBox\n",
"flx <- mkFlexBox"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"By default, boxes have a horizontal orientation. Thus adding some widgets to them lays them out horizontally."
]
},
{
"cell_type": "code",
"execution_count": 8,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import Control.Monad (replicateM)\n",
"\n",
"-- Make some buttons\n",
"buttons <- replicateM 20 mkButton\n",
"\n",
"-- Add children widgets to boxes\n",
"let children = map ChildWidget buttons\n",
"setField box SChildren children\n",
"setField flx SChildren children\n",
"\n",
"-- Display boxes\n",
"box\n",
"flx"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"You might be thinking that there is no difference between `Box` and `FlexBox`, but that's not true.\n",
"\n",
"Following are some differences:\n",
"\n",
"+ `Box` is always horizontal, whereas `FlexBox` has a configurable `Orientation`.\n",
"+ `FlexBox` is flexible, and the flexibility is determined by its `Flex` field (0 to 2).\n",
"+ `FlexBox` also has explicit `Pack` and `Align` fields."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `Accordion` and `TabWidget`"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"These widgets are useful for displaying a variety of content in a small amount of space."
]
},
{
"cell_type": "code",
"execution_count": 9,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"acc <- mkAccordion\n",
"tab <- mkTabWidget"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Let's add some children and see what the result looks like."
]
},
{
"cell_type": "code",
"execution_count": 13,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"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": [
"buttons' <- replicateM 5 mkButton\n",
"\n",
"let children = map ChildWidget buttons'\n",
"\n",
"setField acc SChildren children\n",
"setField tab SChildren children\n",
"\n",
"acc\n",
"tab"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Both the widgets are similar, the only difference is in the orientation. `Accordion` is vertical, whereas `TabWidget` is horizontal."
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Haskell",
"language": "haskell",
"name": "haskell"
}
},
"nbformat": 4,
"nbformat_minor": 0
}
{
"cells": [
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### The `Image` Widget"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"This widget can be used to display images given in the form of base64 encoded `Text`. The widget has a `B64Value` field, which can be changed to display images to it. It also has an `ImageFormat` field, which is set to `PNG` by default."
]
},
{
"cell_type": "code",
"execution_count": 21,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>IHaskell.Display.base64 :: ByteString -> Base64</span>"
],
"text/plain": [
"IHaskell.Display.base64 :: ByteString -> Base64"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>IHaskell.Display.encode64 :: String -> Base64</span>"
],
"text/plain": [
"IHaskell.Display.encode64 :: String -> Base64"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
":t IHaskell.Display.base64\n",
":t IHaskell.Display.encode64"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The following example downloads an xkcd comic and displays it in an image widget."
]
},
{
"cell_type": "code",
"execution_count": 4,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- Uncomment the line below to install HTTP if you don't have it\n",
"-- :!cabal install HTTP\n",
"import Network.HTTP\n",
"import IHaskell.Display (encode64)\n",
"\n",
"get url = simpleHTTP (getRequest url) >>= getResponseBody\n",
"jpg <- get \"http://imgs.xkcd.com/comics/functional.png\"\n",
"\n",
"img <- mkImageWidget\n",
"setField img SB64Value (encode64 jpg)\n",
"img"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Replace the call to undefined by the path to an image, and it will be displayed in an image widget."
]
},
{
"cell_type": "code",
"execution_count": 5,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='err-msg'>Couldn't match type ‘String’ with ‘B.ByteString’<br/>Expected type: B.ByteString -> IHaskell.Display.Base64<br/> Actual type: String -> IHaskell.Display.Base64<br/>In the second argument of ‘(.)’, namely ‘encode64’<br/>In the second argument of ‘(>>=)’, namely ‘setField i SB64Value . encode64’</span>"
],
"text/plain": [
"Couldn't match type ‘String’ with ‘B.ByteString’\n",
"Expected type: B.ByteString -> IHaskell.Display.Base64\n",
" Actual type: String -> IHaskell.Display.Base64\n",
"In the second argument of ‘(.)’, namely ‘encode64’\n",
"In the second argument of ‘(>>=)’, namely ‘setField i SB64Value . encode64’"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"imgpath = undefined\n",
"\n",
"import qualified Data.ByteString as B\n",
"import IHaskell.Display (encode64)\n",
"\n",
"i <- mkImageWidget\n",
"B.readFile imgpath >>= setField i SB64Value . encode64"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### The `Selection` Widgets"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"These widgets can be used to select one from many. The `SelectMultiple` widget allows multiple selections, whereas `Dropdown`, `RadioButtons`, `ToggleButtons`, and `Select` only allow one selection."
]
},
{
"cell_type": "code",
"execution_count": 23,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"-- Allows single selection\n",
"tgbs <- mkToggleButtons\n",
"\n",
"-- Allows multiple selections\n",
"msel <- mkSelectMultiple"
]
},
{
"cell_type": "code",
"execution_count": 24,
"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": 25,
"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",
"\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": 26,
"metadata": {
"collapsed": false
},
"outputs": [],
"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."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### The Numeric Widgets"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"**NOTE**: The following examples use widgets with `Int` in their names. There are also analogous widgets with `Float` in their names.\n",
"\n",
"As the widgets are the same operationally, only the `Int` widgets are shown."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### `IntText` and `BoundedIntText`"
]
},
{
"cell_type": "code",
"execution_count": 27,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"int <- mkIntText\n",
"bit <- mkBoundedIntText"
]
},
{
"cell_type": "code",
"execution_count": 28,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"int\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
}
{
"cells": [
{
"cell_type": "markdown",
"metadata": {},
"source": [
"# The IPython widgets, now in IHaskell !!"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"It is highly recommended that users new to jupyter/ipython take the *User Interface Tour* from the toolbar above (Help -> User Interface Tour)."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"> This notebook introduces the [IPython widgets](https://github.com/ipython/ipywidgets), as implemented in [IHaskell](https://github.com/gibiansky/IHaskell). The `Button` widget is also demonstrated as a live action example."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### The Widget Hierarchy\n",
"\n",
"These are all the widgets available from IPython/Jupyter."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### Uncategorized Widgets\n",
"\n",
"+ Button\n",
"+ Image*Widget*\n",
"+ Output*Widget*\n",
"\n",
"#### Box Widgets\n",
"\n",
"+ Box\n",
"+ FlexBox\n",
"+ Accordion\n",
"+ Tab*Widget*\n",
"\n",
"#### Boolean Widgets\n",
"\n",
"+ CheckBox\n",
"+ ToggleButton\n",
"\n",
"#### Integer 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",
"#### Selection Widgets\n",
"\n",
"+ Selection\n",
"+ Dropdown\n",
"+ RadioButtons\n",
"+ Select\n",
"+ SelectMultiple\n",
"+ ToggleButtons\n",
"\n",
"#### String Widgets\n",
"\n",
"+ HTML*Widget*\n",
"+ Latex*Widget*\n",
"+ TextArea\n",
"+ Text*Widget*"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Using Widgets"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### Necessary Extensions and Imports\n",
"\n",
"All the widgets and related functions are available from a single module, `IHaskell.Display.Widgets`. It is strongly recommended that users use the `OverloadedStrings` extension, as widgets make extensive use of `Text`."
]
},
{
"cell_type": "code",
"execution_count": 1,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"{-# LANGUAGE OverloadedStrings #-}\n",
"import IHaskell.Display.Widgets"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The module can be imported unqualified. Widgets with common names, such as `Text`, `Image` etc. have a `-Widget` suffix to prevent name collisions."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### Widget interface\n",
"\n",
"Each widget has different properties, but the surface level API is the same.\n",
"\n",
"Every widget has:\n",
"\n",
"1. A constructor:\n",
" An `IO <widget>` value/function of the form `mk<widget_name>`.\n",
"2. A set of properties, which can be manipulated using `setField` and `getField`.\n",
"\n",
"The `setField` and `getField` functions have nasty type signatures, but they can be used by just intuitively understanding them."
]
},
{
"cell_type": "code",
"execution_count": 2,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>setField :: forall (w :: WidgetType) (f :: Field). (RElem f (WidgetFields w) (RIndex f (WidgetFields w)), ToPairs (Attr f), IHaskellWidget (IPythonWidget w)) => IPythonWidget w -> SField f -> FieldType f -> IO ()</span>"
],
"text/plain": [
"setField :: forall (w :: WidgetType) (f :: Field). (RElem f (WidgetFields w) (RIndex f (WidgetFields w)), ToPairs (Attr f), IHaskellWidget (IPythonWidget w)) => IPythonWidget w -> SField f -> FieldType f -> IO ()"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
":t setField"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The `setField` function takes three arguments:\n",
"\n",
"1. A widget\n",
"2. A `singleton` for a `Field`\n",
"3. A value for the `Field`"
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {
"collapsed": false,
"scrolled": true
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>getField :: forall (w :: WidgetType) (f :: Field). RElem f (WidgetFields w) (RIndex f (WidgetFields w)) => IPythonWidget w -> SField f -> IO (FieldType f)</span>"
],
"text/plain": [
"getField :: forall (w :: WidgetType) (f :: Field). RElem f (WidgetFields w) (RIndex f (WidgetFields w)) => IPythonWidget w -> SField f -> IO (FieldType f)"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
":t getField"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The `getField` function takes a `Widget`, and a singleton for a `Field` and returns the value of that `Field` for the `Widget`."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Another utility function is `properties`, which shows all properties of a widget."
]
},
{
"cell_type": "code",
"execution_count": 4,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>properties :: forall (w :: WidgetType). IPythonWidget w -> IO [Field]</span>"
],
"text/plain": [
"properties :: forall (w :: WidgetType). IPythonWidget w -> IO [Field]"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
":t properties"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### Singletons\n",
"\n",
"For the purpose of using widgets, singletons are a way of representing properties. To represent a `Field`, we use its singleton, which is written as `S<fieldname>`, i.e `S` followed by the field.\n",
"\n",
"For example, the singleton for `Description` would be `SDescription`."
]
},
{
"cell_type": "code",
"execution_count": 5,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>Description :: Field</span>"
],
"text/plain": [
"Description :: Field"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>SDescription :: Sing 'Description</span>"
],
"text/plain": [
"SDescription :: Sing 'Description"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
":t Description\n",
":t SDescription"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"**PS:** Don't blame me for the naming `:)`. The singletons are generated using Template Haskell."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### Displaying Widgets\n",
"\n",
"IHaskell automatically displays anything *displayable* given to it directly."
]
},
{
"cell_type": "code",
"execution_count": 6,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": [
"3"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/plain": [
"\"abc\""
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- Showables\n",
"1 + 2\n",
"\"abc\""
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Widgets can either be displayed this way, or explicitly using the `display` function from `IHaskell.Display`."
]
},
{
"cell_type": "code",
"execution_count": 7,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>display :: forall a. IHaskellDisplay a => a -> IO Display</span>"
],
"text/plain": [
"display :: forall a. IHaskellDisplay a => a -> IO Display"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"import IHaskell.Display\n",
":t display"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### Multiple displays\n",
"\n",
"A widget can be displayed multiple times. All these *views* are representations of a single object, and thus are linked.\n",
"\n",
"When a widget is created, a model representing it is created in the frontend. This model is used by all the views, and any modification to it propagates to all of them."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"#### Closing widgets\n",
"\n",
"Widgets can be closed using the `closeWidget` function."
]
},
{
"cell_type": "code",
"execution_count": 8,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>closeWidget :: forall w. IHaskellWidget w => w -> IO ()</span>"
],
"text/plain": [
"closeWidget :: forall w. IHaskellWidget w => w -> IO ()"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
":t closeWidget"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### Our first widget: `Button`"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Let's play with buttons as a starting example:\n",
"\n",
"As noted before, all widgets have a constructor of the form `mk<Widget>`. Thus, to create a `Button`, we use `mkButton`."
]
},
{
"cell_type": "code",
"execution_count": 9,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>button :: Button</span>"
],
"text/plain": [
"button :: Button"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"button <- mkButton -- Construct a Button\n",
":t button"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Widgets can be displayed by just entering them into a cell."
]
},
{
"cell_type": "code",
"execution_count": 10,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"button -- Display the button"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"To view a widget's properties, we use the `properties` function:"
]
},
{
"cell_type": "code",
"execution_count": 11,
"metadata": {
"collapsed": false,
"scrolled": false
},
"outputs": [
{
"data": {
"text/plain": [
"ViewModule\n",
"ViewName\n",
"MsgThrottle\n",
"Version\n",
"DisplayHandler\n",
"Visible\n",
"CSS\n",
"DOMClasses\n",
"Width\n",
"Height\n",
"Padding\n",
"Margin\n",
"Color\n",
"BackgroundColor\n",
"BorderColor\n",
"BorderWidth\n",
"BorderRadius\n",
"BorderStyle\n",
"FontStyle\n",
"FontWeight\n",
"FontSize\n",
"FontFamily\n",
"Description\n",
"Tooltip\n",
"Disabled\n",
"Icon\n",
"ButtonStyle\n",
"ClickHandler"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- The button widget has many properties.\n",
"properties button >>= mapM_ print"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The properties shown above are actually types, and we have to use singletons to pass them to `setField`. Let's try making the button widget wider. As mentioned before, we can create a singleton by just pre-pending a `Field` with an uppercase `S`."
]
},
{
"cell_type": "code",
"execution_count": 12,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"-- 250 pixels wide\n",
"-- Singleton for Width == (SWidth :: SField Width)\n",
"setField button SWidth 250"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"There is a lot that can be customized. For example:"
]
},
{
"cell_type": "code",
"execution_count": 13,
"metadata": {
"collapsed": false,
"scrolled": true
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField button SDescription \"Click Me (._.\\\")\"\n",
"setField button SButtonStyle SuccessButton\n",
"setField button SBorderStyle RidgeBorder\n",
"setField button SBorderWidth 20\n",
"setField button SBorderRadius 30\n",
"setField button SPadding 10\n",
"setField button SHeight 125\n",
"setField button SFontFamily \"cursive\"\n",
"setField button SFontSize 30"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The button widget also provides a click handler. We can make it do anything, except console input."
]
},
{
"cell_type": "code",
"execution_count": 14,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField button SClickHandler $ putStrLn \"fO_o\""
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Haskell",
"language": "haskell",
"name": "haskell"
}
},
"nbformat": 4,
"nbformat_minor": 0
}
{
"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
}
{
"cells": [
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### The `OutputWidget`"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The output widget can be used to display rich output. `IHaskell.Display` provides functions to create such rich displays from raw data."
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {
"collapsed": false,
"scrolled": true
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>plain :: String -> DisplayData</span>"
],
"text/plain": [
"plain :: String -> DisplayData"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>html :: String -> DisplayData</span>"
],
"text/plain": [
"html :: String -> DisplayData"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>jpg :: Width -> Height -> Base64 -> DisplayData</span>"
],
"text/plain": [
"jpg :: Width -> Height -> Base64 -> DisplayData"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>svg :: String -> DisplayData</span>"
],
"text/plain": [
"svg :: String -> DisplayData"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>latex :: String -> DisplayData</span>"
],
"text/plain": [
"latex :: String -> DisplayData"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>javascript :: String -> DisplayData</span>"
],
"text/plain": [
"javascript :: String -> DisplayData"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>many :: [Display] -> Display</span>"
],
"text/plain": [
"many :: [Display] -> Display"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"{-# LANGUAGE OverloadedStrings #-}\n",
"import IHaskell.Display.Widgets\n",
"import IHaskell.Display\n",
":t plain\n",
":t html\n",
":t jpg\n",
":t svg\n",
":t latex\n",
":t javascript\n",
":t many"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The `Output` widget is meant to be used through the functions:\n",
"\n",
"+ `appendOutput`: Append more output to the widget.\n",
"+ `clearOutput`: Clear the output widget ASAP.\n",
"+ `clearOutput_`: Clear the output widget on next use of `appendOutput`.\n",
"+ `replaceOutput`: Clear then append."
]
},
{
"cell_type": "code",
"execution_count": 7,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"import Text.Printf\n",
"o <- mkOutputWidget -- Make output widget\n",
"setField o SWidth 500\n",
"o -- Display output widget\n",
"\n",
"fmt = \"<font color=\\\"%s\\\"><marquee direction=\\\"%s\\\" style=\\\"background:%s\\\">%s</marquee></font>\"\n",
"add fg bg dir txt = appendOutput o $ html $ printf fmt fg dir bg txt\n",
"\n",
"add \"WHITE\" \"RED\" \"left\" \"The <b>OUTPUT</b> Widget\"\n",
"add \"WHITE\" \"BLUE\" \"right\" \"Is really <b>SIMPLE</b>\"\n",
"add \"WHITE\" \"GREEN\" \"left\" \"Use it as an <b>UPDATABLE</b> display</b>\""
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Currently, the output widget doesn't support displaying other widgets inside it. It does so in IPython, but not in IHaskell."
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Haskell",
"language": "haskell",
"name": "haskell"
}
},
"nbformat": 4,
"nbformat_minor": 0
}
{
"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
}
{
"cells": [
{
"cell_type": "markdown",
"metadata": {},
"source": [
"## The String Widgets\n",
"\n",
"+ HTMLWidget\n",
"+ LatexWidget\n",
"+ TextWidget\n",
"+ TextArea"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"These widgets are used to display data conventionally represented as strings."
]
},
{
"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": false
},
"outputs": [],
"source": [
"-- Constructors\n",
"html <- mkHTMLWidget\n",
"latex <- mkLatexWidget\n",
"text <- mkTextWidget\n",
"area <- mkTextArea"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"These widgets have a `Text` payload, represented by the `StringValue` field."
]
},
{
"cell_type": "code",
"execution_count": 3,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>StringValue :: Field</span>"
],
"text/plain": [
"StringValue :: Field"
]
},
"metadata": {},
"output_type": "display_data"
},
{
"data": {
"text/html": [
"<style>/*\n",
"Custom IHaskell CSS.\n",
"*/\n",
"\n",
"/* Styles used for the Hoogle display in the pager */\n",
".hoogle-doc {\n",
" display: block;\n",
" padding-bottom: 1.3em;\n",
" padding-left: 0.4em;\n",
"}\n",
".hoogle-code {\n",
" display: block;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
"}\n",
".hoogle-text {\n",
" display: block;\n",
"}\n",
".hoogle-name {\n",
" color: green;\n",
" font-weight: bold;\n",
"}\n",
".hoogle-head {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-sub {\n",
" display: block;\n",
" margin-left: 0.4em;\n",
"}\n",
".hoogle-package {\n",
" font-weight: bold;\n",
" font-style: italic;\n",
"}\n",
".hoogle-module {\n",
" font-weight: bold;\n",
"}\n",
".hoogle-class {\n",
" font-weight: bold;\n",
"}\n",
"\n",
"/* Styles used for basic displays */\n",
".get-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" display: block;\n",
" white-space: pre-wrap;\n",
"}\n",
"\n",
".show-type {\n",
" color: green;\n",
" font-weight: bold;\n",
" font-family: monospace;\n",
" margin-left: 1em;\n",
"}\n",
"\n",
".mono {\n",
" font-family: monospace;\n",
" display: block;\n",
"}\n",
"\n",
".err-msg {\n",
" color: red;\n",
" font-style: italic;\n",
" font-family: monospace;\n",
" white-space: pre;\n",
" display: block;\n",
"}\n",
"\n",
"#unshowable {\n",
" color: red;\n",
" font-weight: bold;\n",
"}\n",
"\n",
".err-msg.in.collapse {\n",
" padding-top: 0.7em;\n",
"}\n",
"\n",
"/* Code that will get highlighted before it is highlighted */\n",
".highlight-code {\n",
" white-space: pre;\n",
" font-family: monospace;\n",
"}\n",
"\n",
"/* Hlint styles */\n",
".suggestion-warning { \n",
" font-weight: bold;\n",
" color: rgb(200, 130, 0);\n",
"}\n",
".suggestion-error { \n",
" font-weight: bold;\n",
" color: red;\n",
"}\n",
".suggestion-name {\n",
" font-weight: bold;\n",
"}\n",
"</style><span class='get-type'>SStringValue :: Sing 'StringValue</span>"
],
"text/plain": [
"SStringValue :: Sing 'StringValue"
]
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
":t StringValue\n",
":t SStringValue -- singleton"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### HTML and Latex"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The `HTMLWidget` and `LatexWidget` display `Text` as rich formatted *HTML* and *LaTeX* respectively."
]
},
{
"cell_type": "code",
"execution_count": 4,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"-- Display the widgets\n",
"html\n",
"latex"
]
},
{
"cell_type": "code",
"execution_count": 5,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"-- Set some html string\n",
"setField html SStringValue \"<b>Bold</b>\""
]
},
{
"cell_type": "code",
"execution_count": 6,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"-- Set some latex string\n",
"setField latex SStringValue \"$x + y$\""
]
},
{
"cell_type": "code",
"execution_count": 7,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"-- The default width of LatexWidget is somewhat small\n",
"setField latex SWidth 400"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"We can also add some padding to the widgets."
]
},
{
"cell_type": "code",
"execution_count": 8,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"setField html SPadding 10\n",
"setField latex SPadding 10"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"### `TextWidget` and `TextArea`"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"First, let's see what they look like:"
]
},
{
"cell_type": "code",
"execution_count": 9,
"metadata": {
"collapsed": false
},
"outputs": [],
"source": [
"text\n",
"area"
]
},
{
"cell_type": "code",
"execution_count": 10,
"metadata": {
"collapsed": false,
"scrolled": true
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"-- Some padding\n",
"setField text SPadding 5"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The `TextWidget` and `TextArea` also have a `Placeholder` property, which represents the text displayed in empty widgets."
]
},
{
"cell_type": "code",
"execution_count": 11,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField text SPlaceholder \"Enter your text here...\"\n",
"setField area SPlaceholder \"Parsed output will appear here...\""
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Both the widgets also accept input. The `StringValue` of the widget is automatically updated on every change to the widget. Additionally, the `TextWidget` also has a `SubmitHandler` which is triggered on hitting the return/enter key."
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Below we set up the `TextWidget` and `TextArea` for parsing phone numbers using parsec. The `TextWidget` is used to recieve input, and the `TextArea` is used to display output."
]
},
{
"cell_type": "code",
"execution_count": 12,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"-- Import parsec and other required libraries\n",
"\n",
"import Text.Parsec\n",
"import Text.Parsec.String\n",
"import Data.Text (pack, unpack)\n",
"import Control.Applicative ((<$>))"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now, we can write some parsers:"
]
},
{
"cell_type": "code",
"execution_count": 13,
"metadata": {
"collapsed": true
},
"outputs": [],
"source": [
"-- Parse a single digit\n",
"digit :: Parser Char\n",
"digit = oneOf ['0'..'9']\n",
"\n",
"-- Parse a multi-digit number.\n",
"number :: Parser Integer\n",
"number = do\n",
" digits <- many1 digit -- At least one digit\n",
" return (read digits) -- Convert [Char] to Integer\n",
" \n",
"-- Parse a country code, starting with a +.\n",
"countryCode :: Parser Integer\n",
"countryCode = do\n",
" char '+'\n",
" number\n",
" \n",
"-- Parse an area code, optionally with parentheses.\n",
"areaCode :: Parser Integer\n",
"areaCode = choice [withParens, withoutParens]\n",
" where\n",
" withParens = between (char '(') (char ')') withoutParens\n",
" withoutParens = number\n",
" \n",
"-- Simple data type representing a phone number.\n",
"-- Real phone numbers are much more complex!\n",
"data PhoneNumber = PhoneNumber {\n",
" phoneCountryCode :: Maybe Integer,\n",
" phoneNumbers :: [Integer]\n",
" } deriving (Eq, Show)\n",
" \n",
"phoneNumber :: Parser PhoneNumber\n",
"phoneNumber = do\n",
" -- Try to parse a country code. If it doesn't work, it's Nothing.\n",
" c <- optionMaybe countryCode\n",
" optional separator\n",
" a1 <- areaCode\n",
" separator -- Separator required after area code\n",
" a2 <- number\n",
" separator -- Separator required before last group of digits\n",
" a3 <- number\n",
" return (PhoneNumber c [a1, a2, a3])\n",
" \n",
" where\n",
" separator = oneOf \" -\""
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"Now, we set the `TextWidget`'s change handler to parse the input, and write the output to the `TextArea`."
]
},
{
"cell_type": "code",
"execution_count": 14,
"metadata": {
"collapsed": false
},
"outputs": [
{
"data": {
"text/plain": []
},
"metadata": {},
"output_type": "display_data"
}
],
"source": [
"setField text SChangeHandler $ do\n",
" input <- unpack <$> getField text SStringValue\n",
" str <- case parse phoneNumber \"<text widget>\" input of\n",
" Left error -> return (show error)\n",
" Right x -> return (show x)\n",
" setField area SStringValue (pack str)"
]
},
{
"cell_type": "markdown",
"metadata": {},
"source": [
"The `TextArea` doesn't have a `SubmitHandler`, but does have a `ChangeHandler`. It is best used to display large amounts of text."
]
}
],
"metadata": {
"kernelspec": {
"display_name": "Haskell",
"language": "haskell",
"name": "haskell"
}
},
"nbformat": 4,
"nbformat_minor": 0
}
...@@ -2,14 +2,15 @@ ...@@ -2,14 +2,15 @@
> Largely based on: https://github.com/ipython/ipython/wiki/IPEP-23:-Backbone.js-Widgets > 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. > implementation makes. It works for us, so it should work for everyone.
## Creating widgets ## Creating widgets
Let's say the user types in some code, and the only effect of that code is the creation of a widget. 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 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"`. > The comm should be opened with a `target_name` of `"ipython.widget"`.
...@@ -22,7 +23,9 @@ The initial state update message looks like this: ...@@ -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: The initial state update must *at least* have the following fields:
......
...@@ -55,8 +55,22 @@ library ...@@ -55,8 +55,22 @@ library
-- Modules included in this library but not exported. -- Modules included in this library but not exported.
other-modules: IHaskell.Display.Widgets.Button 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.CheckBox
IHaskell.Display.Widgets.Bool.ToggleButton 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.Image
IHaskell.Display.Widgets.Output IHaskell.Display.Widgets.Output
IHaskell.Display.Widgets.Selection.Dropdown IHaskell.Display.Widgets.Selection.Dropdown
...@@ -86,6 +100,7 @@ library ...@@ -86,6 +100,7 @@ library
, vinyl >= 0.5 , vinyl >= 0.5
, vector -any , vector -any
, singletons >= 0.9.0 , singletons >= 0.9.0
, scientific -any
-- Waiting for the next release -- Waiting for the next release
, ihaskell -any , ihaskell -any
......
...@@ -2,9 +2,26 @@ module IHaskell.Display.Widgets (module X) where ...@@ -2,9 +2,26 @@ module IHaskell.Display.Widgets (module X) where
import IHaskell.Display.Widgets.Button as X 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.CheckBox as X
import IHaskell.Display.Widgets.Bool.ToggleButton 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.Image as X
import IHaskell.Display.Widgets.Output as X import IHaskell.Display.Widgets.Output as X
...@@ -21,4 +38,8 @@ import IHaskell.Display.Widgets.String.Text 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.String.TextArea as X
import IHaskell.Display.Widgets.Common 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 @@ ...@@ -5,14 +5,14 @@
module IHaskell.Display.Widgets.Bool.CheckBox ( module IHaskell.Display.Widgets.Bool.CheckBox (
-- * The CheckBox Widget -- * The CheckBox Widget
CheckBoxWidget, CheckBox,
-- * Constructor -- * Constructor
mkCheckBoxWidget) where mkCheckBox) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import Data.HashMap.Strict as HM import Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -26,12 +26,12 @@ import IHaskell.IPython.Message.UUID as U ...@@ -26,12 +26,12 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common import IHaskell.Display.Widgets.Common
-- | A 'CheckBoxWidget' represents a Checkbox widget from IPython.html.widgets. -- | A 'CheckBox' represents a Checkbox widget from IPython.html.widgets.
type CheckBoxWidget = IPythonWidget CheckBoxType type CheckBox = IPythonWidget CheckBoxType
-- | Create a new output widget -- | Create a new output widget
mkCheckBoxWidget :: IO CheckBoxWidget mkCheckBox :: IO CheckBox
mkCheckBoxWidget = do mkCheckBox = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
uuid <- U.random uuid <- U.random
...@@ -49,12 +49,12 @@ mkCheckBoxWidget = do ...@@ -49,12 +49,12 @@ mkCheckBoxWidget = do
-- Return the image widget -- Return the image widget
return widget return widget
instance IHaskellDisplay CheckBoxWidget where instance IHaskellDisplay CheckBox where
display b = do display b = do
widgetSendView b widgetSendView b
return $ Display [] return $ Display []
instance IHaskellWidget CheckBoxWidget where instance IHaskellWidget CheckBox where
getCommUUID = uuid getCommUUID = uuid
comm widget (Object dict1) _ = do comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text let key1 = "sync_data" :: Text
...@@ -62,3 +62,4 @@ instance IHaskellWidget CheckBoxWidget where ...@@ -62,3 +62,4 @@ instance IHaskellWidget CheckBoxWidget where
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Bool value) = HM.lookup key2 dict2 Just (Bool value) = HM.lookup key2 dict2
setField' widget SBoolValue value setField' widget SBoolValue value
triggerChange widget
...@@ -12,7 +12,7 @@ ToggleButton, ...@@ -12,7 +12,7 @@ ToggleButton,
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import Data.HashMap.Strict as HM import Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -67,3 +67,4 @@ instance IHaskellWidget ToggleButton where ...@@ -67,3 +67,4 @@ instance IHaskellWidget ToggleButton where
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Bool value) = HM.lookup key2 dict2 Just (Bool value) = HM.lookup key2 dict2
setField' widget SBoolValue value 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 ( ...@@ -7,9 +7,7 @@ module IHaskell.Display.Widgets.Button (
-- * The Button Widget -- * The Button Widget
Button, Button,
-- * Create a new button -- * Create a new button
mkButton, mkButton) where
-- * Click manipulation
triggerClick) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
...@@ -59,10 +57,6 @@ mkButton = do ...@@ -59,10 +57,6 @@ mkButton = do
-- Return the button widget -- Return the button widget
return button return button
-- | Artificially trigger a button click
triggerClick :: Button -> IO ()
triggerClick button = join $ getField button SClickHandler
instance IHaskellDisplay Button where instance IHaskellDisplay Button where
display b = do display b = do
widgetSendView b widgetSendView b
......
...@@ -6,22 +6,29 @@ ...@@ -6,22 +6,29 @@
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module IHaskell.Display.Widgets.Common where module IHaskell.Display.Widgets.Common where
import Data.Aeson import Data.Aeson
import Data.Aeson.Types (emptyObject)
import Data.Text (pack, Text) import Data.Text (pack, Text)
import Data.Singletons.TH import Data.Singletons.TH
import IHaskell.Display (IHaskellWidget)
import IHaskell.Eval.Widgets (widgetSendClose)
-- | Close a widget's comm
closeWidget :: IHaskellWidget w => w -> IO ()
closeWidget w = widgetSendClose w emptyObject
-- Widget properties -- Widget properties
singletons [d| singletons [d|
data Field = ModelModule data Field = ViewModule
| ModelName
| ViewModule
| ViewName | ViewName
| MsgThrottle | MsgThrottle
| Version | Version
| OnDisplayed | DisplayHandler
| Visible | Visible
| CSS | CSS
| DOMClasses | DOMClasses
...@@ -59,9 +66,43 @@ singletons [d| ...@@ -59,9 +66,43 @@ singletons [d|
| Icons | Icons
| SelectedLabels | SelectedLabels
| SelectedValues | SelectedValues
| IntValue
| StepInt
| MaxInt
| MinInt
| IntPairValue
| LowerInt
| UpperInt
| FloatValue
| StepFloat
| MaxFloat
| MinFloat
| FloatPairValue
| LowerFloat
| UpperFloat
| Orientation
| ShowRange
| ReadOut
| SliderColor
| BarStyle
| ChangeHandler
| Children
| OverflowX
| OverflowY
| BoxStyle
| Flex
| Pack
| Align
| Titles
| SelectedIndex
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
|] |]
newtype StrInt = StrInt Integer deriving (Num, Ord, Eq, Enum)
instance ToJSON StrInt where
toJSON (StrInt x) = toJSON . pack $ show x
-- | Pre-defined border styles -- | Pre-defined border styles
data BorderStyleValue = NoBorder data BorderStyleValue = NoBorder
| HiddenBorder | HiddenBorder
...@@ -142,6 +183,20 @@ instance ToJSON ButtonStyleValue where ...@@ -142,6 +183,20 @@ instance ToJSON ButtonStyleValue where
toJSON DangerButton = "danger" toJSON DangerButton = "danger"
toJSON DefaultButton = "" toJSON DefaultButton = ""
-- | Pre-defined bar styles
data BarStyleValue = SuccessBar
| InfoBar
| WarningBar
| DangerBar
| DefaultBar
instance ToJSON BarStyleValue where
toJSON SuccessBar = "success"
toJSON InfoBar = "info"
toJSON WarningBar = "warning"
toJSON DangerBar = "danger"
toJSON DefaultBar = ""
-- | Image formats for ImageWidget -- | Image formats for ImageWidget
data ImageFormatValue = PNG data ImageFormatValue = PNG
| SVG | SVG
...@@ -159,5 +214,53 @@ instance ToJSON ImageFormatValue where ...@@ -159,5 +214,53 @@ instance ToJSON ImageFormatValue where
-- | Options for selection widgets. -- | Options for selection widgets.
data SelectionOptions = OptionLabels [Text] | OptionDict [(Text, Text)] data SelectionOptions = OptionLabels [Text] | OptionDict [(Text, Text)]
-- | Orientation values.
data OrientationValue = HorizontalOrientation
| VerticalOrientation
instance ToJSON OrientationValue where
toJSON HorizontalOrientation = "horizontal"
toJSON VerticalOrientation = "vertical"
data OverflowValue = VisibleOverflow
| HiddenOverflow
| ScrollOverflow
| AutoOverflow
| InitialOverflow
| InheritOverflow
| DefaultOverflow
instance ToJSON OverflowValue where
toJSON VisibleOverflow = "visible"
toJSON HiddenOverflow = "hidden"
toJSON ScrollOverflow = "scroll"
toJSON AutoOverflow = "auto"
toJSON InitialOverflow = "initial"
toJSON InheritOverflow = "inherit"
toJSON DefaultOverflow = ""
data BoxStyleValue = SuccessBox
| InfoBox
| WarningBox
| DangerBox
| DefaultBox
instance ToJSON BoxStyleValue where
toJSON SuccessBox = "success"
toJSON InfoBox = "info"
toJSON WarningBox = "warning"
toJSON DangerBox = "danger"
toJSON DefaultBox = ""
data LocationValue = StartLocation
| CenterLocation
| EndLocation
| BaselineLocation
| StretchLocation
instance ToJSON LocationValue where
toJSON StartLocation = "start"
toJSON CenterLocation = "center"
toJSON EndLocation = "end"
toJSON BaselineLocation = "baseline"
toJSON StretchLocation = "stretch"
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.BoundedFloat.BoundedFloatText (
-- * The BoundedFloatText
-- Widget
BoundedFloatText,
-- * Constructor
mkBoundedFloatText) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join, void)
import Data.Aeson
import qualified 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
-- | 'BoundedFloatText' represents an BoundedFloatText widget from IPython.html.widgets.
type BoundedFloatText = IPythonWidget BoundedFloatTextType
-- | Create a new widget
mkBoundedFloatText :: IO BoundedFloatText
mkBoundedFloatText = do
-- Default properties, with a random uuid
uuid <- U.random
let widgetState = WidgetState $ defaultBoundedFloatWidget "FloatTextView"
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
-- Return the widget
return widget
instance IHaskellDisplay BoundedFloatText where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget BoundedFloatText where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget SFloatValue (Sci.toRealFloat value)
triggerChange widget
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.BoundedFloat.FloatProgress (
-- * The FloatProgress Widget
FloatProgress,
-- * Constructor
mkFloatProgress) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Exception (throw, ArithException(LossOfPrecision))
import Control.Monad (when, join)
import Data.Aeson
import qualified 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
-- | 'FloatProgress' represents an FloatProgress widget from IPython.html.widgets.
type FloatProgress = IPythonWidget FloatProgressType
-- | Create a new widget
mkFloatProgress :: IO FloatProgress
mkFloatProgress = do
-- Default properties, with a random uuid
uuid <- U.random
let boundedFloatAttrs = defaultBoundedFloatWidget "ProgressView"
progressAttrs = (SBarStyle =:: DefaultBar) :& RNil
widgetState = WidgetState $ boundedFloatAttrs <+> progressAttrs
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
-- Return the widget
return widget
instance IHaskellDisplay FloatProgress where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget FloatProgress where
getCommUUID = uuid
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider (
-- * The FloatSlider Widget
FloatSlider,
-- * Constructor
mkFloatSlider) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join, void)
import Data.Aeson
import qualified 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
-- | 'FloatSlider' represents an FloatSlider widget from IPython.html.widgets.
type FloatSlider = IPythonWidget FloatSliderType
-- | Create a new widget
mkFloatSlider :: IO FloatSlider
mkFloatSlider = do
-- Default properties, with a random uuid
uuid <- U.random
let boundedFloatAttrs = defaultBoundedFloatWidget "FloatSliderView"
sliderAttrs = (SOrientation =:: HorizontalOrientation)
:& (SShowRange =:: False)
:& (SReadOut =:: True)
:& (SSliderColor =:: "")
:& RNil
widgetState = WidgetState $ boundedFloatAttrs <+> sliderAttrs
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
-- Return the widget
return widget
instance IHaskellDisplay FloatSlider where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget FloatSlider where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget SFloatValue (Sci.toRealFloat value)
triggerChange widget
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider (
-- * The FloatRangeSlider
-- Widget
FloatRangeSlider,
-- * Constructor
mkFloatRangeSlider) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Exception (throw, ArithException(LossOfPrecision))
import Control.Monad (when, join, void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import qualified Data.Vector as V
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
-- | 'FloatRangeSlider' represents an FloatRangeSlider widget from IPython.html.widgets.
type FloatRangeSlider = IPythonWidget FloatRangeSliderType
-- | Create a new widget
mkFloatRangeSlider :: IO FloatRangeSlider
mkFloatRangeSlider = do
-- Default properties, with a random uuid
uuid <- U.random
let boundedFloatAttrs = defaultBoundedFloatRangeWidget "FloatSliderView"
sliderAttrs = (SOrientation =:: HorizontalOrientation)
:& (SShowRange =:: True)
:& (SReadOut =:: True)
:& (SSliderColor =:: "")
:& RNil
widgetState = WidgetState $ boundedFloatAttrs <+> sliderAttrs
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
-- Return the widget
return widget
instance IHaskellDisplay FloatRangeSlider where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget FloatRangeSlider where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Array values) = HM.lookup key2 dict2
[x, y] = map (\(Number x) -> Sci.toRealFloat x) $ V.toList values
setField' widget SFloatPairValue (x, y)
triggerChange widget
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Float.FloatText (
-- * The FloatText Widget
FloatText,
-- * Constructor
mkFloatText) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join, void)
import Data.Aeson
import qualified 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
-- | 'FloatText' represents an FloatText widget from IPython.html.widgets.
type FloatText = IPythonWidget FloatTextType
-- | Create a new widget
mkFloatText :: IO FloatText
mkFloatText = do
-- Default properties, with a random uuid
uuid <- U.random
let widgetState = WidgetState $ defaultFloatWidget "FloatTextView"
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
-- Return the widget
return widget
instance IHaskellDisplay FloatText where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget FloatText where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget SFloatValue (Sci.toRealFloat value)
triggerChange widget
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText (
-- * The BoundedIntText Widget
BoundedIntText,
-- * Constructor
mkBoundedIntText) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join, void)
import Data.Aeson
import qualified 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
-- | 'BoundedIntText' represents an BoundedIntText widget from IPython.html.widgets.
type BoundedIntText = IPythonWidget BoundedIntTextType
-- | Create a new widget
mkBoundedIntText :: IO BoundedIntText
mkBoundedIntText = do
-- Default properties, with a random uuid
uuid <- U.random
let widgetState = WidgetState $ defaultBoundedIntWidget "IntTextView"
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
-- Return the widget
return widget
instance IHaskellDisplay BoundedIntText where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget BoundedIntText where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget SIntValue (Sci.coefficient value)
triggerChange widget
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.BoundedInt.IntProgress (
-- * The IntProgress Widget
IntProgress,
-- * Constructor
mkIntProgress) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Exception (throw, ArithException(LossOfPrecision))
import Control.Monad (when, join)
import Data.Aeson
import qualified 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
-- | 'IntProgress' represents an IntProgress widget from IPython.html.widgets.
type IntProgress = IPythonWidget IntProgressType
-- | Create a new widget
mkIntProgress :: IO IntProgress
mkIntProgress = do
-- Default properties, with a random uuid
uuid <- U.random
let boundedIntAttrs = defaultBoundedIntWidget "ProgressView"
progressAttrs = (SBarStyle =:: DefaultBar) :& RNil
widgetState = WidgetState $ boundedIntAttrs <+> progressAttrs
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
-- Return the widget
return widget
instance IHaskellDisplay IntProgress where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget IntProgress where
getCommUUID = uuid
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.BoundedInt.IntSlider (
-- * The IntSlider Widget
IntSlider,
-- * Constructor
mkIntSlider) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join, void)
import Data.Aeson
import qualified 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
-- | 'IntSlider' represents an IntSlider widget from IPython.html.widgets.
type IntSlider = IPythonWidget IntSliderType
-- | Create a new widget
mkIntSlider :: IO IntSlider
mkIntSlider = do
-- Default properties, with a random uuid
uuid <- U.random
let boundedIntAttrs = defaultBoundedIntWidget "IntSliderView"
sliderAttrs = (SOrientation =:: HorizontalOrientation)
:& (SShowRange =:: False)
:& (SReadOut =:: True)
:& (SSliderColor =:: "")
:& RNil
widgetState = WidgetState $ boundedIntAttrs <+> sliderAttrs
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
-- Return the widget
return widget
instance IHaskellDisplay IntSlider where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget IntSlider where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget SIntValue (Sci.coefficient value)
triggerChange widget
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider (
-- * The IntRangeSlider Widget
IntRangeSlider,
-- * Constructor
mkIntRangeSlider) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join, void)
import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef)
import qualified Data.Scientific as Sci
import Data.Text (Text)
import qualified Data.Vector as V
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
-- | 'IntRangeSlider' represents an IntRangeSlider widget from IPython.html.widgets.
type IntRangeSlider = IPythonWidget IntRangeSliderType
-- | Create a new widget
mkIntRangeSlider :: IO IntRangeSlider
mkIntRangeSlider = do
-- Default properties, with a random uuid
uuid <- U.random
let boundedIntAttrs = defaultBoundedIntRangeWidget "IntSliderView"
sliderAttrs = (SOrientation =:: HorizontalOrientation)
:& (SShowRange =:: True)
:& (SReadOut =:: True)
:& (SSliderColor =:: "")
:& RNil
widgetState = WidgetState $ boundedIntAttrs <+> sliderAttrs
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
-- Return the widget
return widget
instance IHaskellDisplay IntRangeSlider where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget IntRangeSlider where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Array values) = HM.lookup key2 dict2
[x, y] = map (\(Number x) -> Sci.coefficient x) $ V.toList values
setField' widget SIntPairValue (x, y)
triggerChange widget
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeSynonymInstances #-}
module IHaskell.Display.Widgets.Int.IntText (
-- * The IntText Widget
IntText,
-- * Constructor
mkIntText) where
-- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude
import Control.Monad (when, join, void)
import Data.Aeson
import qualified 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
-- | 'IntText' represents an IntText widget from IPython.html.widgets.
type IntText = IPythonWidget IntTextType
-- | Create a new widget
mkIntText :: IO IntText
mkIntText = do
-- Default properties, with a random uuid
uuid <- U.random
let widgetState = WidgetState $ defaultIntWidget "IntTextView"
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
-- Return the widget
return widget
instance IHaskellDisplay IntText where
display b = do
widgetSendView b
return $ Display []
instance IHaskellWidget IntText where
getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2
setField' widget SIntValue (Sci.coefficient value)
triggerChange widget
...@@ -12,7 +12,7 @@ Dropdown, ...@@ -12,7 +12,7 @@ Dropdown,
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -50,10 +50,6 @@ mkDropdown = do ...@@ -50,10 +50,6 @@ mkDropdown = do
-- Return the widget -- Return the widget
return widget return widget
-- | Artificially trigger a selection
triggerSelection :: Dropdown -> IO ()
triggerSelection widget = join $ getField widget SSelectionHandler
instance IHaskellDisplay Dropdown where instance IHaskellDisplay Dropdown where
display b = do display b = do
widgetSendView b widgetSendView b
...@@ -68,13 +64,13 @@ instance IHaskellWidget Dropdown where ...@@ -68,13 +64,13 @@ instance IHaskellWidget Dropdown where
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue label setField' widget SSelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue value setField' widget SSelectedValue value
triggerSelection widget triggerSelection widget
...@@ -12,7 +12,7 @@ RadioButtons, ...@@ -12,7 +12,7 @@ RadioButtons,
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -48,10 +48,6 @@ mkRadioButtons = do ...@@ -48,10 +48,6 @@ mkRadioButtons = do
-- Return the widget -- Return the widget
return widget return widget
-- | Artificially trigger a selection
triggerSelection :: RadioButtons -> IO ()
triggerSelection widget = join $ getField widget SSelectionHandler
instance IHaskellDisplay RadioButtons where instance IHaskellDisplay RadioButtons where
display b = do display b = do
widgetSendView b widgetSendView b
...@@ -66,13 +62,13 @@ instance IHaskellWidget RadioButtons where ...@@ -66,13 +62,13 @@ instance IHaskellWidget RadioButtons where
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue label setField' widget SSelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue value setField' widget SSelectedValue value
triggerSelection widget triggerSelection widget
...@@ -5,14 +5,14 @@ ...@@ -5,14 +5,14 @@
module IHaskell.Display.Widgets.Selection.Select ( module IHaskell.Display.Widgets.Selection.Select (
-- * The Select Widget -- * The Select Widget
SelectWidget, Select,
-- * Constructor -- * Constructor
mkSelectWidget) where mkSelect) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -26,12 +26,12 @@ import IHaskell.IPython.Message.UUID as U ...@@ -26,12 +26,12 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common import IHaskell.Display.Widgets.Common
-- | A 'SelectWidget' represents a Select widget from IPython.html.widgets. -- | A 'Select' represents a Select widget from IPython.html.widgets.
type SelectWidget = IPythonWidget SelectType type Select = IPythonWidget SelectType
-- | Create a new Select widget -- | Create a new Select widget
mkSelectWidget :: IO SelectWidget mkSelect :: IO Select
mkSelectWidget = do mkSelect = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
uuid <- U.random uuid <- U.random
let widgetState = WidgetState $ defaultSelectionWidget "SelectView" let widgetState = WidgetState $ defaultSelectionWidget "SelectView"
...@@ -47,16 +47,12 @@ mkSelectWidget = do ...@@ -47,16 +47,12 @@ mkSelectWidget = do
-- Return the widget -- Return the widget
return widget return widget
-- | Artificially trigger a selection instance IHaskellDisplay Select where
triggerSelection :: SelectWidget -> IO ()
triggerSelection widget = join $ getField widget SSelectionHandler
instance IHaskellDisplay SelectWidget where
display b = do display b = do
widgetSendView b widgetSendView b
return $ Display [] return $ Display []
instance IHaskellWidget SelectWidget where instance IHaskellWidget Select where
getCommUUID = uuid getCommUUID = uuid
comm widget (Object dict1) _ = do comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text let key1 = "sync_data" :: Text
...@@ -65,13 +61,13 @@ instance IHaskellWidget SelectWidget where ...@@ -65,13 +61,13 @@ instance IHaskellWidget SelectWidget where
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue label setField' widget SSelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue value setField' widget SSelectedValue value
triggerSelection widget triggerSelection widget
...@@ -5,14 +5,14 @@ ...@@ -5,14 +5,14 @@
module IHaskell.Display.Widgets.Selection.SelectMultiple ( module IHaskell.Display.Widgets.Selection.SelectMultiple (
-- * The SelectMultiple Widget -- * The SelectMultiple Widget
SelectMultipleWidget, SelectMultiple,
-- * Constructor -- * Constructor
mkSelectMultipleWidget) where mkSelectMultiple) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (fmap, join, sequence) import Control.Monad (fmap, join, sequence, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -27,12 +27,12 @@ import IHaskell.IPython.Message.UUID as U ...@@ -27,12 +27,12 @@ import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common import IHaskell.Display.Widgets.Common
-- | A 'SelectMultipleWidget' represents a SelectMultiple widget from IPython.html.widgets. -- | A 'SelectMultiple' represents a SelectMultiple widget from IPython.html.widgets.
type SelectMultipleWidget = IPythonWidget SelectMultipleType type SelectMultiple = IPythonWidget SelectMultipleType
-- | Create a new SelectMultiple widget -- | Create a new SelectMultiple widget
mkSelectMultipleWidget :: IO SelectMultipleWidget mkSelectMultiple :: IO SelectMultiple
mkSelectMultipleWidget = do mkSelectMultiple = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
uuid <- U.random uuid <- U.random
let widgetState = WidgetState $ defaultMultipleSelectionWidget "SelectMultipleView" let widgetState = WidgetState $ defaultMultipleSelectionWidget "SelectMultipleView"
...@@ -51,16 +51,12 @@ mkSelectMultipleWidget = do ...@@ -51,16 +51,12 @@ mkSelectMultipleWidget = do
-- Return the widget -- Return the widget
return widget return widget
-- | Artificially trigger a selection instance IHaskellDisplay SelectMultiple where
triggerSelection :: SelectMultipleWidget -> IO ()
triggerSelection widget = join $ getField widget SSelectionHandler
instance IHaskellDisplay SelectMultipleWidget where
display b = do display b = do
widgetSendView b widgetSendView b
return $ Display [] return $ Display []
instance IHaskellWidget SelectMultipleWidget where instance IHaskellWidget SelectMultiple where
getCommUUID = uuid getCommUUID = uuid
comm widget (Object dict1) _ = do comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text let key1 = "sync_data" :: Text
...@@ -70,13 +66,13 @@ instance IHaskellWidget SelectMultipleWidget where ...@@ -70,13 +66,13 @@ instance IHaskellWidget SelectMultipleWidget where
labelList = map (\(String x) -> x) $ V.toList labels labelList = map (\(String x) -> x) $ V.toList labels
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabels labelList setField' widget SSelectedLabels labelList
setField' widget SSelectedValues labelList setField' widget SSelectedValues labelList
OptionDict ps -> OptionDict ps ->
case sequence $ map (`lookup` ps) labelList of case sequence $ map (`lookup` ps) labelList of
Nothing -> return () Nothing -> return ()
Just valueList -> do Just valueList -> void $ do
setField' widget SSelectedLabels labelList setField' widget SSelectedLabels labelList
setField' widget SSelectedValues valueList setField' widget SSelectedValues valueList
triggerSelection widget triggerSelection widget
...@@ -12,7 +12,7 @@ ToggleButtons, ...@@ -12,7 +12,7 @@ ToggleButtons,
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -55,10 +55,6 @@ mkToggleButtons = do ...@@ -55,10 +55,6 @@ mkToggleButtons = do
-- Return the widget -- Return the widget
return widget return widget
-- | Artificially trigger a selection
triggerSelection :: ToggleButtons -> IO ()
triggerSelection widget = join $ getField widget SSelectionHandler
instance IHaskellDisplay ToggleButtons where instance IHaskellDisplay ToggleButtons where
display b = do display b = do
widgetSendView b widgetSendView b
...@@ -73,13 +69,13 @@ instance IHaskellWidget ToggleButtons where ...@@ -73,13 +69,13 @@ instance IHaskellWidget ToggleButtons where
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue label setField' widget SSelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue value setField' widget SSelectedValue value
triggerSelection widget triggerSelection widget
...@@ -7,9 +7,7 @@ module IHaskell.Display.Widgets.String.Text ( ...@@ -7,9 +7,7 @@ module IHaskell.Display.Widgets.String.Text (
-- * The Text Widget -- * The Text Widget
TextWidget, TextWidget,
-- * Constructor -- * Constructor
mkTextWidget, mkTextWidget) where
-- * Submit handling
triggerSubmit) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
...@@ -37,7 +35,7 @@ mkTextWidget = do ...@@ -37,7 +35,7 @@ mkTextWidget = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
uuid <- U.random uuid <- U.random
let strWidget = defaultStringWidget "TextView" let strWidget = defaultStringWidget "TextView"
txtWidget = (SSubmitHandler =:: return ()) :& RNil txtWidget = (SSubmitHandler =:: return ()) :& (SChangeHandler =:: return ()) :& RNil
widgetState = WidgetState $ strWidget <+> txtWidget widgetState = WidgetState $ strWidget <+> txtWidget
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
...@@ -51,9 +49,6 @@ mkTextWidget = do ...@@ -51,9 +49,6 @@ mkTextWidget = do
-- Return the widget -- Return the widget
return widget return widget
triggerSubmit :: TextWidget -> IO ()
triggerSubmit tw = join $ getField tw SSubmitHandler
instance IHaskellDisplay TextWidget where instance IHaskellDisplay TextWidget where
display b = do display b = do
widgetSendView b widgetSendView b
...@@ -66,7 +61,7 @@ instance IHaskellWidget TextWidget where ...@@ -66,7 +61,7 @@ instance IHaskellWidget TextWidget where
case Map.lookup "sync_data" dict1 of case Map.lookup "sync_data" dict1 of
Just (Object dict2) -> Just (Object dict2) ->
case Map.lookup "value" dict2 of case Map.lookup "value" dict2 of
Just (String val) -> setField' tw SStringValue val Just (String val) -> setField' tw SStringValue val >> triggerChange tw
Nothing -> return () Nothing -> return ()
Nothing -> Nothing ->
case Map.lookup "content" dict1 of case Map.lookup "content" dict1 of
......
...@@ -5,15 +5,16 @@ ...@@ -5,15 +5,16 @@
module IHaskell.Display.Widgets.String.TextArea ( module IHaskell.Display.Widgets.String.TextArea (
-- * The TextArea Widget -- * The TextArea Widget
TextAreaWidget, TextArea,
-- * Constructor -- * Constructor
mkTextAreaWidget) where mkTextArea) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
import Data.Text (Text) import Data.Text (Text)
import Data.Vinyl (Rec(..), (<+>)) import Data.Vinyl (Rec(..), (<+>))
...@@ -23,16 +24,19 @@ import IHaskell.Eval.Widgets ...@@ -23,16 +24,19 @@ import IHaskell.Eval.Widgets
import IHaskell.IPython.Message.UUID as U import IHaskell.IPython.Message.UUID as U
import IHaskell.Display.Widgets.Types import IHaskell.Display.Widgets.Types
import IHaskell.Display.Widgets.Common
-- | A 'TextAreaWidget' represents a Textarea widget from IPython.html.widgets. -- | A 'TextArea' represents a Textarea widget from IPython.html.widgets.
type TextAreaWidget = IPythonWidget TextAreaType type TextArea = IPythonWidget TextAreaType
-- | Create a new TextArea widget -- | Create a new TextArea widget
mkTextAreaWidget :: IO TextAreaWidget mkTextArea :: IO TextArea
mkTextAreaWidget = do mkTextArea = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
uuid <- U.random uuid <- U.random
let widgetState = WidgetState $ defaultStringWidget "TextareaView" let strAttrs = defaultStringWidget "TextareaView"
wgtAttrs = (SChangeHandler =:: return ()) :& RNil
widgetState = WidgetState $ strAttrs <+> wgtAttrs
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
...@@ -46,10 +50,17 @@ mkTextAreaWidget = do ...@@ -46,10 +50,17 @@ mkTextAreaWidget = do
-- Return the widget -- Return the widget
return widget return widget
instance IHaskellDisplay TextAreaWidget where instance IHaskellDisplay TextArea where
display b = do display b = do
widgetSendView b widgetSendView b
return $ Display [] return $ Display []
instance IHaskellWidget TextAreaWidget where instance IHaskellWidget TextArea where
getCommUUID = uuid getCommUUID = uuid
comm widget (Object dict1) _ = do
let key1 = "sync_data" :: Text
key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1
Just (String value) = HM.lookup key2 dict2
setField' widget SStringValue value
triggerChange widget
...@@ -11,6 +11,7 @@ ...@@ -11,6 +11,7 @@
{-# LANGUAGE TypeSynonymInstances #-} {-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE BangPatterns #-} {-# LANGUAGE BangPatterns #-}
{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE ExistentialQuantification #-}
module IHaskell.Display.Widgets.Types where module IHaskell.Display.Widgets.Types where
-- | This module houses all the type-trickery needed to make widgets happen. -- | This module houses all the type-trickery needed to make widgets happen.
...@@ -36,30 +37,38 @@ module IHaskell.Display.Widgets.Types where ...@@ -36,30 +37,38 @@ module IHaskell.Display.Widgets.Types where
-- is a type present in the type-level list @ts@. Thus a 'WidgetState' is essentially a list of field -- is a type present in the type-level list @ts@. Thus a 'WidgetState' is essentially a list of field
-- properties wrapped together with the corresponding promoted Field type. See ('=::') for more. -- properties wrapped together with the corresponding promoted Field type. See ('=::') for more.
-- --
-- The properties function can be used to view all the @Field@s associated with a widget object.
--
-- Attributes are represented by the @Attr@ data type, which holds the value of a field, along with
-- the actual @Field@ object and a function to verify validity of changes to the value.
--
-- The IPython widgets expect state updates of the form {"property": value}, where an empty string for -- The IPython widgets expect state updates of the form {"property": value}, where an empty string for
-- numeric values is ignored by the frontend and the default value is used instead. -- numeric values is ignored by the frontend and the default value is used instead. Some numbers need to
-- be sent as numbers (represented by @Integer@), whereas some need to be sent as Strings (@StrInt@).
--
-- Child widgets are expected to be sent as strings of the form "IPY_MODEL_<uuid>", where @<uuid>@
-- represents the uuid of the widget's comm.
-- --
-- To know more about the IPython messaging specification (as implemented in this package) take a look -- To know more about the IPython messaging specification (as implemented in this package) take a look
-- at the supplied MsgSpec.md. -- at the supplied MsgSpec.md.
import Control.Monad (when) import Control.Monad (unless, join)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import qualified Control.Exception as Ex
import Data.Aeson import Data.Aeson
import Data.Aeson.Types (emptyObject, Pair) import Data.Aeson.Types (Pair)
import Data.Text (pack, Text)
import Data.IORef (IORef, readIORef, modifyIORef) import Data.IORef (IORef, readIORef, modifyIORef)
import Data.Text (Text, pack)
import Data.Vinyl (Rec (..), (<+>), recordToList, reifyConstraint, rmap, Dict (..)) import Data.Vinyl (Rec (..), (<+>), recordToList, reifyConstraint, rmap, Dict (..))
import Data.Vinyl.Functor (Compose (..), Const (..)) import Data.Vinyl.Functor (Compose (..), Const (..))
import Data.Vinyl.Lens (rget, rput, type ()) import Data.Vinyl.Lens (rget, rput, type ())
import Data.Vinyl.TypeLevel (RecAll (..)) import Data.Vinyl.TypeLevel (RecAll)
import Data.Singletons.Prelude ((:++)) import Data.Singletons.Prelude ((:++))
import Data.Singletons.TH import Data.Singletons.TH
import Numeric.Natural
import IHaskell.Eval.Widgets (widgetSendUpdate) import IHaskell.Eval.Widgets (widgetSendUpdate)
import IHaskell.Display (Base64, IHaskellWidget (..)) import IHaskell.Display (Base64, IHaskellWidget (..))
import IHaskell.IPython.Message.UUID import IHaskell.IPython.Message.UUID
...@@ -67,44 +76,52 @@ import IHaskell.IPython.Message.UUID ...@@ -67,44 +76,52 @@ import IHaskell.IPython.Message.UUID
import IHaskell.Display.Widgets.Common import IHaskell.Display.Widgets.Common
-- Classes from IPython's widget hierarchy. Defined as such to reduce code duplication. -- Classes from IPython's widget hierarchy. Defined as such to reduce code duplication.
type WidgetClass = '[ModelModule, ModelName, ViewModule, ViewName, MsgThrottle, Version, OnDisplayed] type WidgetClass = '[ViewModule, ViewName, MsgThrottle, Version, DisplayHandler]
type DOMWidgetClass = WidgetClass :++ type DOMWidgetClass = WidgetClass :++
'[ Visible, CSS, DOMClasses, Width, Height, Padding, Margin, Color '[ Visible, CSS, DOMClasses, Width, Height, Padding, Margin, Color
, BackgroundColor, BorderColor, BorderWidth, BorderRadius, BorderStyle, FontStyle , BackgroundColor, BorderColor, BorderWidth, BorderRadius, BorderStyle, FontStyle
, FontWeight, FontSize, FontFamily , FontWeight, FontSize, FontFamily
] ]
type StringClass = DOMWidgetClass :++ '[StringValue, Disabled, Description, Placeholder] type StringClass = DOMWidgetClass :++ '[StringValue, Disabled, Description, Placeholder]
type BoolClass = DOMWidgetClass :++ '[BoolValue, Disabled, Description] type BoolClass = DOMWidgetClass :++ '[BoolValue, Disabled, Description, ChangeHandler]
type SelectionClass = DOMWidgetClass :++ type SelectionClass = DOMWidgetClass :++
'[Options, SelectedValue, SelectedLabel, Disabled, Description, SelectionHandler] '[Options, SelectedValue, SelectedLabel, Disabled, Description, SelectionHandler]
type MultipleSelectionClass = DOMWidgetClass :++ type MultipleSelectionClass = DOMWidgetClass :++
'[Options, SelectedLabels, SelectedValues, Disabled, Description, SelectionHandler] '[Options, SelectedLabels, SelectedValues, Disabled, Description, SelectionHandler]
type IntClass = DOMWidgetClass :++ '[IntValue, Disabled, Description, ChangeHandler]
type BoundedIntClass = IntClass :++ '[StepInt, MinInt, MaxInt]
type IntRangeClass = IntClass :++ '[IntPairValue, LowerInt, UpperInt]
type BoundedIntRangeClass = IntRangeClass :++ '[StepInt, MinInt, MaxInt]
type FloatClass = DOMWidgetClass :++ '[FloatValue, Disabled, Description, ChangeHandler]
type BoundedFloatClass = FloatClass :++ '[StepFloat, MinFloat, MaxFloat]
type FloatRangeClass = FloatClass :++ '[FloatPairValue, LowerFloat, UpperFloat]
type BoundedFloatRangeClass = FloatRangeClass :++ '[StepFloat, MinFloat, MaxFloat]
type BoxClass = DOMWidgetClass :++ '[Children, OverflowX, OverflowY, BoxStyle]
type SelectionContainerClass = BoxClass :++ '[Titles, SelectedIndex, ChangeHandler]
-- Types associated with Fields. -- Types associated with Fields.
type family FieldType (f :: Field) :: * where type family FieldType (f :: Field) :: * where
FieldType ModelModule = Text
FieldType ModelName = Text
FieldType ViewModule = Text FieldType ViewModule = Text
FieldType ViewName = Text FieldType ViewName = Text
FieldType MsgThrottle = Natural FieldType MsgThrottle = Integer
FieldType Version = Natural FieldType Version = Integer
FieldType OnDisplayed = IO () FieldType DisplayHandler = IO ()
FieldType Visible = Bool FieldType Visible = Bool
FieldType CSS = [(Text, Text, Text)] FieldType CSS = [(Text, Text, Text)]
FieldType DOMClasses = [Text] FieldType DOMClasses = [Text]
FieldType Width = Natural FieldType Width = StrInt
FieldType Height = Natural FieldType Height = StrInt
FieldType Padding = Natural FieldType Padding = StrInt
FieldType Margin = Natural FieldType Margin = StrInt
FieldType Color = Text FieldType Color = Text
FieldType BackgroundColor = Text FieldType BackgroundColor = Text
FieldType BorderColor = Text FieldType BorderColor = Text
FieldType BorderWidth = Natural FieldType BorderWidth = StrInt
FieldType BorderRadius = Natural FieldType BorderRadius = StrInt
FieldType BorderStyle = BorderStyleValue FieldType BorderStyle = BorderStyleValue
FieldType FontStyle = FontStyleValue FieldType FontStyle = FontStyleValue
FieldType FontWeight = FontWeightValue FieldType FontWeight = FontWeightValue
FieldType FontSize = Natural FieldType FontSize = StrInt
FieldType FontFamily = Text FieldType FontFamily = Text
FieldType Description = Text FieldType Description = Text
FieldType ClickHandler = IO () FieldType ClickHandler = IO ()
...@@ -126,6 +143,60 @@ type family FieldType (f :: Field) :: * where ...@@ -126,6 +143,60 @@ type family FieldType (f :: Field) :: * where
FieldType Icons = [Text] FieldType Icons = [Text]
FieldType SelectedLabels = [Text] FieldType SelectedLabels = [Text]
FieldType SelectedValues = [Text] FieldType SelectedValues = [Text]
FieldType IntValue = Integer
FieldType StepInt = Integer
FieldType MinInt = Integer
FieldType MaxInt = Integer
FieldType LowerInt = Integer
FieldType UpperInt = Integer
FieldType IntPairValue = (Integer, Integer)
FieldType Orientation = OrientationValue
FieldType ShowRange = Bool
FieldType ReadOut = Bool
FieldType SliderColor = Text
FieldType BarStyle = BarStyleValue
FieldType FloatValue = Double
FieldType StepFloat = Double
FieldType MinFloat = Double
FieldType MaxFloat = Double
FieldType LowerFloat = Double
FieldType UpperFloat = Double
FieldType FloatPairValue = (Double, Double)
FieldType ChangeHandler = IO ()
FieldType Children = [ChildWidget]
FieldType OverflowX = OverflowValue
FieldType OverflowY = OverflowValue
FieldType BoxStyle = BoxStyleValue
FieldType Flex = Int
FieldType Pack = LocationValue
FieldType Align = LocationValue
FieldType Titles = [Text]
FieldType SelectedIndex = Integer
-- | Can be used to put different widgets in a list. Useful for dealing with children widgets.
data ChildWidget = forall w. RecAll Attr (WidgetFields w) ToPairs => ChildWidget (IPythonWidget w)
instance ToJSON ChildWidget where
toJSON (ChildWidget x) = toJSON . pack $ "IPY_MODEL_" ++ uuidToString (uuid x)
-- Will use a custom class rather than a newtype wrapper with an orphan instance. The main issue is
-- the need of a Bounded instance for Float / Double.
class CustomBounded a where
lowerBound :: a
upperBound :: a
-- Set according to what IPython widgets use
instance CustomBounded StrInt where
upperBound = 10 ^ 16 - 1
lowerBound = - (10 ^ 16 - 1)
instance CustomBounded Integer where
lowerBound = - (10 ^ 16 - 1)
upperBound = 10 ^ 16 - 1
instance CustomBounded Double where
lowerBound = - (10 ** 16 - 1)
upperBound = 10 ** 16 - 1
-- Different types of widgets. Every widget in IPython has a corresponding WidgetType -- Different types of widgets. Every widget in IPython has a corresponding WidgetType
data WidgetType = ButtonType data WidgetType = ButtonType
...@@ -142,6 +213,20 @@ data WidgetType = ButtonType ...@@ -142,6 +213,20 @@ data WidgetType = ButtonType
| SelectType | SelectType
| ToggleButtonsType | ToggleButtonsType
| SelectMultipleType | SelectMultipleType
| IntTextType
| BoundedIntTextType
| IntSliderType
| IntProgressType
| IntRangeSliderType
| FloatTextType
| BoundedFloatTextType
| FloatSliderType
| FloatProgressType
| FloatRangeSliderType
| BoxType
| FlexBoxType
| AccordionType
| TabType
-- Fields associated with a widget -- Fields associated with a widget
type family WidgetFields (w :: WidgetType) :: [Field] where type family WidgetFields (w :: WidgetType) :: [Field] where
...@@ -150,8 +235,8 @@ type family WidgetFields (w :: WidgetType) :: [Field] where ...@@ -150,8 +235,8 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
WidgetFields OutputType = DOMWidgetClass WidgetFields OutputType = DOMWidgetClass
WidgetFields HTMLType = StringClass WidgetFields HTMLType = StringClass
WidgetFields LatexType = StringClass WidgetFields LatexType = StringClass
WidgetFields TextType = StringClass :++ '[SubmitHandler] WidgetFields TextType = StringClass :++ '[SubmitHandler, ChangeHandler]
WidgetFields TextAreaType = StringClass WidgetFields TextAreaType = StringClass :++ '[ChangeHandler]
WidgetFields CheckBoxType = BoolClass WidgetFields CheckBoxType = BoolClass
WidgetFields ToggleButtonType = BoolClass :++ '[Tooltip, Icon, ButtonStyle] WidgetFields ToggleButtonType = BoolClass :++ '[Tooltip, Icon, ButtonStyle]
WidgetFields DropdownType = SelectionClass :++ '[ButtonStyle] WidgetFields DropdownType = SelectionClass :++ '[ButtonStyle]
...@@ -159,77 +244,158 @@ type family WidgetFields (w :: WidgetType) :: [Field] where ...@@ -159,77 +244,158 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
WidgetFields SelectType = SelectionClass WidgetFields SelectType = SelectionClass
WidgetFields ToggleButtonsType = SelectionClass :++ '[Tooltips, Icons, ButtonStyle] WidgetFields ToggleButtonsType = SelectionClass :++ '[Tooltips, Icons, ButtonStyle]
WidgetFields SelectMultipleType = MultipleSelectionClass WidgetFields SelectMultipleType = MultipleSelectionClass
WidgetFields IntTextType = IntClass
-- Wrapper around a field WidgetFields BoundedIntTextType = BoundedIntClass
newtype Attr (f :: Field) = Attr { _unAttr :: FieldType f } WidgetFields IntSliderType = BoundedIntClass :++ '[Orientation, ShowRange, ReadOut, SliderColor]
WidgetFields IntProgressType = BoundedIntClass :++ '[BarStyle]
WidgetFields IntRangeSliderType = BoundedIntRangeClass :++ '[Orientation, ShowRange, ReadOut, SliderColor]
WidgetFields FloatTextType = FloatClass
WidgetFields BoundedFloatTextType = BoundedFloatClass
WidgetFields FloatSliderType = BoundedFloatClass :++ '[Orientation, ShowRange, ReadOut, SliderColor]
WidgetFields FloatProgressType = BoundedFloatClass :++ '[BarStyle]
WidgetFields FloatRangeSliderType = BoundedFloatRangeClass :++ '[Orientation, ShowRange, ReadOut, SliderColor]
WidgetFields BoxType = BoxClass
WidgetFields FlexBoxType = BoxClass :++ '[Orientation, Flex, Pack, Align]
WidgetFields AccordionType = SelectionContainerClass
WidgetFields TabType = SelectionContainerClass
-- Wrapper around a field's value. A dummy value is sent as an empty string to the frontend.
data AttrVal a = Dummy a | Real a
unwrap :: AttrVal a -> a
unwrap (Dummy x) = x
unwrap (Real x) = x
-- Wrapper around a field.
data Attr (f :: Field) =
Attr { _value :: AttrVal (FieldType f)
, _verify :: FieldType f -> IO (FieldType f)
, _field :: Field
}
instance ToJSON (FieldType f) => ToJSON (Attr f) where
toJSON attr = case _value attr of
Dummy _ -> ""
Real x -> toJSON x
-- Types that can be converted to Aeson Pairs. -- Types that can be converted to Aeson Pairs.
class ToPairs a where class ToPairs a where
toPairs :: a -> [Pair] toPairs :: a -> [Pair]
-- Attributes that aren't synced with the frontend give [] on toPairs -- Attributes that aren't synced with the frontend give [] on toPairs
instance ToPairs (Attr ModelModule) where toPairs (Attr x) = ["_model_module" .= toJSON x] instance ToPairs (Attr ViewModule) where toPairs x = ["_view_module" .= toJSON x]
instance ToPairs (Attr ModelName) where toPairs (Attr x) = ["_model_name" .= toJSON x] instance ToPairs (Attr ViewName) where toPairs x = ["_view_name" .= toJSON x]
instance ToPairs (Attr ViewModule) where toPairs (Attr x) = ["_view_module" .= toJSON x] instance ToPairs (Attr MsgThrottle) where toPairs x = ["msg_throttle" .= toJSON x]
instance ToPairs (Attr ViewName) where toPairs (Attr x) = ["_view_name" .= toJSON x] instance ToPairs (Attr Version) where toPairs x = ["version" .= toJSON x]
instance ToPairs (Attr MsgThrottle) where toPairs (Attr x) = ["msg_throttle" .= toJSON x] instance ToPairs (Attr DisplayHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr Version) where toPairs (Attr x) = ["version" .= toJSON x] instance ToPairs (Attr Visible) where toPairs x = ["visible" .= toJSON x]
instance ToPairs (Attr OnDisplayed) where toPairs _ = [] -- Not sent to the frontend instance ToPairs (Attr CSS) where toPairs x = ["_css" .= toJSON x]
instance ToPairs (Attr Visible) where toPairs (Attr x) = ["visible" .= toJSON x] instance ToPairs (Attr DOMClasses) where toPairs x = ["_dom_classes" .= toJSON x]
instance ToPairs (Attr CSS) where toPairs (Attr x) = ["_css" .= toJSON x] instance ToPairs (Attr Width) where toPairs x = ["width" .= toJSON x]
instance ToPairs (Attr DOMClasses) where toPairs (Attr x) = ["_dom_classes" .= toJSON x] instance ToPairs (Attr Height) where toPairs x = ["height" .= toJSON x]
instance ToPairs (Attr Width) where toPairs (Attr x) = ["width" .= toJSON x] instance ToPairs (Attr Padding) where toPairs x = ["padding" .= toJSON x]
instance ToPairs (Attr Height) where toPairs (Attr x) = ["height" .= toJSON x] instance ToPairs (Attr Margin) where toPairs x = ["margin" .= toJSON x]
instance ToPairs (Attr Padding) where toPairs (Attr x) = ["padding" .= toJSON x] instance ToPairs (Attr Color) where toPairs x = ["color" .= toJSON x]
instance ToPairs (Attr Margin) where toPairs (Attr x) = ["margin" .= toJSON x] instance ToPairs (Attr BackgroundColor) where toPairs x = ["background_color" .= toJSON x]
instance ToPairs (Attr Color) where toPairs (Attr x) = ["color" .= toJSON x] instance ToPairs (Attr BorderColor) where toPairs x = ["border_color" .= toJSON x]
instance ToPairs (Attr BackgroundColor) where toPairs (Attr x) = ["background_color" .= toJSON x] instance ToPairs (Attr BorderWidth) where toPairs x = ["border_width" .= toJSON x]
instance ToPairs (Attr BorderColor) where toPairs (Attr x) = ["border_color" .= toJSON x] instance ToPairs (Attr BorderRadius) where toPairs x = ["border_radius" .= toJSON x]
instance ToPairs (Attr BorderWidth) where toPairs (Attr x) = ["border_width" .= toJSON x] instance ToPairs (Attr BorderStyle) where toPairs x = ["border_style" .= toJSON x]
instance ToPairs (Attr BorderRadius) where toPairs (Attr x) = ["border_radius" .= toJSON x] instance ToPairs (Attr FontStyle) where toPairs x = ["font_style" .= toJSON x]
instance ToPairs (Attr BorderStyle) where toPairs (Attr x) = ["border_style" .= toJSON x] instance ToPairs (Attr FontWeight) where toPairs x = ["font_weight" .= toJSON x]
instance ToPairs (Attr FontStyle) where toPairs (Attr x) = ["font_style" .= toJSON x] instance ToPairs (Attr FontSize) where toPairs x = ["font_size" .= toJSON x]
instance ToPairs (Attr FontWeight) where toPairs (Attr x) = ["font_weight" .= toJSON x] instance ToPairs (Attr FontFamily) where toPairs x = ["font_family" .= toJSON x]
instance ToPairs (Attr FontSize) where toPairs (Attr x) = ["font_size" .= toJSON x] instance ToPairs (Attr Description) where toPairs x = ["description" .= toJSON x]
instance ToPairs (Attr FontFamily) where toPairs (Attr x) = ["font_family" .= toJSON x]
instance ToPairs (Attr Description) where toPairs (Attr x) = ["description" .= toJSON x]
instance ToPairs (Attr ClickHandler) where toPairs _ = [] -- Not sent to the frontend instance ToPairs (Attr ClickHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr SubmitHandler) where toPairs _ = [] -- Not sent to the frontend instance ToPairs (Attr SubmitHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr Disabled) where toPairs (Attr x) = ["disabled" .= toJSON x] instance ToPairs (Attr Disabled) where toPairs x = ["disabled" .= toJSON x]
instance ToPairs (Attr StringValue) where toPairs (Attr x) = ["value" .= toJSON x] instance ToPairs (Attr StringValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr Placeholder) where toPairs (Attr x) = ["placeholder" .= toJSON x] instance ToPairs (Attr Placeholder) where toPairs x = ["placeholder" .= toJSON x]
instance ToPairs (Attr Tooltip) where toPairs (Attr x) = ["tooltip" .= toJSON x] instance ToPairs (Attr Tooltip) where toPairs x = ["tooltip" .= toJSON x]
instance ToPairs (Attr Icon) where toPairs (Attr x) = ["icon" .= toJSON x] instance ToPairs (Attr Icon) where toPairs x = ["icon" .= toJSON x]
instance ToPairs (Attr ButtonStyle) where toPairs (Attr x) = ["button_style" .= toJSON x] instance ToPairs (Attr ButtonStyle) where toPairs x = ["button_style" .= toJSON x]
instance ToPairs (Attr B64Value) where toPairs (Attr x) = ["_b64value" .= toJSON x] instance ToPairs (Attr B64Value) where toPairs x = ["_b64value" .= toJSON x]
instance ToPairs (Attr ImageFormat) where toPairs (Attr x) = ["format" .= toJSON x] instance ToPairs (Attr ImageFormat) where toPairs x = ["format" .= toJSON x]
instance ToPairs (Attr BoolValue) where toPairs (Attr x) = ["value" .= toJSON x] instance ToPairs (Attr BoolValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr SelectedLabel) where toPairs (Attr x) = ["selected_label" .= toJSON x] instance ToPairs (Attr SelectedLabel) where toPairs x = ["selected_label" .= toJSON x]
instance ToPairs (Attr SelectedValue) where toPairs (Attr x) = ["value" .= toJSON x] instance ToPairs (Attr SelectedValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr Options) where instance ToPairs (Attr Options) where
toPairs (Attr x) = case x of toPairs x = case _value x of
OptionLabels xs -> labels xs Dummy _ -> labels ("" :: Text)
OptionDict xps -> labels $ map fst xps Real (OptionLabels xs) -> labels xs
Real (OptionDict xps) -> labels $ map fst xps
where labels xs = ["_options_labels" .= xs] where labels xs = ["_options_labels" .= xs]
instance ToPairs (Attr SelectionHandler) where toPairs _ = [] -- Not sent to the frontend instance ToPairs (Attr SelectionHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr Tooltips) where toPairs (Attr x) = ["tooltips" .= toJSON x] instance ToPairs (Attr Tooltips) where toPairs x = ["tooltips" .= toJSON x]
instance ToPairs (Attr Icons) where toPairs (Attr x) = ["icons" .= toJSON x] instance ToPairs (Attr Icons) where toPairs x = ["icons" .= toJSON x]
instance ToPairs (Attr SelectedLabels) where toPairs (Attr x) = ["selected_labels" .= toJSON x] instance ToPairs (Attr SelectedLabels) where toPairs x = ["selected_labels" .= toJSON x]
instance ToPairs (Attr SelectedValues) where toPairs (Attr x) = ["values" .= toJSON x] instance ToPairs (Attr SelectedValues) where toPairs x = ["values" .= toJSON x]
instance ToPairs (Attr IntValue) where toPairs x = ["value" .= toJSON x]
-- | Store the value for a field, as an object parametrized by the Field instance ToPairs (Attr StepInt) where toPairs x = ["step" .= toJSON x]
(=::) :: sing f -> FieldType f -> Attr f instance ToPairs (Attr MinInt) where toPairs x = ["min" .= toJSON x]
_ =:: x = Attr x instance ToPairs (Attr MaxInt) where toPairs x = ["max" .= toJSON x]
instance ToPairs (Attr IntPairValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr LowerInt) where toPairs x = ["min" .= toJSON x]
instance ToPairs (Attr UpperInt) where toPairs x = ["max" .= toJSON x]
instance ToPairs (Attr FloatValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr StepFloat) where toPairs x = ["step" .= toJSON x]
instance ToPairs (Attr MinFloat) where toPairs x = ["min" .= toJSON x]
instance ToPairs (Attr MaxFloat) where toPairs x = ["max" .= toJSON x]
instance ToPairs (Attr FloatPairValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr LowerFloat) where toPairs x = ["min" .= toJSON x]
instance ToPairs (Attr UpperFloat) where toPairs x = ["max" .= toJSON x]
instance ToPairs (Attr Orientation) where toPairs x = ["orientation" .= toJSON x]
instance ToPairs (Attr ShowRange) where toPairs x = ["_range" .= toJSON x]
instance ToPairs (Attr ReadOut) where toPairs x = ["readout" .= toJSON x]
instance ToPairs (Attr SliderColor) where toPairs x = ["slider_color" .= toJSON x]
instance ToPairs (Attr BarStyle) where toPairs x = ["bar_style" .= toJSON x]
instance ToPairs (Attr ChangeHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr Children) where toPairs x = ["children" .= toJSON x]
instance ToPairs (Attr OverflowX) where toPairs x = ["overflow_x" .= toJSON x]
instance ToPairs (Attr OverflowY) where toPairs x = ["overflow_y" .= toJSON x]
instance ToPairs (Attr BoxStyle) where toPairs x = ["box_style" .= toJSON x]
instance ToPairs (Attr Flex) where toPairs x = ["flex" .= toJSON x]
instance ToPairs (Attr Pack) where toPairs x = ["pack" .= toJSON x]
instance ToPairs (Attr Align) where toPairs x = ["align" .= toJSON x]
instance ToPairs (Attr Titles) where toPairs x = ["_titles" .= toJSON x]
instance ToPairs (Attr SelectedIndex) where toPairs x = ["selected_index" .= toJSON x]
-- | Store the value for a field, as an object parametrized by the Field. No verification is done
-- for these values.
(=::) :: SingI f => Sing f -> FieldType f -> Attr f
s =:: x = Attr { _value = Real x, _verify = return, _field = reflect s }
-- | If the number is in the range, return it. Otherwise raise the appropriate (over/under)flow
-- exception.
rangeCheck :: (Num a, Ord a) => (a, a) -> a -> IO a
rangeCheck (l, u) x
| l <= x && x <= u = return x
| l > x = Ex.throw Ex.Underflow
| u < x = Ex.throw Ex.Overflow
-- | Store a numeric value, with verification mechanism for its range.
ranged :: (SingI f, Num (FieldType f), Ord (FieldType f))
=> Sing f -> (FieldType f, FieldType f) -> AttrVal (FieldType f) -> Attr f
ranged s range x = Attr x (rangeCheck range) (reflect s)
-- | Store a numeric value, with the invariant that it stays non-negative. The value set is set as a
-- dummy value if it's equal to zero.
(=:+) :: (SingI f, Num (FieldType f), CustomBounded (FieldType f), Ord (FieldType f))
=> Sing f -> FieldType f -> Attr f
s =:+ val = Attr ((if val == 0 then Dummy else Real) val) (rangeCheck (0, upperBound)) (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 = fromSing
-- | A record representing an object of the Widget class from IPython -- | A record representing an object of the Widget class from IPython
defaultWidget :: FieldType ViewName -> Rec Attr WidgetClass defaultWidget :: FieldType ViewName -> Rec Attr WidgetClass
defaultWidget viewName = (SModelModule =:: "") defaultWidget viewName = (SViewModule =:: "")
:& (SModelName =:: "WidgetModel")
:& (SViewModule =:: "")
:& (SViewName =:: viewName) :& (SViewName =:: viewName)
:& (SMsgThrottle =:: 3) :& (SMsgThrottle =:+ 3)
:& (SVersion =:: 0) :& (SVersion =:: 0)
:& (SOnDisplayed =:: return ()) :& (SDisplayHandler =:: return ())
:& RNil :& RNil
-- | A record representing an object of the DOMWidget class from IPython -- | A record representing an object of the DOMWidget class from IPython
...@@ -238,19 +404,19 @@ defaultDOMWidget viewName = defaultWidget viewName <+> domAttrs ...@@ -238,19 +404,19 @@ defaultDOMWidget viewName = defaultWidget viewName <+> domAttrs
where domAttrs = (SVisible =:: True) where domAttrs = (SVisible =:: True)
:& (SCSS =:: []) :& (SCSS =:: [])
:& (SDOMClasses =:: []) :& (SDOMClasses =:: [])
:& (SWidth =:: 0) :& (SWidth =:+ 0)
:& (SHeight =:: 0) :& (SHeight =:+ 0)
:& (SPadding =:: 0) :& (SPadding =:+ 0)
:& (SMargin =:: 0) :& (SMargin =:+ 0)
:& (SColor =:: "") :& (SColor =:: "")
:& (SBackgroundColor =:: "") :& (SBackgroundColor =:: "")
:& (SBorderColor =:: "") :& (SBorderColor =:: "")
:& (SBorderWidth =:: 0) :& (SBorderWidth =:+ 0)
:& (SBorderRadius =:: 0) :& (SBorderRadius =:+ 0)
:& (SBorderStyle =:: DefaultBorder) :& (SBorderStyle =:: DefaultBorder)
:& (SFontStyle =:: DefaultFont) :& (SFontStyle =:: DefaultFont)
:& (SFontWeight =:: DefaultWeight) :& (SFontWeight =:: DefaultWeight)
:& (SFontSize =:: 0) :& (SFontSize =:+ 0)
:& (SFontFamily =:: "") :& (SFontFamily =:: "")
:& RNil :& RNil
...@@ -269,6 +435,7 @@ defaultBoolWidget viewName = defaultDOMWidget viewName <+> boolAttrs ...@@ -269,6 +435,7 @@ defaultBoolWidget viewName = defaultDOMWidget viewName <+> boolAttrs
where boolAttrs = (SBoolValue =:: False) where boolAttrs = (SBoolValue =:: False)
:& (SDisabled =:: False) :& (SDisabled =:: False)
:& (SDescription =:: "") :& (SDescription =:: "")
:& (SChangeHandler =:: return ())
:& RNil :& RNil
-- | A record representing a widget of the _Selection class from IPython -- | A record representing a widget of the _Selection class from IPython
...@@ -293,6 +460,89 @@ defaultMultipleSelectionWidget viewName = defaultDOMWidget viewName <+> mulSelAt ...@@ -293,6 +460,89 @@ defaultMultipleSelectionWidget viewName = defaultDOMWidget viewName <+> mulSelAt
:& (SSelectionHandler =:: return ()) :& (SSelectionHandler =:: return ())
:& RNil :& RNil
-- | A record representing a widget of the _Int class from IPython
defaultIntWidget :: FieldType ViewName -> Rec Attr IntClass
defaultIntWidget viewName = defaultDOMWidget viewName <+> intAttrs
where intAttrs = (SIntValue =:: 0)
:& (SDisabled =:: False)
:& (SDescription =:: "")
:& (SChangeHandler =:: return ())
:& RNil
-- | A record representing a widget of the _BoundedInt class from IPython
defaultBoundedIntWidget :: FieldType ViewName -> Rec Attr BoundedIntClass
defaultBoundedIntWidget viewName = defaultIntWidget viewName <+> boundedIntAttrs
where boundedIntAttrs = (SStepInt =:: 1)
:& (SMinInt =:: 0)
:& (SMaxInt =:: 100)
:& RNil
-- | A record representing a widget of the _BoundedInt class from IPython
defaultIntRangeWidget :: FieldType ViewName -> Rec Attr IntRangeClass
defaultIntRangeWidget viewName = defaultIntWidget viewName <+> rangeAttrs
where rangeAttrs = (SIntPairValue =:: (25, 75))
:& (SLowerInt =:: 0)
:& (SUpperInt =:: 100)
:& RNil
-- | A record representing a widget of the _BoundedIntRange class from IPython
defaultBoundedIntRangeWidget :: FieldType ViewName -> Rec Attr BoundedIntRangeClass
defaultBoundedIntRangeWidget viewName = defaultIntRangeWidget viewName <+> boundedIntRangeAttrs
where boundedIntRangeAttrs = (SStepInt =:+ 1)
:& (SMinInt =:: 0)
:& (SMaxInt =:: 100)
:& RNil
-- | A record representing a widget of the _Float class from IPython
defaultFloatWidget :: FieldType ViewName -> Rec Attr FloatClass
defaultFloatWidget viewName = defaultDOMWidget viewName <+> intAttrs
where intAttrs = (SFloatValue =:: 0)
:& (SDisabled =:: False)
:& (SDescription =:: "")
:& (SChangeHandler =:: return ())
:& RNil
-- | A record representing a widget of the _BoundedFloat class from IPython
defaultBoundedFloatWidget :: FieldType ViewName -> Rec Attr BoundedFloatClass
defaultBoundedFloatWidget viewName = defaultFloatWidget viewName <+> boundedFloatAttrs
where boundedFloatAttrs = (SStepFloat =:+ 1)
:& (SMinFloat =:: 0)
:& (SMaxFloat =:: 100)
:& RNil
-- | A record representing a widget of the _BoundedFloat class from IPython
defaultFloatRangeWidget :: FieldType ViewName -> Rec Attr FloatRangeClass
defaultFloatRangeWidget viewName = defaultFloatWidget viewName <+> rangeAttrs
where rangeAttrs = (SFloatPairValue =:: (25, 75))
:& (SLowerFloat =:: 0)
:& (SUpperFloat =:: 100)
:& RNil
-- | A record representing a widget of the _BoundedFloatRange class from IPython
defaultBoundedFloatRangeWidget :: FieldType ViewName -> Rec Attr BoundedFloatRangeClass
defaultBoundedFloatRangeWidget viewName = defaultFloatRangeWidget viewName <+> boundedFloatRangeAttrs
where boundedFloatRangeAttrs = (SStepFloat =:+ 1)
:& (SMinFloat =:: 0)
:& (SMaxFloat =:: 100)
:& RNil
-- | A record representing a widget of the _Box class from IPython
defaultBoxWidget :: FieldType ViewName -> Rec Attr BoxClass
defaultBoxWidget viewName = defaultDOMWidget viewName <+> boxAttrs
where boxAttrs = (SChildren =:: [])
:& (SOverflowX =:: DefaultOverflow)
:& (SOverflowY =:: DefaultOverflow)
:& (SBoxStyle =:: DefaultBox)
:& RNil
-- | A record representing a widget of the _SelectionContainer class from IPython
defaultSelectionContainerWidget :: FieldType ViewName -> Rec Attr SelectionContainerClass
defaultSelectionContainerWidget viewName = defaultBoxWidget viewName <+> selAttrs
where selAttrs = (STitles =:: [])
:& (SSelectedIndex =:: 0)
:& (SChangeHandler =:: return ())
:& RNil
newtype WidgetState w = WidgetState { _getState :: Rec Attr (WidgetFields w) } newtype WidgetState w = WidgetState { _getState :: Rec Attr (WidgetFields w) }
-- All records with ToPair instances for their Attrs will automatically have a toJSON instance now. -- All records with ToPair instances for their Attrs will automatically have a toJSON instance now.
...@@ -307,28 +557,54 @@ instance RecAll Attr (WidgetFields w) ToPairs => ToJSON (WidgetState w) where ...@@ -307,28 +557,54 @@ instance RecAll Attr (WidgetFields w) ToPairs => ToJSON (WidgetState w) where
data IPythonWidget (w :: WidgetType) = IPythonWidget { uuid :: UUID, state :: IORef (WidgetState w) } data IPythonWidget (w :: WidgetType) = IPythonWidget { uuid :: UUID, state :: IORef (WidgetState w) }
-- | Change the value for a field, and notify the frontend about it. -- | Change the value for a field, and notify the frontend about it.
setField :: (f WidgetFields w, IHaskellWidget (IPythonWidget w), ToPairs (Attr f)) => IPythonWidget w -> SField f -> FieldType f -> IO () setField :: (f WidgetFields w, IHaskellWidget (IPythonWidget w), ToPairs (Attr f))
setField widget (sfield :: SField f) fval = do => IPythonWidget w -> SField f -> FieldType f -> IO ()
setField' widget sfield fval setField widget sfield fval = do
let pairs = toPairs (Attr fval :: Attr f) !newattr <- setField' widget sfield fval
when (not . null $ pairs) $ widgetSendUpdate widget (object pairs) let pairs = toPairs newattr
unless (null pairs) $ widgetSendUpdate widget (object pairs)
-- | Change the value of a field, without notifying the frontend. For internal use. Uses BangPattern.
setField' :: (f WidgetFields w, IHaskellWidget (IPythonWidget w)) => IPythonWidget w -> SField f -> FieldType f -> IO () -- | Change the value of a field, without notifying the frontend. For internal use.
setField' widget sfield !fval = modifyIORef (state widget) (WidgetState . rput (sfield =:: fval) . _getState) setField' :: (f WidgetFields w, IHaskellWidget (IPythonWidget w))
=> IPythonWidget w -> SField f -> FieldType f -> IO (Attr f)
setField' widget sfield val = do
attr <- getAttr widget sfield
newval <- _verify attr val
let newattr = attr { _value = Real newval }
modifyIORef (state widget) (WidgetState . rput newattr . _getState)
return newattr
-- | Pluck an attribute from a record
getAttr :: (f WidgetFields w) => IPythonWidget w -> SField f -> IO (Attr f)
getAttr widget sfield = rget sfield <$> _getState <$> readIORef (state widget)
-- | Get the value of a field. -- | Get the value of a field.
getField :: (f WidgetFields w) => IPythonWidget w -> SField f -> IO (FieldType f) getField :: (f WidgetFields w) => IPythonWidget w -> SField f -> IO (FieldType f)
getField widget sfield = _unAttr <$> rget sfield <$> _getState <$> readIORef (state widget) getField widget sfield = unwrap . _value <$> getAttr widget sfield
-- | Useful with toJSON and OverloadedStrings -- | Useful with toJSON and OverloadedStrings
str :: String -> String str :: String -> String
str = id str = id
-- | Send zero values as empty strings, which stands for default value in the frontend. properties :: IPythonWidget w -> IO [Field]
instance ToJSON Natural where properties widget = do
toJSON 0 = String "" st <- readIORef $ state widget
toJSON n = String . pack $ show n let convert :: Attr f -> Const Field f
convert attr = Const { getConst = _field attr }
return $ recordToList . rmap convert . _getState $ st
-- Trigger events
triggerChange :: (ChangeHandler WidgetFields w) => IPythonWidget w -> IO ()
triggerChange w = join $ getField w SChangeHandler
triggerClick :: (ClickHandler WidgetFields w) => IPythonWidget w -> IO ()
triggerClick w = join $ getField w SClickHandler
triggerSelection :: (SelectionHandler WidgetFields w) => IPythonWidget w -> IO ()
triggerSelection w = join $ getField w SSelectionHandler
triggerSubmit :: (SubmitHandler WidgetFields w) => IPythonWidget w -> IO ()
triggerSubmit w = join $ getField w SSubmitHandler
triggerDisplay :: (DisplayHandler WidgetFields w) => IPythonWidget w -> IO ()
triggerDisplay w = join $ getField w SDisplayHandler
-- | Description : UUID generator and data structure -- | Description : UUID generator and data structure
-- --
-- Generate, parse, and pretty print UUIDs for use with IPython. -- 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.Monad (mzero, replicateM)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
...@@ -16,7 +16,7 @@ data UUID = ...@@ -16,7 +16,7 @@ data UUID =
-- present in the correct locations. For the purposes of new UUIDs, it does not matter, -- 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 -- but IPython expects UUIDs passed to kernels to be returned unchanged, so we cannot
-- actually parse them. -- actually parse them.
UUID String UUID { uuidToString :: String }
deriving (Show, Read, Eq, Ord) deriving (Show, Read, Eq, Ord)
-- | Generate a list of random UUIDs. -- | Generate a list of random UUIDs.
...@@ -28,7 +28,7 @@ randoms n = replicateM n random ...@@ -28,7 +28,7 @@ randoms n = replicateM n random
random :: IO UUID random :: IO UUID
random = UUID <$> show <$> nextRandom 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 instance FromJSON UUID where
parseJSON val@(String _) = UUID <$> parseJSON val parseJSON val@(String _) = UUID <$> parseJSON val
......
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