packages feed

ihaskell-widgets 0.1.0.0 → 0.2.0.0

raw patch · 38 files changed

+1071/−436 lines, 38 filesdep ~aesonsetup-changed

Dependency ranges changed: aeson

Files

Setup.hs view
@@ -1,2 +1,3 @@-import Distribution.Simple+import           Distribution.Simple+ main = defaultMain
ihaskell-widgets.cabal view
@@ -10,7 +10,7 @@ -- PVP summary:      +-+------- breaking API changes --                   | | +----- non-breaking API additions --                   | | | +--- code changes with no API change-version:             0.1.0.0+version:             0.2.0.0  -- A short (one-line) description of the package. synopsis:            IPython standard widgets for IHaskell.@@ -52,15 +52,19 @@ library   -- Modules exported by the library.   exposed-modules:     IHaskell.Display.Widgets-  +                       IHaskell.Display.Widgets.Interactive+   -- Modules included in this library but not exported.   other-modules:       IHaskell.Display.Widgets.Button                        IHaskell.Display.Widgets.Box.Box+                       IHaskell.Display.Widgets.Box.Proxy+                       IHaskell.Display.Widgets.Box.PlaceProxy                        IHaskell.Display.Widgets.Box.FlexBox                        IHaskell.Display.Widgets.Box.SelectionContainer.Accordion                        IHaskell.Display.Widgets.Box.SelectionContainer.Tab                        IHaskell.Display.Widgets.Bool.CheckBox                        IHaskell.Display.Widgets.Bool.ToggleButton+                       IHaskell.Display.Widgets.Bool.Valid                        IHaskell.Display.Widgets.Int.IntText                        IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText                        IHaskell.Display.Widgets.Int.BoundedInt.IntProgress@@ -91,10 +95,10 @@   -- other-extensions:          -- Other library packages from which modules are imported.-  build-depends:       aeson >=0.7 && < 0.9+  build-depends:       aeson >=0.7 && < 0.10                      , base >=4.7 && <4.9                      , containers >= 0.5-                     , ipython-kernel >= 0.6.1.1+                     , ipython-kernel >= 0.6.1.2                      , text >= 0.11                      , unordered-containers -any                      , nats -any
src/IHaskell/Display/Widgets.hs view
@@ -3,12 +3,15 @@ import           IHaskell.Display.Widgets.Button as X  import           IHaskell.Display.Widgets.Box.Box as X+import           IHaskell.Display.Widgets.Box.Proxy as X+import           IHaskell.Display.Widgets.Box.PlaceProxy as X import           IHaskell.Display.Widgets.Box.FlexBox as X import           IHaskell.Display.Widgets.Box.SelectionContainer.Accordion as X import           IHaskell.Display.Widgets.Box.SelectionContainer.Tab as X  import           IHaskell.Display.Widgets.Bool.CheckBox as X import           IHaskell.Display.Widgets.Bool.ToggleButton as X+import           IHaskell.Display.Widgets.Bool.Valid as X  import           IHaskell.Display.Widgets.Int.IntText as X import           IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText as X@@ -38,8 +41,7 @@ import           IHaskell.Display.Widgets.String.TextArea as X  import           IHaskell.Display.Widgets.Common as X-import           IHaskell.Display.Widgets.Types as X (setField, getField, properties)--import           IHaskell.Display.Widgets.Types as X (triggerDisplay, triggerChange, triggerClick,+import           IHaskell.Display.Widgets.Types as X (setField, getField, properties,+                                                      triggerDisplay, triggerChange, triggerClick,                                                       triggerSelection, triggerSubmit,                                                       ChildWidget(..))
src/IHaskell/Display/Widgets/Bool/CheckBox.hs view
@@ -40,11 +40,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Checkbox"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the image widget   return widget
src/IHaskell/Display/Widgets/Bool/ToggleButton.hs view
@@ -45,11 +45,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.ToggleButton"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the image widget   return widget
+ src/IHaskell/Display/Widgets/Bool/Valid.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeSynonymInstances #-}++module IHaskell.Display.Widgets.Bool.Valid (+  -- * The Valid Widget+  ValidWidget,+  -- * Constructor+  mkValidWidget) where++-- To keep `cabal repl` happy when running from the ihaskell repo+import           Prelude++import           Control.Monad (when, join, void)+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 'ValidWidget' represents a Valid widget from IPython.html.widgets.+type ValidWidget = IPythonWidget ValidType++-- | Create a new output widget+mkValidWidget :: IO ValidWidget+mkValidWidget = do+  -- Default properties, with a random uuid+  uuid <- U.random++  let boolState = defaultBoolWidget "ValidView"+      validState = (ReadOutMsg =:: "") :& RNil+      widgetState = WidgetState $ boolState <+> validState++  stateIO <- newIORef widgetState++  let widget = IPythonWidget uuid stateIO++  -- Open a comm for this widget, and store it in the kernel state+  widgetSendOpen widget $ toJSON widgetState++  -- Return the image widget+  return widget++instance IHaskellDisplay ValidWidget where+  display b = do+    widgetSendView b+    return $ Display []++instance IHaskellWidget ValidWidget where+  getCommUUID = uuid
src/IHaskell/Display/Widgets/Box/Box.hs view
@@ -40,10 +40,9 @@   stateIO <- newIORef widgetState    let box = IPythonWidget uuid stateIO-      initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Box"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen box initData $ toJSON widgetState+  widgetSendOpen box $ toJSON widgetState    -- Return the widget   return box
src/IHaskell/Display/Widgets/Box/FlexBox.hs view
@@ -46,10 +46,9 @@   stateIO <- newIORef widgetState    let box = IPythonWidget uuid stateIO-      initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.FlexBox"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen box initData $ toJSON widgetState+  widgetSendOpen box $ toJSON widgetState    -- Return the widget   return box
+ src/IHaskell/Display/Widgets/Box/PlaceProxy.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeSynonymInstances #-}+++module IHaskell.Display.Widgets.Box.PlaceProxy (+  -- * The PlaceProxy widget+  PlaceProxy,+  -- * Constructor+  mkPlaceProxy) where++-- To keep `cabal repl` happy when running from the ihaskell repo+import           Prelude++import           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           Data.Vinyl.Lens (rput)++import           IHaskell.Display+import           IHaskell.Eval.Widgets+import           IHaskell.IPython.Message.UUID as U++import           IHaskell.Display.Widgets.Types+import           IHaskell.Display.Widgets.Common++-- | A 'Box' represents a Box widget from IPython.html.widgets.+type PlaceProxy = IPythonWidget PlaceProxyType++-- | Create a new box+mkPlaceProxy :: IO PlaceProxy+mkPlaceProxy = do+  -- Default properties, with a random uuid+  uuid <- U.random++  let widgetClassState = defaultWidget "PlaceProxyView"+      baseState = rput (ModelName =:: "ProxyModel") widgetClassState+      proxyState = (Child =:: Nothing) :& (Selector =:: "") :& RNil+      widgetState = WidgetState $ baseState <+> proxyState++  stateIO <- newIORef widgetState++  let widget = IPythonWidget uuid stateIO++  -- Open a comm for this widget, and store it in the kernel state+  widgetSendOpen widget $ toJSON widgetState++  -- Return the widget+  return widget++instance IHaskellDisplay PlaceProxy where+  display b = do+    widgetSendView b+    return $ Display []++instance IHaskellWidget PlaceProxy where+  getCommUUID = uuid
+ src/IHaskell/Display/Widgets/Box/Proxy.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeSynonymInstances #-}++module IHaskell.Display.Widgets.Box.Proxy (+-- * The Proxy widget+ProxyWidget,+     -- * Constructor+     mkProxyWidget) where++-- To keep `cabal repl` happy when running from the ihaskell repo+import           Prelude++import           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           Data.Vinyl.Lens (rput)++import           IHaskell.Display+import           IHaskell.Eval.Widgets+import           IHaskell.IPython.Message.UUID as U++import           IHaskell.Display.Widgets.Types+import           IHaskell.Display.Widgets.Common++-- | A 'Box' represents a Box widget from IPython.html.widgets.+type ProxyWidget = IPythonWidget ProxyType++-- | Create a new box+mkProxyWidget :: IO ProxyWidget+mkProxyWidget = do+  -- Default properties, with a random uuid+  uuid <- U.random++  let widgetClassState = defaultWidget "ProxyView"+      baseState = rput (ModelName =:: "ProxyModel") widgetClassState+      proxyState = (Child =:: Nothing) :& RNil+      widgetState = WidgetState $ baseState <+> proxyState++  stateIO <- newIORef widgetState++  let proxy = IPythonWidget uuid stateIO++  -- Open a comm for this widget, and store it in the kernel state+  widgetSendOpen proxy $ toJSON widgetState++  -- Return the widget+  return proxy++instance IHaskellDisplay ProxyWidget where+  display b = do+    widgetSendView b+    return $ Display []++instance IHaskellWidget ProxyWidget where+  getCommUUID = uuid
src/IHaskell/Display/Widgets/Box/SelectionContainer/Accordion.hs view
@@ -41,11 +41,9 @@   stateIO <- newIORef widgetState    let box = IPythonWidget uuid stateIO-      initData = object-                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Accordion"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen box initData $ toJSON widgetState+  widgetSendOpen box $ toJSON widgetState    -- Return the widget   return box
src/IHaskell/Display/Widgets/Box/SelectionContainer/Tab.hs view
@@ -41,10 +41,9 @@   stateIO <- newIORef widgetState    let box = IPythonWidget uuid stateIO-      initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Tab"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen box initData $ toJSON widgetState+  widgetSendOpen box $ toJSON widgetState    -- Return the widget   return box
src/IHaskell/Display/Widgets/Button.hs view
@@ -49,10 +49,8 @@    let button = IPythonWidget uuid stateIO -  let initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Button"]-   -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen button initData $ toJSON buttonState+  widgetSendOpen button $ toJSON buttonState    -- Return the button widget   return button
src/IHaskell/Display/Widgets/Common.hs view
@@ -4,19 +4,22 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE GADTs #-}+ module IHaskell.Display.Widgets.Common where -import Data.Aeson-import Data.Aeson.Types (emptyObject)-import Data.Text (pack, Text)+import           Data.Aeson+import           Data.Aeson.Types (emptyObject)+import           Data.Text (pack, Text) -import IHaskell.Display (IHaskellWidget)-import IHaskell.Eval.Widgets (widgetSendClose)+import           IHaskell.Display (IHaskellWidget)+import           IHaskell.Eval.Widgets (widgetSendClose)  import qualified IHaskell.Display.Widgets.Singletons as S  pattern ViewModule = S.SViewModule pattern ViewName = S.SViewName+pattern ModelModule = S.SModelModule+pattern ModelName = S.SModelName pattern MsgThrottle = S.SMsgThrottle pattern Version = S.SVersion pattern DisplayHandler = S.SDisplayHandler@@ -86,12 +89,16 @@ pattern Align = S.SAlign pattern Titles = S.STitles pattern SelectedIndex = S.SSelectedIndex+pattern ReadOutMsg = S.SReadOutMsg+pattern Child = S.SChild+pattern Selector = S.SSelector  -- | Close a widget's comm closeWidget :: IHaskellWidget w => w -> IO () closeWidget w = widgetSendClose w emptyObject -newtype StrInt = StrInt Integer deriving (Num, Ord, Eq, Enum)+newtype StrInt = StrInt Integer+  deriving (Num, Ord, Eq, Enum)  instance ToJSON StrInt where   toJSON (StrInt x) = toJSON . pack $ show x@@ -205,7 +212,8 @@   toJSON = toJSON . pack . show  -- | Options for selection widgets.-data SelectionOptions = OptionLabels [Text] | OptionDict [(Text, Text)]+data SelectionOptions = OptionLabels [Text]+                      | OptionDict [(Text, Text)]  -- | Orientation values. data OrientationValue = HorizontalOrientation
src/IHaskell/Display/Widgets/Float/BoundedFloat/BoundedFloatText.hs view
@@ -42,13 +42,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   [ "model_name" .= str "WidgetModel"-                   , "widget_class" .= str "IPython.BoundedFloatText"-                   ]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatProgress.hs view
@@ -38,19 +38,17 @@   uuid <- U.random    let boundedFloatAttrs = defaultBoundedFloatWidget "ProgressView"-      progressAttrs = (BarStyle =:: DefaultBar) :& RNil+      progressAttrs = (Orientation =:: HorizontalOrientation)+                      :& (BarStyle =:: 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+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatSlider.hs view
@@ -47,11 +47,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.FloatSlider"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Float/BoundedFloatRange/FloatRangeSlider.hs view
@@ -50,13 +50,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   [ "model_name" .= str "WidgetModel"-                   , "widget_class" .= str "IPython.FloatRangeSlider"-                   ]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Float/FloatText.hs view
@@ -41,11 +41,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.FloatText"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Image.hs view
@@ -38,6 +38,8 @@    let dom = defaultDOMWidget "ImageView"       img = (ImageFormat =:: PNG)+            :& (Width =:+ 0)+            :& (Height =:+ 0)             :& (B64Value =:: mempty)             :& RNil       widgetState = WidgetState (dom <+> img)@@ -46,10 +48,8 @@    let widget = IPythonWidget uuid stateIO -  let initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Image"]-   -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the image widget   return widget
src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs view
@@ -41,13 +41,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   [ "model_name" .= str "WidgetModel"-                   , "widget_class" .= str "IPython.BoundedIntText"-                   ]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs view
@@ -38,17 +38,17 @@   uuid <- U.random    let boundedIntAttrs = defaultBoundedIntWidget "ProgressView"-      progressAttrs = (BarStyle =:: DefaultBar) :& RNil+      progressAttrs = (Orientation =:: HorizontalOrientation)+                      :& (BarStyle =:: 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+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs view
@@ -47,11 +47,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.IntSlider"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs view
@@ -48,13 +48,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   [ "model_name" .= str "WidgetModel"-                   , "widget_class" .= str "IPython.IntRangeSlider"-                   ]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Int/IntText.hs view
@@ -41,10 +41,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.IntText"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
+ src/IHaskell/Display/Widgets/Interactive.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE PatternSynonyms #-}++module IHaskell.Display.Widgets.Interactive (interactive, uncurryHList, Rec(..), Argument(..)) where++import           Data.Text+import           Data.Proxy++import           Data.Vinyl.Core+import           Data.Vinyl.Functor (Identity(..), Const(..))+import           Data.Vinyl.Derived (HList)+import           Data.Vinyl.Lens (type (∈))+import           Data.Vinyl.TypeLevel (RecAll)++import           IHaskell.Display++import           IHaskell.Display.Widgets.Types+import           IHaskell.Display.Widgets.Common+import qualified IHaskell.Display.Widgets.Singletons as S (SField(..), Field(..))++import           IHaskell.Display.Widgets.Box.FlexBox+import           IHaskell.Display.Widgets.Bool.CheckBox+import           IHaskell.Display.Widgets.String.Text+import           IHaskell.Display.Widgets.Int.BoundedInt.IntSlider+import           IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider+import           IHaskell.Display.Widgets.Output++ +data WidgetConf a where+        WidgetConf ::+            (RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs,+             FromWidget a) =>+            WrappedWidget (SuitableWidget a) (SuitableHandler a)+              (SuitableField a)+              a+              -> WidgetConf a++newtype WrappedConstructor a =+          WrappedConstructor+            { wrappedConstructor :: IO (IPythonWidget (SuitableWidget a)) }++ +type family WithTypes (ts :: [*]) (r :: *) :: * where+        WithTypes '[] r = r+        WithTypes (x ': xs) r = (x -> WithTypes xs r)++uncurryHList :: WithTypes ts r -> HList ts -> r+uncurryHList f RNil = f+uncurryHList f (Identity x :& xs) = uncurryHList (f x) xs++-- Consistent type variables are required to make things play nicely with vinyl+ +data Constructor a where+        Constructor ::+            RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs =>+            IO (IPythonWidget (SuitableWidget a)) -> Constructor a++newtype Getter a = Getter (IPythonWidget (SuitableWidget a) -> IO a)++newtype EventSetter a = EventSetter (IPythonWidget (SuitableWidget a) -> IO () -> IO ())++newtype Initializer a = Initializer (IPythonWidget (SuitableWidget a) -> Argument a -> IO ())++newtype Trigger a = Trigger (IPythonWidget (SuitableWidget a) -> IO ())++ +data RequiredWidget a where+        RequiredWidget ::+            RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs =>+            IPythonWidget (SuitableWidget a) -> RequiredWidget a++-- Zipping vinyl records in various ways+applyGetters :: Rec Getter ts -> Rec RequiredWidget ts -> IO (HList ts)+applyGetters RNil RNil = return RNil+applyGetters (Getter getter :& gs) (RequiredWidget widget :& ws) = do+  val <- getter widget+  rest <- applyGetters gs ws+  return $ Identity val :& rest++applyEventSetters :: Rec EventSetter ts -> Rec RequiredWidget ts -> IO () -> IO ()+applyEventSetters RNil RNil _ = return ()+applyEventSetters (EventSetter setter :& xs) (RequiredWidget widget :& ws) handler = do+  setter widget handler+  applyEventSetters xs ws handler++setInitialValues :: Rec Initializer ts -> Rec RequiredWidget ts -> Rec Argument ts -> IO ()+setInitialValues RNil RNil RNil = return ()+setInitialValues (Initializer initializer :& fs) (RequiredWidget widget :& ws) (argument :& vs) = do+  initializer widget argument+  setInitialValues fs ws vs++extractConstructor :: WidgetConf x -> Constructor x+extractConstructor (WidgetConf wr) = Constructor $ construct wr++extractGetter :: WidgetConf x -> Getter x+extractGetter (WidgetConf wr) = Getter $ getValue wr++extractEventSetter :: WidgetConf x -> EventSetter x+extractEventSetter (WidgetConf wr) = EventSetter $ setEvent wr++extractTrigger :: WidgetConf x -> Trigger x+extractTrigger (WidgetConf wr) = Trigger $ trigger wr++extractInitializer :: WidgetConf x -> Initializer x+extractInitializer (WidgetConf wr) = Initializer initializer++createWidget :: Constructor a -> IO (RequiredWidget a)+createWidget (Constructor con) = fmap RequiredWidget con++mkChildren :: Rec RequiredWidget a -> [ChildWidget]+mkChildren widgets =+  let childRecord = rmap (\(RequiredWidget w) -> Const (ChildWidget w)) widgets+  in recordToList childRecord++class MakeConfs (ts :: [*]) where+  mkConfs :: proxy ts -> Rec WidgetConf ts++instance MakeConfs '[] where+  mkConfs _ = RNil++instance (FromWidget t, MakeConfs ts) => MakeConfs (t ': ts) where+  mkConfs _ = WidgetConf wrapped :& mkConfs (Proxy :: Proxy ts)++interactive :: (IHaskellDisplay r, MakeConfs ts)+            => (HList ts -> r) -> Rec Argument ts -> IO FlexBox+interactive func =+  let confs = mkConfs Proxy+  in liftToWidgets func confs++-- | Transform a function (HList ts -> r) to one which: 1) Uses widgets to accept the arguments 2)+-- Accepts initial values for the arguments 3) Creates a compound FlexBox widget with an embedded+-- OutputWidget for display+liftToWidgets :: IHaskellDisplay r+              => (HList ts -> r) -> Rec WidgetConf ts -> Rec Argument ts -> IO FlexBox+liftToWidgets func rc initvals = do+  let constructors = rmap extractConstructor rc+      getters = rmap extractGetter rc+      eventSetters = rmap extractEventSetter rc+      initializers = rmap extractInitializer rc+      triggers = rmap extractTrigger rc++  bx <- mkFlexBox+  out <- mkOutputWidget++  -- Create a list of widgets+  widgets <- rtraverse createWidget constructors++  let handler = do+        vals <- applyGetters getters widgets+        replaceOutput out $ func vals++  -- Apply handler to all widgets+  applyEventSetters eventSetters widgets handler++  -- Set initial values for all widgets+  setInitialValues initializers widgets initvals+  -- applyValueSetters valueSetters widgets $ getList defvals+  setField out Width 500+  setField bx Orientation VerticalOrientation++  -- Set children for the FlexBox+  let children = mkChildren widgets+  setField bx Children $ children ++ [ChildWidget out]++  return bx++ +data WrappedWidget w h f a where+        WrappedWidget ::+            (FieldType h ~ IO (), FieldType f ~ a, h ∈ WidgetFields w,+             f ∈ WidgetFields w, ToPairs (Attr h),+             IHaskellWidget (IPythonWidget w), ToPairs (Attr f)) =>+            IO (IPythonWidget w) ->+              S.SField h -> S.SField f -> WrappedWidget w h f a++construct :: WrappedWidget w h f a -> IO (IPythonWidget w)+construct (WrappedWidget cons _ _) = cons++getValue :: WrappedWidget w h f a -> IPythonWidget w -> IO a+getValue (WrappedWidget _ _ field) widget = getField widget field++setValue :: WrappedWidget w h f a -> IPythonWidget w -> a -> IO ()+setValue (WrappedWidget _ _ field) widget = setField widget field++setEvent :: WrappedWidget w h f a -> IPythonWidget w -> IO () -> IO ()+setEvent (WrappedWidget _ h _) widget = setField widget h++trigger :: WrappedWidget w h f a -> IPythonWidget w -> IO ()+trigger (WrappedWidget _ h _) = triggerEvent h++class RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs => FromWidget a where+  type SuitableWidget a :: WidgetType+  type SuitableHandler a :: S.Field+  type SuitableField a :: S.Field+  data Argument a+  initializer :: IPythonWidget (SuitableWidget a) -> Argument a -> IO ()+  wrapped :: WrappedWidget (SuitableWidget a) (SuitableHandler a) (SuitableField a) a++instance FromWidget Bool where+  type SuitableWidget Bool = CheckBoxType+  type SuitableHandler Bool = S.ChangeHandler+  type SuitableField Bool = S.BoolValue+  data Argument Bool = BoolVal Bool+  initializer w (BoolVal b) = setField w BoolValue b+  wrapped = WrappedWidget mkCheckBox ChangeHandler BoolValue++instance FromWidget Text where+  type SuitableWidget Text = TextType+  type SuitableHandler Text = S.SubmitHandler+  type SuitableField Text = S.StringValue+  data Argument Text = TextVal Text+  initializer w (TextVal txt) = setField w StringValue txt+  wrapped = WrappedWidget mkTextWidget SubmitHandler StringValue++instance FromWidget Integer where+  type SuitableWidget Integer = IntSliderType+  type SuitableHandler Integer = S.ChangeHandler+  type SuitableField Integer = S.IntValue+  data Argument Integer = IntVal Integer+                      | IntRange (Integer, Integer, Integer)+  wrapped = WrappedWidget mkIntSlider ChangeHandler IntValue+  initializer w (IntVal int) = setField w IntValue int+  initializer w (IntRange (v, l, u)) = do+    setField w IntValue v+    setField w MinInt l+    setField w MaxInt u++instance FromWidget Double where+  type SuitableWidget Double = FloatSliderType+  type SuitableHandler Double = S.ChangeHandler+  type SuitableField Double = S.FloatValue+  data Argument Double = FloatVal Double+                     | FloatRange (Double, Double, Double)+  wrapped = WrappedWidget mkFloatSlider ChangeHandler FloatValue+  initializer w (FloatVal d) = setField w FloatValue d+  initializer w (FloatRange (v, l, u)) = do+    setField w FloatValue v+    setField w MinFloat l+    setField w MaxFloat u
src/IHaskell/Display/Widgets/Output.hs view
@@ -45,10 +45,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object ["model_name" .= str "WidgetModel"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the image widget   return widget
src/IHaskell/Display/Widgets/Selection/Dropdown.hs view
@@ -41,11 +41,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Dropdown"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Selection/RadioButtons.hs view
@@ -39,11 +39,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.RadioButtons"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Selection/Select.hs view
@@ -39,10 +39,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Select"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Selection/SelectMultiple.hs view
@@ -40,13 +40,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   [ "model_name" .= str "WidgetModel"-                   , "widget_class" .= str "IPython.SelectMultiple"-                   ]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Selection/ToggleButtons.hs view
@@ -44,13 +44,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   [ "model_name" .= str "WidgetModel"-                   , "widget_class" .= str "IPython.ToggleButtons"-                   ]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Singletons.hs view
@@ -5,14 +5,19 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE QuasiQuotes #-}+ module IHaskell.Display.Widgets.Singletons where -import Data.Singletons.TH+import           Data.Singletons.TH  -- Widget properties-singletons [d|+singletons+  [d|+   data Field = ViewModule              | ViewName+             | ModelModule+             | ModelName              | MsgThrottle              | Version              | DisplayHandler@@ -82,5 +87,8 @@              | Align              | Titles              | SelectedIndex+             | ReadOutMsg+             | Child+             | Selector              deriving (Eq, Ord, Show)-             |]+  |]
src/IHaskell/Display/Widgets/String/HTML.hs view
@@ -37,10 +37,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.HTML"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/String/Latex.hs view
@@ -37,10 +37,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Latex"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/String/Text.hs view
@@ -41,10 +41,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Text"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/String/TextArea.hs view
@@ -41,11 +41,9 @@   stateIO <- newIORef widgetState    let widget = IPythonWidget uuid stateIO-      initData = object-                   ["model_name" .= str "WidgetModel", "widget_class" .= str "IPython.Textarea"]    -- Open a comm for this widget, and store it in the kernel state-  widgetSendOpen widget initData $ toJSON widgetState+  widgetSendOpen widget $ toJSON widgetState    -- Return the widget   return widget
src/IHaskell/Display/Widgets/Types.hs view
@@ -12,14 +12,16 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE ExistentialQuantification #-}+ module IHaskell.Display.Widgets.Types where  -- | This module houses all the type-trickery needed to make widgets happen. ----- All widgets have a corresponding 'WidgetType', and some fields/attributes/properties as defined by--- the 'WidgetFields' type-family.+-- All widgets have a corresponding 'WidgetType', and some fields/attributes/properties as defined+-- by the 'WidgetFields' type-family. ----- Each widget field corresponds to a concrete haskell type, as given by the 'FieldType' type-family.+-- Each widget field corresponds to a concrete haskell type, as given by the 'FieldType'+-- type-family. -- -- Vinyl records are used to wrap together widget fields into a single 'WidgetState'. --@@ -29,157 +31,181 @@ -- SViewName :: SField ViewName -- @ ----- This allows the user to pass the type 'ViewName' without using Data.Proxy. In essence, a singleton--- is the only inhabitant (other than bottom) of a promoted type. Single element set/type == singleton.+-- This allows the user to pass the type 'ViewName' without using Data.Proxy. In essence, a+-- singleton is the only inhabitant (other than bottom) of a promoted type. Single element set/type+-- == singleton. -- -- It also allows the record to wrap values of properties with information about their Field type. A--- vinyl record is represented as @Rec f ts@, which means that a record is a list of @f x@, where @x@--- 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.+-- vinyl record is represented as @Rec f ts@, which means that a record is a list of @f x@, where+-- @x@ 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. -- -- 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--- 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@).+-- 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. 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--- at the supplied MsgSpec.md.+-- To know more about the IPython messaging specification (as implemented in this package) take a+-- look at the supplied MsgSpec.md. ----- Widgets are not able to do console input, the reason for that can also be found in the messaging+-- Widgets are not able to do console input, the reason for that can be found in the messaging -- specification-import Control.Monad (unless, join, when, void, mapM_)-import Control.Applicative ((<$>))+import           Control.Monad (unless, join, when, void, mapM_)+import           Control.Applicative ((<$>)) import qualified Control.Exception as Ex -import GHC.IO.Exception-import System.IO.Error-import System.Posix.IO+import           GHC.IO.Exception+import           System.IO.Error+import           System.Posix.IO -import Data.Aeson-import Data.Aeson.Types (Pair)-import Data.IORef (IORef, readIORef, modifyIORef)-import Data.Text (Text, pack)+import           Data.Aeson+import           Data.Aeson.Types (Pair)+import           Data.IORef (IORef, readIORef, modifyIORef)+import           Data.Text (Text, pack) -import Data.Vinyl (Rec (..), (<+>), recordToList, reifyConstraint, rmap, Dict (..))-import Data.Vinyl.Functor (Compose (..), Const (..))-import Data.Vinyl.Lens (rget, rput, type (∈))-import Data.Vinyl.TypeLevel (RecAll)+import           Data.Vinyl (Rec(..), (<+>), recordToList, reifyConstraint, rmap, Dict(..))+import           Data.Vinyl.Functor (Compose(..), Const(..))+import           Data.Vinyl.Lens (rget, rput, type (∈))+import           Data.Vinyl.TypeLevel (RecAll) -import Data.Singletons.Prelude ((:++))-import Data.Singletons.TH+import           Data.Singletons.Prelude ((:++))+import           Data.Singletons.TH -import IHaskell.Eval.Widgets (widgetSendUpdate)-import IHaskell.Display (Base64, IHaskellWidget (..))-import IHaskell.IPython.Message.UUID+import           IHaskell.Eval.Widgets (widgetSendUpdate)+import           IHaskell.Display (Base64, IHaskellWidget(..))+import           IHaskell.IPython.Message.UUID -import IHaskell.Display.Widgets.Singletons (Field, SField (..))+import           IHaskell.Display.Widgets.Singletons (Field, SField(..)) import qualified IHaskell.Display.Widgets.Singletons as S-import IHaskell.Display.Widgets.Common+import           IHaskell.Display.Widgets.Common  -- Classes from IPython's widget hierarchy. Defined as such to reduce code duplication.-type WidgetClass = '[ S.ViewModule, S.ViewName, S.MsgThrottle, S.Version, S.DisplayHandler ]-type DOMWidgetClass = WidgetClass :++-   '[ S.Visible, S.CSS, S.DOMClasses, S.Width, S.Height, S.Padding, S.Margin, S.Color-    , S.BackgroundColor, S.BorderColor, S.BorderWidth, S.BorderRadius, S.BorderStyle, S.FontStyle-    , S.FontWeight, S.FontSize, S.FontFamily-    ]+type WidgetClass = '[S.ViewModule, S.ViewName, S.ModelModule, S.ModelName,+  S.MsgThrottle, S.Version, S.DisplayHandler]++type DOMWidgetClass = WidgetClass :++ '[S.Visible, S.CSS, S.DOMClasses, S.Width, S.Height, S.Padding,+  S.Margin, S.Color, S.BackgroundColor, S.BorderColor, S.BorderWidth,+  S.BorderRadius, S.BorderStyle, S.FontStyle, S.FontWeight,+  S.FontSize, S.FontFamily]+ type StringClass = DOMWidgetClass :++ '[S.StringValue, S.Disabled, S.Description, S.Placeholder]+ type BoolClass = DOMWidgetClass :++ '[S.BoolValue, S.Disabled, S.Description, S.ChangeHandler]-type SelectionClass = DOMWidgetClass :++-   '[S.Options, S.SelectedValue, S.SelectedLabel, S.Disabled, S.Description, S.SelectionHandler]-type MultipleSelectionClass = DOMWidgetClass :++-   '[S.Options, S.SelectedLabels, S.SelectedValues, S.Disabled, S.Description, S.SelectionHandler]++type SelectionClass = DOMWidgetClass :++ '[S.Options, S.SelectedValue, S.SelectedLabel, S.Disabled,+  S.Description, S.SelectionHandler]++type MultipleSelectionClass = DOMWidgetClass :++ '[S.Options, S.SelectedValues, S.SelectedLabels, S.Disabled,+  S.Description, S.SelectionHandler]+ type IntClass = DOMWidgetClass :++ '[S.IntValue, S.Disabled, S.Description, S.ChangeHandler]+ type BoundedIntClass = IntClass :++ '[S.StepInt, S.MinInt, S.MaxInt]+ type IntRangeClass = IntClass :++ '[S.IntPairValue, S.LowerInt, S.UpperInt]+ type BoundedIntRangeClass = IntRangeClass :++ '[S.StepInt, S.MinInt, S.MaxInt]+ type FloatClass = DOMWidgetClass :++ '[S.FloatValue, S.Disabled, S.Description, S.ChangeHandler]+ type BoundedFloatClass = FloatClass :++ '[S.StepFloat, S.MinFloat, S.MaxFloat]+ type FloatRangeClass = FloatClass :++ '[S.FloatPairValue, S.LowerFloat, S.UpperFloat]+ type BoundedFloatRangeClass = FloatRangeClass :++ '[S.StepFloat, S.MinFloat, S.MaxFloat]+ type BoxClass = DOMWidgetClass :++ '[S.Children, S.OverflowX, S.OverflowY, S.BoxStyle]+ type SelectionContainerClass = BoxClass :++ '[S.Titles, S.SelectedIndex, S.ChangeHandler]  -- Types associated with Fields.+ type family FieldType (f :: Field) :: * where-  FieldType S.ViewModule = Text-  FieldType S.ViewName = Text-  FieldType S.MsgThrottle = Integer-  FieldType S.Version = Integer-  FieldType S.DisplayHandler = IO ()-  FieldType S.Visible = Bool-  FieldType S.CSS = [(Text, Text, Text)]-  FieldType S.DOMClasses = [Text]-  FieldType S.Width = StrInt-  FieldType S.Height = StrInt-  FieldType S.Padding = StrInt-  FieldType S.Margin = StrInt-  FieldType S.Color = Text-  FieldType S.BackgroundColor = Text-  FieldType S.BorderColor = Text-  FieldType S.BorderWidth = StrInt-  FieldType S.BorderRadius = StrInt-  FieldType S.BorderStyle = BorderStyleValue-  FieldType S.FontStyle = FontStyleValue-  FieldType S.FontWeight = FontWeightValue-  FieldType S.FontSize = StrInt-  FieldType S.FontFamily = Text-  FieldType S.Description = Text-  FieldType S.ClickHandler = IO ()-  FieldType S.SubmitHandler = IO ()-  FieldType S.Disabled = Bool-  FieldType S.StringValue = Text-  FieldType S.Placeholder = Text-  FieldType S.Tooltip = Text-  FieldType S.Icon = Text-  FieldType S.ButtonStyle = ButtonStyleValue-  FieldType S.B64Value = Base64-  FieldType S.ImageFormat = ImageFormatValue-  FieldType S.BoolValue = Bool-  FieldType S.Options = SelectionOptions-  FieldType S.SelectedLabel = Text-  FieldType S.SelectedValue = Text-  FieldType S.SelectionHandler = IO ()-  FieldType S.Tooltips = [Text]-  FieldType S.Icons = [Text]-  FieldType S.SelectedLabels = [Text]-  FieldType S.SelectedValues = [Text]-  FieldType S.IntValue = Integer-  FieldType S.StepInt = Integer-  FieldType S.MinInt = Integer-  FieldType S.MaxInt = Integer-  FieldType S.LowerInt = Integer-  FieldType S.UpperInt = Integer-  FieldType S.IntPairValue = (Integer, Integer)-  FieldType S.Orientation = OrientationValue-  FieldType S.ShowRange = Bool-  FieldType S.ReadOut = Bool-  FieldType S.SliderColor = Text-  FieldType S.BarStyle = BarStyleValue-  FieldType S.FloatValue = Double-  FieldType S.StepFloat = Double-  FieldType S.MinFloat = Double-  FieldType S.MaxFloat = Double-  FieldType S.LowerFloat = Double-  FieldType S.UpperFloat = Double-  FieldType S.FloatPairValue = (Double, Double)-  FieldType S.ChangeHandler = IO ()-  FieldType S.Children = [ChildWidget]-  FieldType S.OverflowX = OverflowValue-  FieldType S.OverflowY = OverflowValue-  FieldType S.BoxStyle = BoxStyleValue-  FieldType S.Flex = Int-  FieldType S.Pack = LocationValue-  FieldType S.Align = LocationValue-  FieldType S.Titles = [Text]-  FieldType S.SelectedIndex = Integer+        FieldType S.ViewModule = Text+        FieldType S.ViewName = Text+        FieldType S.ModelModule = Text+        FieldType S.ModelName = Text+        FieldType S.MsgThrottle = Integer+        FieldType S.Version = Integer+        FieldType S.DisplayHandler = IO ()+        FieldType S.Visible = Bool+        FieldType S.CSS = [(Text, Text, Text)]+        FieldType S.DOMClasses = [Text]+        FieldType S.Width = StrInt+        FieldType S.Height = StrInt+        FieldType S.Padding = StrInt+        FieldType S.Margin = StrInt+        FieldType S.Color = Text+        FieldType S.BackgroundColor = Text+        FieldType S.BorderColor = Text+        FieldType S.BorderWidth = StrInt+        FieldType S.BorderRadius = StrInt+        FieldType S.BorderStyle = BorderStyleValue+        FieldType S.FontStyle = FontStyleValue+        FieldType S.FontWeight = FontWeightValue+        FieldType S.FontSize = StrInt+        FieldType S.FontFamily = Text+        FieldType S.Description = Text+        FieldType S.ClickHandler = IO ()+        FieldType S.SubmitHandler = IO ()+        FieldType S.Disabled = Bool+        FieldType S.StringValue = Text+        FieldType S.Placeholder = Text+        FieldType S.Tooltip = Text+        FieldType S.Icon = Text+        FieldType S.ButtonStyle = ButtonStyleValue+        FieldType S.B64Value = Base64+        FieldType S.ImageFormat = ImageFormatValue+        FieldType S.BoolValue = Bool+        FieldType S.Options = SelectionOptions+        FieldType S.SelectedLabel = Text+        FieldType S.SelectedValue = Text+        FieldType S.SelectionHandler = IO ()+        FieldType S.Tooltips = [Text]+        FieldType S.Icons = [Text]+        FieldType S.SelectedLabels = [Text]+        FieldType S.SelectedValues = [Text]+        FieldType S.IntValue = Integer+        FieldType S.StepInt = Integer+        FieldType S.MinInt = Integer+        FieldType S.MaxInt = Integer+        FieldType S.LowerInt = Integer+        FieldType S.UpperInt = Integer+        FieldType S.IntPairValue = (Integer, Integer)+        FieldType S.Orientation = OrientationValue+        FieldType S.ShowRange = Bool+        FieldType S.ReadOut = Bool+        FieldType S.SliderColor = Text+        FieldType S.BarStyle = BarStyleValue+        FieldType S.FloatValue = Double+        FieldType S.StepFloat = Double+        FieldType S.MinFloat = Double+        FieldType S.MaxFloat = Double+        FieldType S.LowerFloat = Double+        FieldType S.UpperFloat = Double+        FieldType S.FloatPairValue = (Double, Double)+        FieldType S.ChangeHandler = IO ()+        FieldType S.Children = [ChildWidget]+        FieldType S.OverflowX = OverflowValue+        FieldType S.OverflowY = OverflowValue+        FieldType S.BoxStyle = BoxStyleValue+        FieldType S.Flex = Int+        FieldType S.Pack = LocationValue+        FieldType S.Align = LocationValue+        FieldType S.Titles = [Text]+        FieldType S.SelectedIndex = Integer+        FieldType S.ReadOutMsg = Text+        FieldType S.Child = Maybe ChildWidget+        FieldType S.Selector = Text  -- | 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)@@ -196,14 +222,14 @@ -- Set according to what IPython widgets use instance CustomBounded StrInt where   upperBound = 10 ^ 16 - 1-  lowerBound = - (10 ^ 16 - 1)+  lowerBound = -(10 ^ 16 - 1)  instance CustomBounded Integer where-  lowerBound = - (10 ^ 16 - 1)+  lowerBound = -(10 ^ 16 - 1)   upperBound = 10 ^ 16 - 1  instance CustomBounded Double where-  lowerBound = - (10 ** 16 - 1)+  lowerBound = -(10 ** 16 - 1)   upperBound = 10 ** 16 - 1  -- Different types of widgets. Every widget in IPython has a corresponding WidgetType@@ -216,6 +242,7 @@                 | TextAreaType                 | CheckBoxType                 | ToggleButtonType+                | ValidType                 | DropdownType                 | RadioButtonsType                 | SelectType@@ -232,43 +259,68 @@                 | FloatProgressType                 | FloatRangeSliderType                 | BoxType+                | ProxyType+                | PlaceProxyType                 | FlexBoxType                 | AccordionType                 | TabType  -- Fields associated with a widget+ type family WidgetFields (w :: WidgetType) :: [Field] where-  WidgetFields ButtonType = DOMWidgetClass :++ '[S.Description, S.Tooltip, S.Disabled, S.Icon, S.ButtonStyle, S.ClickHandler]-  WidgetFields ImageType = DOMWidgetClass :++ '[S.ImageFormat, S.B64Value]-  WidgetFields OutputType = DOMWidgetClass-  WidgetFields HTMLType = StringClass-  WidgetFields LatexType = StringClass-  WidgetFields TextType = StringClass :++ '[S.SubmitHandler, S.ChangeHandler]-  WidgetFields TextAreaType = StringClass :++ '[S.ChangeHandler]-  WidgetFields CheckBoxType = BoolClass-  WidgetFields ToggleButtonType = BoolClass :++ '[S.Tooltip, S.Icon, S.ButtonStyle]-  WidgetFields DropdownType = SelectionClass :++ '[S.ButtonStyle]-  WidgetFields RadioButtonsType = SelectionClass-  WidgetFields SelectType = SelectionClass-  WidgetFields ToggleButtonsType = SelectionClass :++ '[S.Tooltips, S.Icons, S.ButtonStyle]-  WidgetFields SelectMultipleType = MultipleSelectionClass-  WidgetFields IntTextType = IntClass-  WidgetFields BoundedIntTextType = BoundedIntClass-  WidgetFields IntSliderType = BoundedIntClass :++ '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]-  WidgetFields IntProgressType = BoundedIntClass :++ '[S.BarStyle]-  WidgetFields IntRangeSliderType = BoundedIntRangeClass :++ '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]-  WidgetFields FloatTextType = FloatClass-  WidgetFields BoundedFloatTextType = BoundedFloatClass-  WidgetFields FloatSliderType = BoundedFloatClass :++ '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]-  WidgetFields FloatProgressType = BoundedFloatClass :++ '[S.BarStyle]-  WidgetFields FloatRangeSliderType = BoundedFloatRangeClass :++ '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]-  WidgetFields BoxType = BoxClass-  WidgetFields FlexBoxType = BoxClass :++ '[S.Orientation, S.Flex, S.Pack, S.Align]-  WidgetFields AccordionType = SelectionContainerClass-  WidgetFields TabType = SelectionContainerClass+        WidgetFields ButtonType =+                                DOMWidgetClass :+++                                  '[S.Description, S.Tooltip, S.Disabled, S.Icon, S.ButtonStyle,+                                    S.ClickHandler]+        WidgetFields ImageType =+                               DOMWidgetClass :++ '[S.ImageFormat, S.Width, S.Height, S.B64Value]+        WidgetFields OutputType = DOMWidgetClass+        WidgetFields HTMLType = StringClass+        WidgetFields LatexType = StringClass+        WidgetFields TextType =+                              StringClass :++ '[S.SubmitHandler, S.ChangeHandler]+        WidgetFields TextAreaType = StringClass :++ '[S.ChangeHandler]+        WidgetFields CheckBoxType = BoolClass+        WidgetFields ToggleButtonType =+                                      BoolClass :++ '[S.Tooltip, S.Icon, S.ButtonStyle]+        WidgetFields ValidType = BoolClass :++ '[S.ReadOutMsg]+        WidgetFields DropdownType = SelectionClass :++ '[S.ButtonStyle]+        WidgetFields RadioButtonsType = SelectionClass+        WidgetFields SelectType = SelectionClass+        WidgetFields ToggleButtonsType =+                                       SelectionClass :++ '[S.Tooltips, S.Icons, S.ButtonStyle]+        WidgetFields SelectMultipleType = MultipleSelectionClass+        WidgetFields IntTextType = IntClass+        WidgetFields BoundedIntTextType = BoundedIntClass+        WidgetFields IntSliderType =+                                   BoundedIntClass :+++                                     '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]+        WidgetFields IntProgressType =+                                     BoundedIntClass :++ '[S.Orientation, S.BarStyle]+        WidgetFields IntRangeSliderType =+                                        BoundedIntRangeClass :+++                                          '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]+        WidgetFields FloatTextType = FloatClass+        WidgetFields BoundedFloatTextType = BoundedFloatClass+        WidgetFields FloatSliderType =+                                     BoundedFloatClass :+++                                       '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]+        WidgetFields FloatProgressType =+                                       BoundedFloatClass :++ '[S.Orientation, S.BarStyle]+        WidgetFields FloatRangeSliderType =+                                          BoundedFloatRangeClass :+++                                            '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]+        WidgetFields BoxType = BoxClass+        WidgetFields ProxyType = WidgetClass :++ '[S.Child]+        WidgetFields PlaceProxyType = WidgetFields ProxyType :++ '[S.Selector]+        WidgetFields FlexBoxType =+                                 BoxClass :++ '[S.Orientation, S.Flex, S.Pack, S.Align]+        WidgetFields AccordionType = SelectionContainerClass+        WidgetFields TabType = SelectionContainerClass  -- 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+data AttrVal a = Dummy a+               | Real a  unwrap :: AttrVal a -> a unwrap (Dummy x) = x@@ -276,98 +328,257 @@  -- Wrapper around a field. data Attr (f :: Field) =-  Attr { _value :: AttrVal (FieldType f)-       , _verify :: FieldType f -> IO (FieldType f)-       , _field :: 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+  toJSON attr =+    case _value attr of+      Dummy _ -> ""+      Real x  -> toJSON x  -- Types that can be converted to Aeson Pairs. class ToPairs a where   toPairs :: a -> [Pair]  -- Attributes that aren't synced with the frontend give [] on toPairs-instance ToPairs (Attr S.ViewModule) where toPairs x = ["_view_module" .= toJSON x]-instance ToPairs (Attr S.ViewName) where toPairs x = ["_view_name" .= toJSON x]-instance ToPairs (Attr S.MsgThrottle) where toPairs x = ["msg_throttle" .= toJSON x]-instance ToPairs (Attr S.Version) where toPairs x = ["version" .= toJSON x]-instance ToPairs (Attr S.DisplayHandler) where toPairs _ = [] -- Not sent to the frontend-instance ToPairs (Attr S.Visible) where toPairs x = ["visible" .= toJSON x]-instance ToPairs (Attr S.CSS) where toPairs x = ["_css" .= toJSON x]-instance ToPairs (Attr S.DOMClasses) where toPairs x = ["_dom_classes" .= toJSON x]-instance ToPairs (Attr S.Width) where toPairs x = ["width" .= toJSON x]-instance ToPairs (Attr S.Height) where toPairs x = ["height" .= toJSON x]-instance ToPairs (Attr S.Padding) where toPairs x = ["padding" .= toJSON x]-instance ToPairs (Attr S.Margin) where toPairs x = ["margin" .= toJSON x]-instance ToPairs (Attr S.Color) where toPairs x = ["color" .= toJSON x]-instance ToPairs (Attr S.BackgroundColor) where toPairs x = ["background_color" .= toJSON x]-instance ToPairs (Attr S.BorderColor) where toPairs x = ["border_color" .= toJSON x]-instance ToPairs (Attr S.BorderWidth) where toPairs x = ["border_width" .= toJSON x]-instance ToPairs (Attr S.BorderRadius) where toPairs x = ["border_radius" .= toJSON x]-instance ToPairs (Attr S.BorderStyle) where toPairs x = ["border_style" .= toJSON x]-instance ToPairs (Attr S.FontStyle) where toPairs x = ["font_style" .= toJSON x]-instance ToPairs (Attr S.FontWeight) where toPairs x = ["font_weight" .= toJSON x]-instance ToPairs (Attr S.FontSize) where toPairs x = ["font_size" .= toJSON x]-instance ToPairs (Attr S.FontFamily) where toPairs x = ["font_family" .= toJSON x]-instance ToPairs (Attr S.Description) where toPairs x = ["description" .= toJSON x]-instance ToPairs (Attr S.ClickHandler) where toPairs _ = [] -- Not sent to the frontend-instance ToPairs (Attr S.SubmitHandler) where toPairs _ = [] -- Not sent to the frontend-instance ToPairs (Attr S.Disabled) where toPairs x = ["disabled" .= toJSON x]-instance ToPairs (Attr S.StringValue) where toPairs x = ["value" .= toJSON x]-instance ToPairs (Attr S.Placeholder) where toPairs x = ["placeholder" .= toJSON x]-instance ToPairs (Attr S.Tooltip) where toPairs x = ["tooltip" .= toJSON x]-instance ToPairs (Attr S.Icon) where toPairs x = ["icon" .= toJSON x]-instance ToPairs (Attr S.ButtonStyle) where toPairs x = ["button_style" .= toJSON x]-instance ToPairs (Attr S.B64Value) where toPairs x = ["_b64value" .= toJSON x]-instance ToPairs (Attr S.ImageFormat) where toPairs x = ["format" .= toJSON x]-instance ToPairs (Attr S.BoolValue) where toPairs x = ["value" .= toJSON x]-instance ToPairs (Attr S.SelectedLabel) where toPairs x = ["selected_label" .= toJSON x]-instance ToPairs (Attr S.SelectedValue) where toPairs x = ["value" .= toJSON x]+instance ToPairs (Attr S.ViewModule) where+  toPairs x = ["_view_module" .= toJSON x]++instance ToPairs (Attr S.ViewName) where+  toPairs x = ["_view_name" .= toJSON x]++instance ToPairs (Attr S.ModelModule) where+  toPairs x = ["_model_module" .= toJSON x]++instance ToPairs (Attr S.ModelName) where+  toPairs x = ["_model_name" .= toJSON x]++instance ToPairs (Attr S.MsgThrottle) where+  toPairs x = ["msg_throttle" .= toJSON x]++instance ToPairs (Attr S.Version) where+  toPairs x = ["version" .= toJSON x]++instance ToPairs (Attr S.DisplayHandler) where+  toPairs _ = [] -- Not sent to the frontend++instance ToPairs (Attr S.Visible) where+  toPairs x = ["visible" .= toJSON x]++instance ToPairs (Attr S.CSS) where+  toPairs x = ["_css" .= toJSON x]++instance ToPairs (Attr S.DOMClasses) where+  toPairs x = ["_dom_classes" .= toJSON x]++instance ToPairs (Attr S.Width) where+  toPairs x = ["width" .= toJSON x]++instance ToPairs (Attr S.Height) where+  toPairs x = ["height" .= toJSON x]++instance ToPairs (Attr S.Padding) where+  toPairs x = ["padding" .= toJSON x]++instance ToPairs (Attr S.Margin) where+  toPairs x = ["margin" .= toJSON x]++instance ToPairs (Attr S.Color) where+  toPairs x = ["color" .= toJSON x]++instance ToPairs (Attr S.BackgroundColor) where+  toPairs x = ["background_color" .= toJSON x]++instance ToPairs (Attr S.BorderColor) where+  toPairs x = ["border_color" .= toJSON x]++instance ToPairs (Attr S.BorderWidth) where+  toPairs x = ["border_width" .= toJSON x]++instance ToPairs (Attr S.BorderRadius) where+  toPairs x = ["border_radius" .= toJSON x]++instance ToPairs (Attr S.BorderStyle) where+  toPairs x = ["border_style" .= toJSON x]++instance ToPairs (Attr S.FontStyle) where+  toPairs x = ["font_style" .= toJSON x]++instance ToPairs (Attr S.FontWeight) where+  toPairs x = ["font_weight" .= toJSON x]++instance ToPairs (Attr S.FontSize) where+  toPairs x = ["font_size" .= toJSON x]++instance ToPairs (Attr S.FontFamily) where+  toPairs x = ["font_family" .= toJSON x]++instance ToPairs (Attr S.Description) where+  toPairs x = ["description" .= toJSON x]++instance ToPairs (Attr S.ClickHandler) where+  toPairs _ = [] -- Not sent to the frontend++instance ToPairs (Attr S.SubmitHandler) where+  toPairs _ = [] -- Not sent to the frontend++instance ToPairs (Attr S.Disabled) where+  toPairs x = ["disabled" .= toJSON x]++instance ToPairs (Attr S.StringValue) where+  toPairs x = ["value" .= toJSON x]++instance ToPairs (Attr S.Placeholder) where+  toPairs x = ["placeholder" .= toJSON x]++instance ToPairs (Attr S.Tooltip) where+  toPairs x = ["tooltip" .= toJSON x]++instance ToPairs (Attr S.Icon) where+  toPairs x = ["icon" .= toJSON x]++instance ToPairs (Attr S.ButtonStyle) where+  toPairs x = ["button_style" .= toJSON x]++instance ToPairs (Attr S.B64Value) where+  toPairs x = ["_b64value" .= toJSON x]++instance ToPairs (Attr S.ImageFormat) where+  toPairs x = ["format" .= toJSON x]++instance ToPairs (Attr S.BoolValue) where+  toPairs x = ["value" .= toJSON x]++instance ToPairs (Attr S.SelectedLabel) where+  toPairs x = ["selected_label" .= toJSON x]++instance ToPairs (Attr S.SelectedValue) where+  toPairs x = ["value" .= toJSON x]+ instance ToPairs (Attr S.Options) where-  toPairs x = case _value x of-    Dummy _ -> labels ("" :: Text)-    Real (OptionLabels xs) -> labels xs-    Real (OptionDict xps) -> labels $ map fst xps-    where labels xs = ["_options_labels" .= xs]-instance ToPairs (Attr S.SelectionHandler) where toPairs _ = [] -- Not sent to the frontend-instance ToPairs (Attr S.Tooltips) where toPairs x = ["tooltips" .= toJSON x]-instance ToPairs (Attr S.Icons) where toPairs x = ["icons" .= toJSON x]-instance ToPairs (Attr S.SelectedLabels) where toPairs x = ["selected_labels" .= toJSON x]-instance ToPairs (Attr S.SelectedValues) where toPairs x = ["values" .= toJSON x]-instance ToPairs (Attr S.IntValue) where toPairs x = ["value" .= toJSON x]-instance ToPairs (Attr S.StepInt) where toPairs x = ["step" .= toJSON x]-instance ToPairs (Attr S.MinInt) where toPairs x = ["min" .= toJSON x]-instance ToPairs (Attr S.MaxInt) where toPairs x = ["max" .= toJSON x]-instance ToPairs (Attr S.IntPairValue) where toPairs x = ["value" .= toJSON x]-instance ToPairs (Attr S.LowerInt) where toPairs x = ["min" .= toJSON x]-instance ToPairs (Attr S.UpperInt) where toPairs x = ["max" .= toJSON x]-instance ToPairs (Attr S.FloatValue) where toPairs x = ["value" .= toJSON x]-instance ToPairs (Attr S.StepFloat) where toPairs x = ["step" .= toJSON x]-instance ToPairs (Attr S.MinFloat) where toPairs x = ["min" .= toJSON x]-instance ToPairs (Attr S.MaxFloat) where toPairs x = ["max" .= toJSON x]-instance ToPairs (Attr S.FloatPairValue) where toPairs x = ["value" .= toJSON x]-instance ToPairs (Attr S.LowerFloat) where toPairs x = ["min" .= toJSON x]-instance ToPairs (Attr S.UpperFloat) where toPairs x = ["max" .= toJSON x]-instance ToPairs (Attr S.Orientation) where toPairs x = ["orientation" .= toJSON x]-instance ToPairs (Attr S.ShowRange) where toPairs x = ["_range" .= toJSON x]-instance ToPairs (Attr S.ReadOut) where toPairs x = ["readout" .= toJSON x]-instance ToPairs (Attr S.SliderColor) where toPairs x = ["slider_color" .= toJSON x]-instance ToPairs (Attr S.BarStyle) where toPairs x = ["bar_style" .= toJSON x]-instance ToPairs (Attr S.ChangeHandler) where toPairs _ = [] -- Not sent to the frontend-instance ToPairs (Attr S.Children) where toPairs x = ["children" .= toJSON x]-instance ToPairs (Attr S.OverflowX) where toPairs x = ["overflow_x" .= toJSON x]-instance ToPairs (Attr S.OverflowY) where toPairs x = ["overflow_y" .= toJSON x]-instance ToPairs (Attr S.BoxStyle) where toPairs x = ["box_style" .= toJSON x]-instance ToPairs (Attr S.Flex) where toPairs x = ["flex" .= toJSON x]-instance ToPairs (Attr S.Pack) where toPairs x = ["pack" .= toJSON x]-instance ToPairs (Attr S.Align) where toPairs x = ["align" .= toJSON x]-instance ToPairs (Attr S.Titles) where toPairs x = ["_titles" .= toJSON x]-instance ToPairs (Attr S.SelectedIndex) where toPairs x = ["selected_index" .= toJSON x]+  toPairs x =+    case _value x of+      Dummy _                -> labels ("" :: Text)+      Real (OptionLabels xs) -> labels xs+      Real (OptionDict xps)  -> labels $ map fst xps+    where+      labels xs = ["_options_labels" .= xs] +instance ToPairs (Attr S.SelectionHandler) where+  toPairs _ = [] -- Not sent to the frontend++instance ToPairs (Attr S.Tooltips) where+  toPairs x = ["tooltips" .= toJSON x]++instance ToPairs (Attr S.Icons) where+  toPairs x = ["icons" .= toJSON x]++instance ToPairs (Attr S.SelectedLabels) where+  toPairs x = ["selected_labels" .= toJSON x]++instance ToPairs (Attr S.SelectedValues) where+  toPairs x = ["values" .= toJSON x]++instance ToPairs (Attr S.IntValue) where+  toPairs x = ["value" .= toJSON x]++instance ToPairs (Attr S.StepInt) where+  toPairs x = ["step" .= toJSON x]++instance ToPairs (Attr S.MinInt) where+  toPairs x = ["min" .= toJSON x]++instance ToPairs (Attr S.MaxInt) where+  toPairs x = ["max" .= toJSON x]++instance ToPairs (Attr S.IntPairValue) where+  toPairs x = ["value" .= toJSON x]++instance ToPairs (Attr S.LowerInt) where+  toPairs x = ["min" .= toJSON x]++instance ToPairs (Attr S.UpperInt) where+  toPairs x = ["max" .= toJSON x]++instance ToPairs (Attr S.FloatValue) where+  toPairs x = ["value" .= toJSON x]++instance ToPairs (Attr S.StepFloat) where+  toPairs x = ["step" .= toJSON x]++instance ToPairs (Attr S.MinFloat) where+  toPairs x = ["min" .= toJSON x]++instance ToPairs (Attr S.MaxFloat) where+  toPairs x = ["max" .= toJSON x]++instance ToPairs (Attr S.FloatPairValue) where+  toPairs x = ["value" .= toJSON x]++instance ToPairs (Attr S.LowerFloat) where+  toPairs x = ["min" .= toJSON x]++instance ToPairs (Attr S.UpperFloat) where+  toPairs x = ["max" .= toJSON x]++instance ToPairs (Attr S.Orientation) where+  toPairs x = ["orientation" .= toJSON x]++instance ToPairs (Attr S.ShowRange) where+  toPairs x = ["_range" .= toJSON x]++instance ToPairs (Attr S.ReadOut) where+  toPairs x = ["readout" .= toJSON x]++instance ToPairs (Attr S.SliderColor) where+  toPairs x = ["slider_color" .= toJSON x]++instance ToPairs (Attr S.BarStyle) where+  toPairs x = ["bar_style" .= toJSON x]++instance ToPairs (Attr S.ChangeHandler) where+  toPairs _ = [] -- Not sent to the frontend++instance ToPairs (Attr S.Children) where+  toPairs x = ["children" .= toJSON x]++instance ToPairs (Attr S.OverflowX) where+  toPairs x = ["overflow_x" .= toJSON x]++instance ToPairs (Attr S.OverflowY) where+  toPairs x = ["overflow_y" .= toJSON x]++instance ToPairs (Attr S.BoxStyle) where+  toPairs x = ["box_style" .= toJSON x]++instance ToPairs (Attr S.Flex) where+  toPairs x = ["flex" .= toJSON x]++instance ToPairs (Attr S.Pack) where+  toPairs x = ["pack" .= toJSON x]++instance ToPairs (Attr S.Align) where+  toPairs x = ["align" .= toJSON x]++instance ToPairs (Attr S.Titles) where+  toPairs x = ["_titles" .= toJSON x]++instance ToPairs (Attr S.SelectedIndex) where+  toPairs x = ["selected_index" .= toJSON x]++instance ToPairs (Attr S.ReadOutMsg) where+  toPairs x = ["readout" .= toJSON x]++instance ToPairs (Attr S.Child) where+  toPairs x = ["child" .= toJSON x]++instance ToPairs (Attr S.Selector) where+  toPairs x = ["selector" .= 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@@ -380,6 +591,7 @@   | l <= x && x <= u = return x   | l > x = Ex.throw Ex.Underflow   | u < x = Ex.throw Ex.Overflow+  | otherwise = error "The impossible happened in IHaskell.Display.Widgets.Types.rangeCheck"  -- | Store a numeric value, with verification mechanism for its range. ranged :: (SingI f, Num (FieldType f), Ord (FieldType f))@@ -390,166 +602,190 @@ -- 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)+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+-- | 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 defaultWidget :: FieldType S.ViewName -> Rec Attr WidgetClass defaultWidget viewName = (ViewModule =:: "")-                      :& (ViewName =:: viewName)-                      :& (MsgThrottle =:+ 3)-                      :& (Version =:: 0)-                      :& (DisplayHandler =:: return ())-                      :& RNil+                         :& (ViewName =:: viewName)+                         :& (ModelModule =:: "")+                         :& (ModelName =:: "WidgetModel")+                         :& (MsgThrottle =:+ 3)+                         :& (Version =:: 0)+                         :& (DisplayHandler =:: return ())+                         :& RNil  -- | A record representing an object of the DOMWidget class from IPython defaultDOMWidget :: FieldType S.ViewName -> Rec Attr DOMWidgetClass defaultDOMWidget viewName = defaultWidget viewName <+> domAttrs-  where domAttrs = (Visible =:: True)-                :& (CSS =:: [])-                :& (DOMClasses =:: [])-                :& (Width =:+ 0)-                :& (Height =:+ 0)-                :& (Padding =:+ 0)-                :& (Margin =:+ 0)-                :& (Color =:: "")-                :& (BackgroundColor =:: "")-                :& (BorderColor =:: "")-                :& (BorderWidth =:+ 0)-                :& (BorderRadius =:+ 0)-                :& (BorderStyle =:: DefaultBorder)-                :& (FontStyle =:: DefaultFont)-                :& (FontWeight =:: DefaultWeight)-                :& (FontSize =:+ 0)-                :& (FontFamily =:: "")-                :& RNil+  where+    domAttrs = (Visible =:: True)+               :& (CSS =:: [])+               :& (DOMClasses =:: [])+               :& (Width =:+ 0)+               :& (Height =:+ 0)+               :& (Padding =:+ 0)+               :& (Margin =:+ 0)+               :& (Color =:: "")+               :& (BackgroundColor =:: "")+               :& (BorderColor =:: "")+               :& (BorderWidth =:+ 0)+               :& (BorderRadius =:+ 0)+               :& (BorderStyle =:: DefaultBorder)+               :& (FontStyle =:: DefaultFont)+               :& (FontWeight =:: DefaultWeight)+               :& (FontSize =:+ 0)+               :& (FontFamily =:: "")+               :& RNil  -- | A record representing a widget of the _String class from IPython defaultStringWidget :: FieldType S.ViewName -> Rec Attr StringClass defaultStringWidget viewName = defaultDOMWidget viewName <+> strAttrs-  where strAttrs = (StringValue =:: "")-                :& (Disabled =:: False)-                :& (Description =:: "")-                :& (Placeholder =:: "")-                :& RNil+  where+    strAttrs = (StringValue =:: "")+               :& (Disabled =:: False)+               :& (Description =:: "")+               :& (Placeholder =:: "")+               :& RNil  -- | A record representing a widget of the _Bool class from IPython defaultBoolWidget :: FieldType S.ViewName -> Rec Attr BoolClass defaultBoolWidget viewName = defaultDOMWidget viewName <+> boolAttrs-  where boolAttrs = (BoolValue =:: False)-                 :& (Disabled =:: False)-                 :& (Description =:: "")-                 :& (ChangeHandler =:: return ())-                 :& RNil+  where+    boolAttrs = (BoolValue =:: False)+                :& (Disabled =:: False)+                :& (Description =:: "")+                :& (ChangeHandler =:: return ())+                :& RNil  -- | A record representing a widget of the _Selection class from IPython defaultSelectionWidget :: FieldType S.ViewName -> Rec Attr SelectionClass defaultSelectionWidget viewName = defaultDOMWidget viewName <+> selectionAttrs-  where selectionAttrs = (Options =:: OptionLabels [])-                      :& (SelectedValue =:: "")-                      :& (SelectedLabel =:: "")-                      :& (Disabled =:: False)-                      :& (Description =:: "")-                      :& (SelectionHandler =:: return ())-                      :& RNil+  where+    selectionAttrs = (Options =:: OptionLabels [])+                     :& (SelectedValue =:: "")+                     :& (SelectedLabel =:: "")+                     :& (Disabled =:: False)+                     :& (Description =:: "")+                     :& (SelectionHandler =:: return ())+                     :& RNil  -- | A record representing a widget of the _MultipleSelection class from IPython defaultMultipleSelectionWidget :: FieldType S.ViewName -> Rec Attr MultipleSelectionClass defaultMultipleSelectionWidget viewName = defaultDOMWidget viewName <+> mulSelAttrs-  where mulSelAttrs = (Options =:: OptionLabels [])-                   :& (SelectedLabels =:: [])-                   :& (SelectedValues =:: [])-                   :& (Disabled =:: False)-                   :& (Description =:: "")-                   :& (SelectionHandler =:: return ())-                   :& RNil+  where+    mulSelAttrs = (Options =:: OptionLabels [])+                  :& (SelectedValues =:: [])+                  :& (SelectedLabels =:: [])+                  :& (Disabled =:: False)+                  :& (Description =:: "")+                  :& (SelectionHandler =:: return ())+                  :& RNil  -- | A record representing a widget of the _Int class from IPython defaultIntWidget :: FieldType S.ViewName -> Rec Attr IntClass defaultIntWidget viewName = defaultDOMWidget viewName <+> intAttrs-  where intAttrs = (IntValue =:: 0)-                :& (Disabled =:: False)-                :& (Description =:: "")-                :& (ChangeHandler =:: return ())-                :& RNil+  where+    intAttrs = (IntValue =:: 0)+               :& (Disabled =:: False)+               :& (Description =:: "")+               :& (ChangeHandler =:: return ())+               :& RNil  -- | A record representing a widget of the _BoundedInt class from IPython defaultBoundedIntWidget :: FieldType S.ViewName -> Rec Attr BoundedIntClass defaultBoundedIntWidget viewName = defaultIntWidget viewName <+> boundedIntAttrs-  where boundedIntAttrs = (StepInt =:: 1)-                       :& (MinInt =:: 0)-                       :& (MaxInt =:: 100)-                       :& RNil+  where+    boundedIntAttrs = (StepInt =:: 1)+                      :& (MinInt =:: 0)+                      :& (MaxInt =:: 100)+                      :& RNil  -- | A record representing a widget of the _BoundedInt class from IPython defaultIntRangeWidget :: FieldType S.ViewName -> Rec Attr IntRangeClass defaultIntRangeWidget viewName = defaultIntWidget viewName <+> rangeAttrs-  where rangeAttrs = (IntPairValue =:: (25, 75))-                  :& (LowerInt =:: 0)-                  :& (UpperInt =:: 100)-                  :& RNil+  where+    rangeAttrs = (IntPairValue =:: (25, 75))+                 :& (LowerInt =:: 0)+                 :& (UpperInt =:: 100)+                 :& RNil  -- | A record representing a widget of the _BoundedIntRange class from IPython defaultBoundedIntRangeWidget :: FieldType S.ViewName -> Rec Attr BoundedIntRangeClass defaultBoundedIntRangeWidget viewName = defaultIntRangeWidget viewName <+> boundedIntRangeAttrs-  where boundedIntRangeAttrs = (StepInt =:+ 1)-                            :& (MinInt =:: 0)-                            :& (MaxInt =:: 100)-                            :& RNil+  where+    boundedIntRangeAttrs = (StepInt =:+ 1)+                           :& (MinInt =:: 0)+                           :& (MaxInt =:: 100)+                           :& RNil  -- | A record representing a widget of the _Float class from IPython defaultFloatWidget :: FieldType S.ViewName -> Rec Attr FloatClass defaultFloatWidget viewName = defaultDOMWidget viewName <+> intAttrs-  where intAttrs = (FloatValue =:: 0)-                :& (Disabled =:: False)-                :& (Description =:: "")-                :& (ChangeHandler =:: return ())-                :& RNil+  where+    intAttrs = (FloatValue =:: 0)+               :& (Disabled =:: False)+               :& (Description =:: "")+               :& (ChangeHandler =:: return ())+               :& RNil  -- | A record representing a widget of the _BoundedFloat class from IPython defaultBoundedFloatWidget :: FieldType S.ViewName -> Rec Attr BoundedFloatClass defaultBoundedFloatWidget viewName = defaultFloatWidget viewName <+> boundedFloatAttrs-  where boundedFloatAttrs = (StepFloat =:+ 1)-                         :& (MinFloat =:: 0)-                         :& (MaxFloat =:: 100)-                         :& RNil+  where+    boundedFloatAttrs = (StepFloat =:+ 1)+                        :& (MinFloat =:: 0)+                        :& (MaxFloat =:: 100)+                        :& RNil  -- | A record representing a widget of the _BoundedFloat class from IPython defaultFloatRangeWidget :: FieldType S.ViewName -> Rec Attr FloatRangeClass defaultFloatRangeWidget viewName = defaultFloatWidget viewName <+> rangeAttrs-  where rangeAttrs = (FloatPairValue =:: (25, 75))-                  :& (LowerFloat =:: 0)-                  :& (UpperFloat =:: 100)-                  :& RNil+  where+    rangeAttrs = (FloatPairValue =:: (25, 75))+                 :& (LowerFloat =:: 0)+                 :& (UpperFloat =:: 100)+                 :& RNil  -- | A record representing a widget of the _BoundedFloatRange class from IPython defaultBoundedFloatRangeWidget :: FieldType S.ViewName -> Rec Attr BoundedFloatRangeClass defaultBoundedFloatRangeWidget viewName = defaultFloatRangeWidget viewName <+> boundedFloatRangeAttrs-  where boundedFloatRangeAttrs = (StepFloat =:+ 1)-                              :& (MinFloat =:: 0)-                              :& (MaxFloat =:: 100)-                              :& RNil+  where+    boundedFloatRangeAttrs = (StepFloat =:+ 1)+                             :& (MinFloat =:: 0)+                             :& (MaxFloat =:: 100)+                             :& RNil  -- | A record representing a widget of the _Box class from IPython defaultBoxWidget :: FieldType S.ViewName -> Rec Attr BoxClass-defaultBoxWidget viewName = defaultDOMWidget viewName <+> boxAttrs-  where boxAttrs = (Children =:: [])-                :& (OverflowX =:: DefaultOverflow)-                :& (OverflowY =:: DefaultOverflow)-                :& (BoxStyle =:: DefaultBox)-                :& RNil+defaultBoxWidget viewName = domAttrs <+> boxAttrs+  where+    defaultDOM = defaultDOMWidget viewName+    domAttrs = rput (ModelName =:: "BoxModel") defaultDOM+    boxAttrs = (Children =:: [])+               :& (OverflowX =:: DefaultOverflow)+               :& (OverflowY =:: DefaultOverflow)+               :& (BoxStyle =:: DefaultBox)+               :& RNil  -- | A record representing a widget of the _SelectionContainer class from IPython defaultSelectionContainerWidget :: FieldType S.ViewName -> Rec Attr SelectionContainerClass defaultSelectionContainerWidget viewName = defaultBoxWidget viewName <+> selAttrs-  where selAttrs = (Titles =:: [])-                :& (SelectedIndex =:: 0)-                :& (ChangeHandler =:: return ())-                :& RNil+  where+    selAttrs = (Titles =:: [])+               :& (SelectedIndex =:: 0)+               :& (ChangeHandler =:: return ())+               :& RNil  newtype WidgetState w = WidgetState { _getState :: Rec Attr (WidgetFields w) } @@ -558,11 +794,15 @@   toJSON record =     object     . concat-    . recordToList-    . rmap (\(Compose (Dict x)) -> Const $ toPairs x)-    $ reifyConstraint (Proxy :: Proxy ToPairs) $ _getState record+      . recordToList+        . rmap (\(Compose (Dict x)) -> Const $ toPairs x) $ reifyConstraint (Proxy :: Proxy ToPairs) $ _getState+                                                                                                         record -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. setField :: (f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w), ToPairs (Attr f))