ihaskell-widgets: Turn on -Wall and fix all warnings

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

@@ -50,6 +50,11 @@ extra-source-files:  README.md, MsgSpec.md
 cabal-version:       >=1.10
 
 library
+  ghc-options:         -Wall
+
+  if impl (ghc >= 8.4)
+    ghc-options:       -Wpartial-fields
+
   -- Modules exported by the library.
   exposed-modules:     IHaskell.Display.Widgets
                        IHaskell.Display.Widgets.Interactive

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

@@ -3,19 +3,21 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Bool.CheckBox (
--- * The CheckBox Widget
-CheckBox, 
-          -- * Constructor
-          mkCheckBox) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+module IHaskell.Display.Widgets.Bool.CheckBox
+  ( -- * The CheckBox Widget
+    CheckBox
+    -- * Constructor
+  , mkCheckBox
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
+import           Control.Monad (void)
 import           Data.Aeson
-import           Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
-import           Data.Text (Text)
 
 import           IHaskell.Display
 import           IHaskell.Eval.Widgets
@@ -25,19 +27,19 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'CheckBox' represents a Checkbox widget from IPython.html.widgets.
-type CheckBox = IPythonWidget CheckBoxType
+type CheckBox = IPythonWidget 'CheckBoxType
 
 -- | Create a new output widget
 mkCheckBox :: IO CheckBox
 mkCheckBox = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let widgetState = WidgetState $ defaultBoolWidget "CheckboxView" "CheckboxModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -52,10 +54,9 @@ instance IHaskellDisplay CheckBox where
 
 instance IHaskellWidget CheckBox where
   getCommUUID = uuid
-  comm widget (Object dict1) _ = do
-    let key1 = "sync_data" :: Text
-        key2 = "value" :: Text
-        Just (Object dict2) = HM.lookup key1 dict1
-        Just (Bool value) = HM.lookup key2 dict2
-    setField' widget BoolValue value
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Bool value) -> do
+        void $ setField' widget BoolValue value
+        triggerChange widget
+      _ -> pure ()

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

@@ -3,19 +3,21 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Bool.ToggleButton (
--- * The ToggleButton Widget
-ToggleButton, 
-              -- * Constructor
-              mkToggleButton) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+module IHaskell.Display.Widgets.Bool.ToggleButton
+  ( -- * The ToggleButton Widget
+    ToggleButton
+    -- * Constructor
+  , mkToggleButton
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
+import           Control.Monad (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
@@ -26,13 +28,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'ToggleButton' represents a ToggleButton widget from IPython.html.widgets.
-type ToggleButton = IPythonWidget ToggleButtonType
+type ToggleButton = IPythonWidget 'ToggleButtonType
 
 -- | Create a new output widget
 mkToggleButton :: IO ToggleButton
 mkToggleButton = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let boolState = defaultBoolWidget "ToggleButtonView" "ToggleButtonModel"
       toggleState = (Tooltip =:: "")
@@ -43,7 +45,7 @@ mkToggleButton = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -58,10 +60,9 @@ instance IHaskellDisplay ToggleButton where
 
 instance IHaskellWidget ToggleButton where
   getCommUUID = uuid
-  comm widget (Object dict1) _ = do
-    let key1 = "sync_data" :: Text
-        key2 = "value" :: Text
-        Just (Object dict2) = HM.lookup key1 dict1
-        Just (Bool value) = HM.lookup key2 dict2
-    setField' widget BoolValue value
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Bool value) -> do
+        void $ setField' widget BoolValue value
+        triggerChange widget
+      _ -> pure ()

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

@@ -3,11 +3,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Bool.Valid (
--- * The Valid Widget
-ValidWidget, 
-             -- * Constructor
-             mkValidWidget) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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
@@ -24,13 +27,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'ValidWidget' represents a Valid widget from IPython.html.widgets.
-type ValidWidget = IPythonWidget ValidType
+type ValidWidget = IPythonWidget 'ValidType
 
 -- | Create a new output widget
 mkValidWidget :: IO ValidWidget
 mkValidWidget = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let boolState = defaultBoolWidget "ValidView" "ValidModel"
       validState = (ReadOutMsg =:: "") :& RNil
@@ -38,7 +41,7 @@ mkValidWidget = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState

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

@@ -3,11 +3,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Box.Box (
--- * The Box widget
-Box, 
-     -- * Constructor
-     mkBox) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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
@@ -22,19 +25,19 @@ import           IHaskell.IPython.Message.UUID as U
 import           IHaskell.Display.Widgets.Types
 
 -- | A 'Box' represents a Box widget from IPython.html.widgets.
-type Box = IPythonWidget BoxType
+type Box = IPythonWidget 'BoxType
 
 -- | Create a new box
 mkBox :: IO Box
 mkBox = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let widgetState = WidgetState $ defaultBoxWidget "BoxView" "BoxModel"
 
   stateIO <- newIORef widgetState
 
-  let box = IPythonWidget uuid stateIO
+  let box = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen box $ toJSON widgetState

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

@@ -3,20 +3,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Box.SelectionContainer.Accordion (
--- * The Accordion widget
-Accordion, 
-           -- * Constructor
-           mkAccordion) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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 (void)
 import           Data.Aeson
-import           Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
 import qualified Data.Scientific as Sci
-import           Data.Text (Text)
 
 import           IHaskell.Display
 import           IHaskell.Eval.Widgets
@@ -26,19 +28,19 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'Accordion' represents a Accordion widget from IPython.html.widgets.
-type Accordion = IPythonWidget AccordionType
+type Accordion = IPythonWidget 'AccordionType
 
 -- | Create a new box
 mkAccordion :: IO Accordion
 mkAccordion = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let widgetState = WidgetState $ defaultSelectionContainerWidget "AccordionView" "AccordionModel"
 
   stateIO <- newIORef widgetState
 
-  let box = IPythonWidget uuid stateIO
+  let box = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen box $ toJSON widgetState
@@ -53,10 +55,9 @@ instance IHaskellDisplay Accordion where
 
 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 SelectedIndex (Sci.coefficient num)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "selected_index"] of
+      Just (Number num) -> do
+        void $ setField' widget SelectedIndex (Sci.coefficient num)
+        triggerChange widget
+      _ -> pure ()

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

@@ -3,20 +3,21 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Box.SelectionContainer.Tab (
--- * The Tab widget
-TabWidget, 
-           -- * Constructor
-           mkTabWidget) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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           Data.Aeson
-import           Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
 import qualified Data.Scientific as Sci
-import           Data.Text (Text)
 
 import           IHaskell.Display
 import           IHaskell.Eval.Widgets
@@ -26,19 +27,19 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'TabWidget' represents a Tab widget from IPython.html.widgets.
-type TabWidget = IPythonWidget TabType
+type TabWidget = IPythonWidget 'TabType
 
 -- | Create a new box
 mkTabWidget :: IO TabWidget
 mkTabWidget = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let widgetState = WidgetState $ defaultSelectionContainerWidget "TabView" "TabModel"
 
   stateIO <- newIORef widgetState
 
-  let box = IPythonWidget uuid stateIO
+  let box = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen box $ toJSON widgetState
@@ -53,10 +54,9 @@ instance IHaskellDisplay TabWidget where
 
 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 SelectedIndex (Sci.coefficient num)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "selected_index"] of
+      Just (Number num) -> do
+        _ <- setField' widget SelectedIndex (Sci.coefficient num)
+        triggerChange widget
+      _ -> pure ()

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

@@ -3,20 +3,20 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Button (
--- * The Button Widget
-Button, 
-        -- * Create a new button
-        mkButton) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+module IHaskell.Display.Widgets.Button
+  ( -- * The Button Widget
+    Button
+    -- * Create a new button
+  , mkButton
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when)
 import           Data.Aeson
-import           Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
-import           Data.Text (Text)
 import           Data.Vinyl (Rec(..), (<+>))
 
 import           IHaskell.Display
@@ -27,13 +27,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'Button' represents a Button from IPython.html.widgets.
-type Button = IPythonWidget ButtonType
+type Button = IPythonWidget 'ButtonType
 
 -- | Create a new button
 mkButton :: IO Button
 mkButton = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let dom = defaultDOMWidget "ButtonView" "ButtonModel"
       but = (Description =:: "")
@@ -47,7 +47,7 @@ mkButton = do
 
   stateIO <- newIORef buttonState
 
-  let button = IPythonWidget uuid stateIO
+  let button = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen button $ toJSON buttonState
@@ -62,9 +62,7 @@ instance IHaskellDisplay Button where
 
 instance IHaskellWidget Button where
   getCommUUID = uuid
-  comm widget (Object dict1) _ = do
-    let key1 = "content" :: Text
-        key2 = "event" :: Text
-        Just (Object dict2) = HM.lookup key1 dict1
-        Just (String event) = HM.lookup key2 dict2
-    when (event == "click") $ triggerClick widget
+  comm widget val _ =
+    case nestedObjectLookup val ["content", "event"] of
+      Just (String "click") -> triggerClick widget
+      _ -> pure ()

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

@@ -7,10 +7,16 @@
 {-# LANGUAGE AutoDeriveTypeable #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 
+-- There are lots of pattern synpnyms, and little would be gained by adding
+-- the type signatures.
+{-# OPTIONS_GHC -fno-warn-missing-pattern-synonym-signatures #-}
+{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+
 module IHaskell.Display.Widgets.Common where
 
 import           Data.Aeson
 import           Data.Aeson.Types (emptyObject)
+import           Data.HashMap.Strict as HM
 import           Data.Text (pack, Text)
 import           Data.Typeable (Typeable)
 
@@ -268,3 +274,11 @@ instance ToJSON LocationValue where
   toJSON EndLocation = "end"
   toJSON BaselineLocation = "baseline"
   toJSON StretchLocation = "stretch"
+
+-- Could use 'lens-aeson' here but this is easier to read.
+nestedObjectLookup :: Value -> [Text] -> Maybe Value
+nestedObjectLookup val [] = Just val
+nestedObjectLookup val (x:xs) =
+  case val of
+    Object o -> maybe Nothing (`nestedObjectLookup` xs) $ HM.lookup x o
+    _ -> Nothing

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/BoundedFloatText.hs

@@ -3,21 +3,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Float.BoundedFloat.BoundedFloatText (
--- * The BoundedFloatText
--- Widget
-BoundedFloatText, 
-                  -- * Constructor
-                  mkBoundedFloatText) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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 (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           IHaskell.Display
 import           IHaskell.Eval.Widgets
@@ -27,19 +28,19 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'BoundedFloatText' represents an BoundedFloatText widget from IPython.html.widgets.
-type BoundedFloatText = IPythonWidget BoundedFloatTextType
+type BoundedFloatText = IPythonWidget 'BoundedFloatTextType
 
 -- | Create a new widget
 mkBoundedFloatText :: IO BoundedFloatText
 mkBoundedFloatText = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let widgetState = WidgetState $ defaultBoundedFloatWidget "FloatTextView" "FloatTextModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -54,10 +55,9 @@ instance IHaskellDisplay BoundedFloatText where
 
 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 FloatValue (Sci.toRealFloat value)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Number value) -> do
+        void $ setField' widget FloatValue (Sci.toRealFloat value)
+        triggerChange widget
+      _ -> pure ()

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatProgress.hs

@@ -3,11 +3,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Float.BoundedFloat.FloatProgress (
--- * The FloatProgress Widget
-FloatProgress, 
-               -- * Constructor
-               mkFloatProgress) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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
@@ -24,13 +27,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'FloatProgress' represents an FloatProgress widget from IPython.html.widgets.
-type FloatProgress = IPythonWidget FloatProgressType
+type FloatProgress = IPythonWidget 'FloatProgressType
 
 -- | Create a new widget
 mkFloatProgress :: IO FloatProgress
 mkFloatProgress = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let boundedFloatAttrs = defaultBoundedFloatWidget "ProgressView" "ProgressModel"
       progressAttrs = (Orientation =:: HorizontalOrientation)
@@ -40,7 +43,7 @@ mkFloatProgress = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatSlider.hs

@@ -3,20 +3,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider (
--- * The FloatSlider Widget
-FloatSlider, 
-             -- * Constructor
-             mkFloatSlider) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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 (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
@@ -27,13 +29,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'FloatSlider' represents an FloatSlider widget from IPython.html.widgets.
-type FloatSlider = IPythonWidget FloatSliderType
+type FloatSlider = IPythonWidget 'FloatSliderType
 
 -- | Create a new widget
 mkFloatSlider :: IO FloatSlider
 mkFloatSlider = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let boundedFloatAttrs = defaultBoundedFloatWidget "FloatSliderView" "FloatSliderModel"
       sliderAttrs = (Orientation =:: HorizontalOrientation)
@@ -45,7 +47,7 @@ mkFloatSlider = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -60,10 +62,9 @@ instance IHaskellDisplay FloatSlider where
 
 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 FloatValue (Sci.toRealFloat value)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Number value) -> do
+        void $ setField' widget FloatValue (Sci.toRealFloat value)
+        triggerChange widget
+      _ -> pure ()

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloatRange/FloatRangeSlider.hs

@@ -3,21 +3,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider (
--- * The FloatRangeSlider
--- Widget
-FloatRangeSlider, 
-                  -- * Constructor
-                  mkFloatRangeSlider) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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.Monad (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(..), (<+>))
 
@@ -29,13 +30,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'FloatRangeSlider' represents an FloatRangeSlider widget from IPython.html.widgets.
-type FloatRangeSlider = IPythonWidget FloatRangeSliderType
+type FloatRangeSlider = IPythonWidget 'FloatRangeSliderType
 
 -- | Create a new widget
 mkFloatRangeSlider :: IO FloatRangeSlider
 mkFloatRangeSlider = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let boundedFloatAttrs = defaultBoundedFloatRangeWidget "FloatSliderView" "FloatSliderModel"
       sliderAttrs = (Orientation =:: HorizontalOrientation)
@@ -47,7 +48,7 @@ mkFloatRangeSlider = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -62,11 +63,12 @@ instance IHaskellDisplay FloatRangeSlider where
 
 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 FloatPairValue (x, y)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Array values) ->
+        case map (\(Number x) -> Sci.toRealFloat x) $ V.toList values of
+          [x, y] -> do
+            void $ setField' widget FloatPairValue (x, y)
+            triggerChange widget
+          _ -> pure ()
+      _ -> pure ()

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

@@ -3,20 +3,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Float.FloatText (
--- * The FloatText Widget
-FloatText, 
-           -- * Constructor
-           mkFloatText) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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 (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           IHaskell.Display
 import           IHaskell.Eval.Widgets
@@ -26,19 +28,19 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'FloatText' represents an FloatText widget from IPython.html.widgets.
-type FloatText = IPythonWidget FloatTextType
+type FloatText = IPythonWidget 'FloatTextType
 
 -- | Create a new widget
 mkFloatText :: IO FloatText
 mkFloatText = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let widgetState = WidgetState $ defaultFloatWidget "FloatTextView" "FloatTextModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -53,10 +55,9 @@ instance IHaskellDisplay FloatText where
 
 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 FloatValue (Sci.toRealFloat value)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Number value) -> do
+        void $ setField' widget FloatValue (Sci.toRealFloat value)
+        triggerChange widget
+      _ -> pure ()

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

@@ -3,11 +3,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Image (
--- * The Image Widget
-ImageWidget, 
-             -- * Constructor
-             mkImageWidget) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.Image
+  ( -- * The Image Widget
+    ImageWidget
+    -- * Constructor
+  , mkImageWidget
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
@@ -25,13 +28,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | An 'ImageWidget' represents a Image widget from IPython.html.widgets.
-type ImageWidget = IPythonWidget ImageType
+type ImageWidget = IPythonWidget 'ImageType
 
 -- | Create a new image widget
 mkImageWidget :: IO ImageWidget
 mkImageWidget = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let dom = defaultDOMWidget "ImageView" "ImageModel"
       img = (ImageFormat =:: PNG)
@@ -43,7 +46,7 @@ mkImageWidget = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs

@@ -3,20 +3,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText (
--- * The BoundedIntText Widget
-BoundedIntText, 
-                -- * Constructor
-                mkBoundedIntText) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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 (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           IHaskell.Display
 import           IHaskell.Eval.Widgets
@@ -26,19 +28,19 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'BoundedIntText' represents an BoundedIntText widget from IPython.html.widgets.
-type BoundedIntText = IPythonWidget BoundedIntTextType
+type BoundedIntText = IPythonWidget 'BoundedIntTextType
 
 -- | Create a new widget
 mkBoundedIntText :: IO BoundedIntText
 mkBoundedIntText = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let widgetState = WidgetState $ defaultBoundedIntWidget "IntTextView" "IntTextModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -53,10 +55,9 @@ instance IHaskellDisplay BoundedIntText where
 
 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 IntValue (Sci.coefficient value)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Number value) -> do
+        void $ setField' widget IntValue (Sci.coefficient value)
+        triggerChange widget
+      _ -> pure ()

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs

@@ -3,11 +3,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Int.BoundedInt.IntProgress (
--- * The IntProgress Widget
-IntProgress, 
-             -- * Constructor
-             mkIntProgress) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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
@@ -24,13 +27,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'IntProgress' represents an IntProgress widget from IPython.html.widgets.
-type IntProgress = IPythonWidget IntProgressType
+type IntProgress = IPythonWidget 'IntProgressType
 
 -- | Create a new widget
 mkIntProgress :: IO IntProgress
 mkIntProgress = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let boundedIntAttrs = defaultBoundedIntWidget "ProgressView" "ProgressModel"
       progressAttrs = (Orientation =:: HorizontalOrientation)
@@ -40,7 +43,7 @@ mkIntProgress = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs

@@ -3,20 +3,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Int.BoundedInt.IntSlider (
--- * The IntSlider Widget
-IntSlider, 
-           -- * Constructor
-           mkIntSlider) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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 (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
@@ -27,13 +29,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'IntSlider' represents an IntSlider widget from IPython.html.widgets.
-type IntSlider = IPythonWidget IntSliderType
+type IntSlider = IPythonWidget 'IntSliderType
 
 -- | Create a new widget
 mkIntSlider :: IO IntSlider
 mkIntSlider = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let boundedIntAttrs = defaultBoundedIntWidget "IntSliderView" "IntSliderModel"
       sliderAttrs = (Orientation =:: HorizontalOrientation)
@@ -45,7 +47,7 @@ mkIntSlider = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -60,10 +62,9 @@ instance IHaskellDisplay IntSlider where
 
 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 IntValue (Sci.coefficient value)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Number value) -> do
+        void $ setField' widget IntValue (Sci.coefficient value)
+        triggerChange widget
+      _ -> pure ()

ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs

@@ -3,20 +3,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider (
--- * The IntRangeSlider Widget
-IntRangeSlider, 
-                -- * Constructor
-                mkIntRangeSlider) where
+{-# OPTIONS_GHC -fno-warn-orphans  #-}
+
+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 (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(..), (<+>))
 
@@ -28,13 +30,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'IntRangeSlider' represents an IntRangeSlider widget from IPython.html.widgets.
-type IntRangeSlider = IPythonWidget IntRangeSliderType
+type IntRangeSlider = IPythonWidget 'IntRangeSliderType
 
 -- | Create a new widget
 mkIntRangeSlider :: IO IntRangeSlider
 mkIntRangeSlider = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let boundedIntAttrs = defaultBoundedIntRangeWidget "IntSliderView" "IntSliderModel"
       sliderAttrs = (Orientation =:: HorizontalOrientation)
@@ -46,7 +48,7 @@ mkIntRangeSlider = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -61,11 +63,12 @@ instance IHaskellDisplay IntRangeSlider where
 
 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 IntPairValue (x, y)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Array values) ->
+        case map (\(Number x) -> Sci.coefficient x) $ V.toList values of
+          [x, y] -> do
+            void $ setField' widget IntPairValue (x, y)
+            triggerChange widget
+          _ -> pure ()
+      _ -> pure ()

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

@@ -3,20 +3,22 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Int.IntText (
--- * The IntText Widget
-IntText, 
-         -- * Constructor
-         mkIntText) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+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 (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           IHaskell.Display
 import           IHaskell.Eval.Widgets
@@ -26,19 +28,19 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | 'IntText' represents an IntText widget from IPython.html.widgets.
-type IntText = IPythonWidget IntTextType
+type IntText = IPythonWidget 'IntTextType
 
 -- | Create a new widget
 mkIntText :: IO IntText
 mkIntText = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let widgetState = WidgetState $ defaultIntWidget "IntTextView" "IntTextModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -53,10 +55,9 @@ instance IHaskellDisplay IntText where
 
 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 IntValue (Sci.coefficient value)
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (Number value) -> do
+        void $ setField' widget IntValue (Sci.coefficient value)
+        triggerChange widget
+      _ -> pure ()

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

@@ -8,7 +8,12 @@
 {-# LANGUAGE UndecidableSuperClasses #-}
 {-# LANGUAGE PolyKinds #-}
 
-module IHaskell.Display.Widgets.Interactive (interactive, uncurryHList, Rec(..), Argument(..)) where
+module IHaskell.Display.Widgets.Interactive
+  ( interactive
+  , uncurryHList
+  , Rec (..)
+  , Argument(..)
+  ) where
 
 import           Data.Text
 import           Data.Proxy
@@ -32,7 +37,7 @@ 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,
@@ -42,7 +47,7 @@ data WidgetConf a where
               a
               -> WidgetConf a
 
- 
+
 type family WithTypes (ts :: [*]) (r :: *) :: * where
         WithTypes '[] r = r
         WithTypes (x ': xs) r = (x -> WithTypes xs r)
@@ -52,7 +57,7 @@ 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 =>
@@ -64,7 +69,7 @@ newtype EventSetter a = EventSetter (IPythonWidget (SuitableWidget a) -> IO () -
 
 newtype Initializer a = Initializer (IPythonWidget (SuitableWidget a) -> Argument a -> IO ())
 
- 
+
 data RequiredWidget a where
         RequiredWidget ::
             RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs =>
@@ -86,8 +91,8 @@ applyEventSetters (EventSetter setter :& xs) (RequiredWidget widget :& ws) handl
 
 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 (Initializer initialize :& fs) (RequiredWidget widget :& ws) (argument :& vs) = do
+  initialize widget argument
   setInitialValues fs ws vs
 
 extractConstructor :: WidgetConf x -> Constructor x
@@ -163,7 +168,7 @@ liftToWidgets func rc initvals = do
 
   return bx
 
- 
+
 data WrappedWidget w h f a where
         WrappedWidget ::
             (FieldType h ~ IO (), FieldType f ~ a, h ∈ WidgetFields w,
@@ -173,7 +178,7 @@ data WrappedWidget w h f a where
               S.SField h -> S.SField f -> WrappedWidget w h f a
 
 construct :: WrappedWidget w h f a -> IO (IPythonWidget w)
-construct (WrappedWidget cons _ _) = cons
+construct (WrappedWidget cs _ _) = cs
 
 getValue :: WrappedWidget w h f a -> IPythonWidget w -> IO a
 getValue (WrappedWidget _ _ field) widget = getField widget field
@@ -190,25 +195,25 @@ class RecAll Attr (WidgetFields (SuitableWidget a)) ToPairs => FromWidget a wher
   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
+  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
+  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
+  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
@@ -219,9 +224,9 @@ instance FromWidget Integer where
     setField w MaxInt u
 
 instance FromWidget Double where
-  type SuitableWidget Double = FloatSliderType
-  type SuitableHandler Double = S.ChangeHandler
-  type SuitableField Double = S.FloatValue
+  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

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

@@ -3,17 +3,19 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Output (
-    -- * The Output Widget
-    OutputWidget,
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.Output
+  ( -- * The Output Widget
+    OutputWidget
     -- * Constructor
-    mkOutputWidget,
+  , mkOutputWidget
     -- * Using the output widget
-    appendOutput,
-    clearOutput,
-    clearOutput_,
-    replaceOutput,
-    ) where
+  , appendOutput
+  , clearOutput
+  , clearOutput_
+  , replaceOutput
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
@@ -28,19 +30,19 @@ import           IHaskell.IPython.Message.UUID as U
 import           IHaskell.Display.Widgets.Types
 
 -- | An 'OutputWidget' represents a Output widget from IPython.html.widgets.
-type OutputWidget = IPythonWidget OutputType
+type OutputWidget = IPythonWidget 'OutputType
 
 -- | Create a new output widget
 mkOutputWidget :: IO OutputWidget
 mkOutputWidget = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
 
   let widgetState = WidgetState $ defaultDOMWidget "OutputView" "OutputModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState

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

@@ -3,20 +3,21 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Selection.Dropdown (
--- * The Dropdown Widget
-Dropdown, 
-          -- * Constructor
-          mkDropdown) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.Selection.Dropdown
+  ( -- * The Dropdown Widget
+    Dropdown
+    -- * Constructor
+  , mkDropdown
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
 import           Control.Monad (void)
 import           Data.Aeson
-import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
-import           Data.Text (Text)
 import           Data.Vinyl (Rec(..), (<+>))
 
 import           IHaskell.Display
@@ -27,20 +28,20 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'Dropdown' represents a Dropdown widget from IPython.html.widgets.
-type Dropdown = IPythonWidget DropdownType
+type Dropdown = IPythonWidget 'DropdownType
 
 -- | Create a new Dropdown widget
 mkDropdown :: IO Dropdown
 mkDropdown = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
   let selectionAttrs = defaultSelectionWidget "DropdownView" "DropdownModel"
       dropdownAttrs = (ButtonStyle =:: DefaultButton) :& RNil
       widgetState = WidgetState $ selectionAttrs <+> dropdownAttrs
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -55,20 +56,19 @@ instance IHaskellDisplay Dropdown where
 
 instance IHaskellWidget Dropdown where
   getCommUUID = uuid
-  comm widget (Object dict1) _ = do
-    let key1 = "sync_data" :: Text
-        key2 = "selected_label" :: Text
-        Just (Object dict2) = HM.lookup key1 dict1
-        Just (String label) = HM.lookup key2 dict2
-    opts <- getField widget Options
-    case opts of
-      OptionLabels _ -> void $ do
-        setField' widget SelectedLabel label
-        setField' widget SelectedValue label
-      OptionDict ps ->
-        case lookup label ps of
-          Nothing -> return ()
-          Just value -> void $ do
-            setField' widget SelectedLabel label
-            setField' widget SelectedValue value
-    triggerSelection widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "selected_label"] of
+      Just (String label) -> do
+        opts <- getField widget Options
+        case opts of
+          OptionLabels _ -> do
+            void $ setField' widget SelectedLabel label
+            void $ setField' widget SelectedValue label
+          OptionDict ps ->
+            case lookup label ps of
+              Nothing -> return ()
+              Just value -> do
+                void $ setField' widget SelectedLabel label
+                void $ setField' widget SelectedValue value
+        triggerSelection widget
+      _ -> pure ()

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

@@ -3,20 +3,21 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Selection.RadioButtons (
--- * The RadioButtons Widget
-RadioButtons, 
-              -- * Constructor
-              mkRadioButtons) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.Selection.RadioButtons
+  ( -- * The RadioButtons Widget
+    RadioButtons
+    -- * Constructor
+  , mkRadioButtons
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when, void)
+import           Control.Monad (void)
 import           Data.Aeson
-import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
-import           Data.Text (Text)
 
 import           IHaskell.Display
 import           IHaskell.Eval.Widgets
@@ -26,18 +27,18 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'RadioButtons' represents a RadioButtons widget from IPython.html.widgets.
-type RadioButtons = IPythonWidget RadioButtonsType
+type RadioButtons = IPythonWidget 'RadioButtonsType
 
 -- | Create a new RadioButtons widget
 mkRadioButtons :: IO RadioButtons
 mkRadioButtons = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
   let widgetState = WidgetState $ defaultSelectionWidget "RadioButtonsView" "RadioButtonsModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -52,20 +53,19 @@ instance IHaskellDisplay RadioButtons where
 
 instance IHaskellWidget RadioButtons where
   getCommUUID = uuid
-  comm widget (Object dict1) _ = do
-    let key1 = "sync_data" :: Text
-        key2 = "selected_label" :: Text
-        Just (Object dict2) = HM.lookup key1 dict1
-        Just (String label) = HM.lookup key2 dict2
-    opts <- getField widget Options
-    case opts of
-      OptionLabels _ -> void $ do
-        setField' widget SelectedLabel label
-        setField' widget SelectedValue label
-      OptionDict ps ->
-        case lookup label ps of
-          Nothing -> return ()
-          Just value -> void $ do
-            setField' widget SelectedLabel label
-            setField' widget SelectedValue value
-    triggerSelection widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "selected_label"] of
+      Just (String label) -> do
+        opts <- getField widget Options
+        case opts of
+          OptionLabels _ -> do
+            void $ setField' widget SelectedLabel label
+            void $ setField' widget SelectedValue label
+          OptionDict ps ->
+            case lookup label ps of
+              Nothing -> pure ()
+              Just value -> do
+                void $ setField' widget SelectedLabel label
+                void $ setField' widget SelectedValue value
+        triggerSelection widget
+      _ -> pure ()

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

@@ -3,21 +3,21 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Selection.Select (
--- * The Select Widget
-Select, 
-        -- * Constructor
-        mkSelect) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.Selection.Select
+  ( -- * The Select Widget
+    Select
+    -- * Constructor
+  , mkSelect
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when, join, void)
+import           Control.Monad (void)
 import           Data.Aeson
-import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
-import           Data.Text (Text)
-import           Data.Vinyl (Rec(..), (<+>))
 
 import           IHaskell.Display
 import           IHaskell.Eval.Widgets
@@ -27,18 +27,18 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'Select' represents a Select widget from IPython.html.widgets.
-type Select = IPythonWidget SelectType
+type Select = IPythonWidget 'SelectType
 
 -- | Create a new Select widget
 mkSelect :: IO Select
 mkSelect = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
   let widgetState = WidgetState $ defaultSelectionWidget "SelectView" "SelectModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -53,20 +53,19 @@ instance IHaskellDisplay Select where
 
 instance IHaskellWidget Select where
   getCommUUID = uuid
-  comm widget (Object dict1) _ = do
-    let key1 = "sync_data" :: Text
-        key2 = "selected_label" :: Text
-        Just (Object dict2) = HM.lookup key1 dict1
-        Just (String label) = HM.lookup key2 dict2
-    opts <- getField widget Options
-    case opts of
-      OptionLabels _ -> void $ do
-        setField' widget SelectedLabel label
-        setField' widget SelectedValue label
-      OptionDict ps ->
-        case lookup label ps of
-          Nothing -> return ()
-          Just value -> void $ do
-            setField' widget SelectedLabel label
-            setField' widget SelectedValue value
-    triggerSelection widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "selected_label"] of
+      Just (String label) -> do
+        opts <- getField widget Options
+        case opts of
+          OptionLabels _ -> do
+            void $ setField' widget SelectedLabel label
+            void $ setField' widget SelectedValue label
+          OptionDict ps ->
+            case lookup label ps of
+              Nothing -> pure ()
+              Just value -> do
+                void $ setField' widget SelectedLabel label
+                void $ setField' widget SelectedValue value
+        triggerSelection widget
+      _ -> pure ()

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

@@ -3,20 +3,21 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Selection.SelectMultiple (
--- * The SelectMultiple Widget
-SelectMultiple, 
-                -- * Constructor
-                mkSelectMultiple) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.Selection.SelectMultiple
+  ( -- * The SelectMultiple Widget
+    SelectMultiple
+    -- * Constructor
+  , mkSelectMultiple
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
 import           Control.Monad (void)
 import           Data.Aeson
-import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
-import           Data.Text (Text)
 import qualified Data.Vector as V
 
 import           IHaskell.Display
@@ -27,18 +28,18 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'SelectMultiple' represents a SelectMultiple widget from IPython.html.widgets.
-type SelectMultiple = IPythonWidget SelectMultipleType
+type SelectMultiple = IPythonWidget 'SelectMultipleType
 
 -- | Create a new SelectMultiple widget
 mkSelectMultiple :: IO SelectMultiple
 mkSelectMultiple = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
   let widgetState = WidgetState $ defaultMultipleSelectionWidget "SelectMultipleView" "SelectMultipleModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -53,21 +54,20 @@ instance IHaskellDisplay SelectMultiple where
 
 instance IHaskellWidget SelectMultiple where
   getCommUUID = uuid
-  comm widget (Object dict1) _ = do
-    let key1 = "sync_data" :: Text
-        key2 = "selected_labels" :: Text
-        Just (Object dict2) = HM.lookup key1 dict1
-        Just (Array labels) = HM.lookup key2 dict2
-        labelList = map (\(String x) -> x) $ V.toList labels
-    opts <- getField widget Options
-    case opts of
-      OptionLabels _ -> void $ do
-        setField' widget SelectedLabels labelList
-        setField' widget SelectedValues labelList
-      OptionDict ps ->
-        case sequence $ map (`lookup` ps) labelList of
-          Nothing -> return ()
-          Just valueList -> void $ do
-            setField' widget SelectedLabels labelList
-            setField' widget SelectedValues valueList
-    triggerSelection widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "selected_labels"] of
+      Just (Array labels) -> do
+        let labelList = map (\(String x) -> x) $ V.toList labels
+        opts <- getField widget Options
+        case opts of
+          OptionLabels _ -> do
+            void $ setField' widget SelectedLabels labelList
+            void $ setField' widget SelectedValues labelList
+          OptionDict ps ->
+            case mapM (`lookup` ps) labelList of
+              Nothing -> pure ()
+              Just valueList -> do
+                void $ setField' widget SelectedLabels labelList
+                void $ setField' widget SelectedValues valueList
+        triggerSelection widget
+      _ -> pure ()

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

@@ -3,20 +3,21 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.Selection.ToggleButtons (
--- * The ToggleButtons Widget
-ToggleButtons, 
-               -- * Constructor
-               mkToggleButtons) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.Selection.ToggleButtons
+  ( -- * The ToggleButtons Widget
+    ToggleButtons
+    -- * Constructor
+  , mkToggleButtons
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
 import           Control.Monad (void)
 import           Data.Aeson
-import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
-import           Data.Text (Text)
 import           Data.Vinyl (Rec(..), (<+>))
 
 import           IHaskell.Display
@@ -27,13 +28,13 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'ToggleButtons' represents a ToggleButtons widget from IPython.html.widgets.
-type ToggleButtons = IPythonWidget ToggleButtonsType
+type ToggleButtons = IPythonWidget 'ToggleButtonsType
 
 -- | Create a new ToggleButtons widget
 mkToggleButtons :: IO ToggleButtons
 mkToggleButtons = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
   let selectionAttrs = defaultSelectionWidget "ToggleButtonsView" "ToggleButtonsModel"
       toggleButtonsAttrs = (Tooltips =:: [])
                            :& (Icons =:: [])
@@ -43,7 +44,7 @@ mkToggleButtons = do
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -58,20 +59,19 @@ instance IHaskellDisplay ToggleButtons where
 
 instance IHaskellWidget ToggleButtons where
   getCommUUID = uuid
-  comm widget (Object dict1) _ = do
-    let key1 = "sync_data" :: Text
-        key2 = "selected_label" :: Text
-        Just (Object dict2) = HM.lookup key1 dict1
-        Just (String label) = HM.lookup key2 dict2
-    opts <- getField widget Options
-    case opts of
-      OptionLabels _ -> void $ do
-        setField' widget SelectedLabel label
-        setField' widget SelectedValue label
-      OptionDict ps ->
-        case lookup label ps of
-          Nothing -> return ()
-          Just value -> void $ do
-            setField' widget SelectedLabel label
-            setField' widget SelectedValue value
-    triggerSelection widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "selected_label"]  of
+      Just (String label) -> do
+        opts <- getField widget Options
+        case opts of
+          OptionLabels _ -> void $ do
+            void $ setField' widget SelectedLabel label
+            void $ setField' widget SelectedValue label
+          OptionDict ps ->
+            case lookup label ps of
+              Nothing -> pure ()
+              Just value -> do
+                void $ setField' widget SelectedLabel label
+                void $ setField' widget SelectedValue value
+        triggerSelection widget
+      _ -> pure ()

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

@@ -8,11 +8,16 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE InstanceSigs #-}
 {-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE CPP #-}
 
 module IHaskell.Display.Widgets.Singletons where
 
 import           Data.Singletons.TH
+
+#if MIN_VERSION_singletons(2,4,0)
+#else
 import           Data.Singletons.Prelude.Ord
+#endif
 
 -- Widget properties
 singletons

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

@@ -3,11 +3,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.String.HTML (
--- * The HTML Widget
-HTMLWidget, 
-            -- * Constructor
-            mkHTMLWidget) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.String.HTML
+  ( -- * The HTML Widget
+    HTMLWidget
+    -- * Constructor
+  , mkHTMLWidget
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
@@ -22,18 +25,18 @@ import           IHaskell.IPython.Message.UUID as U
 import           IHaskell.Display.Widgets.Types
 
 -- | A 'HTMLWidget' represents a HTML widget from IPython.html.widgets.
-type HTMLWidget = IPythonWidget HTMLType
+type HTMLWidget = IPythonWidget 'HTMLType
 
 -- | Create a new HTML widget
 mkHTMLWidget :: IO HTMLWidget
 mkHTMLWidget = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
   let widgetState = WidgetState $ defaultStringWidget "HTMLView" "HTMLModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState

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

@@ -3,11 +3,14 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.String.Label (
--- * The Label Widget
-LabelWidget, 
-             -- * Constructor
-             mkLabelWidget) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.String.Label
+  ( -- * The Label Widget
+    LabelWidget
+    -- * Constructor
+  , mkLabelWidget
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
@@ -22,18 +25,18 @@ import           IHaskell.IPython.Message.UUID as U
 import           IHaskell.Display.Widgets.Types
 
 -- | A 'LabelWidget' represents a Label widget from IPython.html.widgets.
-type LabelWidget = IPythonWidget LabelType
+type LabelWidget = IPythonWidget 'LabelType
 
 -- | Create a new Label widget
 mkLabelWidget :: IO LabelWidget
 mkLabelWidget = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
   let widgetState = WidgetState $ defaultStringWidget "LabelView" "LabelModel"
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState

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

@@ -3,18 +3,20 @@
 {-# LANGUAGE DataKinds #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.String.Text (
--- * The Text Widget
-TextWidget, 
-            -- * Constructor
-            mkTextWidget) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.String.Text
+  ( -- * The Text Widget
+    TextWidget
+    -- * Constructor
+  , mkTextWidget
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
 import           Control.Monad (when)
 import           Data.Aeson
-import qualified Data.HashMap.Strict as Map
 import           Data.IORef (newIORef)
 import           Data.Vinyl (Rec(..), (<+>))
 
@@ -26,20 +28,20 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'TextWidget' represents a Text widget from IPython.html.widgets.
-type TextWidget = IPythonWidget TextType
+type TextWidget = IPythonWidget 'TextType
 
 -- | Create a new Text widget
 mkTextWidget :: IO TextWidget
 mkTextWidget = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
   let strWidget = defaultStringWidget "TextView" "TextModel"
       txtWidget = (SubmitHandler =:: return ()) :& (ChangeHandler =:: return ()) :& RNil
       widgetState = WidgetState $ strWidget <+> txtWidget
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -55,16 +57,10 @@ instance IHaskellDisplay TextWidget where
 instance IHaskellWidget TextWidget where
   getCommUUID = uuid
   -- Two possibilities: 1. content -> event -> "submit" 2. sync_data -> value -> <new_value>
-  comm tw (Object dict1) _ =
-    case Map.lookup "sync_data" dict1 of
-      Just (Object dict2) ->
-        case Map.lookup "value" dict2 of
-          Just (String val) -> setField' tw StringValue val >> triggerChange tw
-          Nothing           -> return ()
-      Nothing ->
-        case Map.lookup "content" dict1 of
-          Just (Object dict2) ->
-            case Map.lookup "event" dict2 of
-              Just (String event) -> when (event == "submit") $ triggerSubmit tw
-              Nothing             -> return ()
-          Nothing -> return ()
+  comm tw val _ = do
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (String value) -> setField' tw StringValue value >> triggerChange tw
+      _                 -> pure ()
+    case nestedObjectLookup val ["content", "event"] of
+      Just (String event) -> when (event == "submit") $ triggerSubmit tw
+      _                   -> pure ()

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

 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE DataKinds #-}
-{-# LANGUAGE TypeSynonymInstances #-}
 
-module IHaskell.Display.Widgets.String.TextArea (
--- * The TextArea Widget
-TextArea, 
-          -- * Constructor
-          mkTextArea) where
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
+module IHaskell.Display.Widgets.String.TextArea
+  ( -- * The TextArea Widget
+    TextArea
+    -- * Constructor
+  , mkTextArea
+  ) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
+import           Control.Monad (void)
 import           Data.Aeson
-import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
-import           Data.Text (Text)
 import           Data.Vinyl (Rec(..), (<+>))
 
 import           IHaskell.Display
@@ -26,20 +27,20 @@ import           IHaskell.Display.Widgets.Types
 import           IHaskell.Display.Widgets.Common
 
 -- | A 'TextArea' represents a Textarea widget from IPython.html.widgets.
-type TextArea = IPythonWidget TextAreaType
+type TextArea = IPythonWidget 'TextAreaType
 
 -- | Create a new TextArea widget
 mkTextArea :: IO TextArea
 mkTextArea = do
   -- Default properties, with a random uuid
-  uuid <- U.random
+  wid <- U.random
   let strAttrs = defaultStringWidget "TextareaView" "TextareaModel"
       wgtAttrs = (ChangeHandler =:: return ()) :& RNil
       widgetState = WidgetState $ strAttrs <+> wgtAttrs
 
   stateIO <- newIORef widgetState
 
-  let widget = IPythonWidget uuid stateIO
+  let widget = IPythonWidget wid stateIO
 
   -- Open a comm for this widget, and store it in the kernel state
   widgetSendOpen widget $ toJSON widgetState
@@ -54,10 +55,9 @@ instance IHaskellDisplay TextArea where
 
 instance IHaskellWidget TextArea where
   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 StringValue value
-    triggerChange widget
+  comm widget val _ =
+    case nestedObjectLookup val ["sync_data", "value"] of
+      Just (String value) -> do
+        void $ setField' widget StringValue value
+        triggerChange widget
+      _ -> pure ()

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

@@ -16,6 +16,9 @@
 {-# LANGUAGE AutoDeriveTypeable #-}
 {-# LANGUAGE CPP #-}
 
+-- Can't make the compiler accept this file without this.
+{-# OPTIONS_GHC -fno-warn-unticked-promoted-constructors #-}
+
 -- | 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
@@ -72,9 +75,9 @@ import           System.IO.Error
 import           System.Posix.IO
 import           Text.Printf (printf)
 
-import           Data.Aeson
+import           Data.Aeson hiding (pairs)
 import           Data.Aeson.Types (Pair)
-
+import           Data.Int (Int16)
 import           Data.Vinyl (Rec(..), (<+>), recordToList, reifyConstraint, rmap, Dict(..))
 import           Data.Vinyl.Functor (Compose(..), Const(..))
 import           Data.Vinyl.Lens (rget, rput, type (∈))
@@ -109,123 +112,123 @@ type (a :++ b) = a ++ b
 #endif
 
 -- Classes from IPython's widget hierarchy. Defined as such to reduce code duplication.
-type WidgetClass = '[S.ViewModule, S.ViewName, S.ModelModule, S.ModelName,
-  S.MsgThrottle, S.Version, S.DisplayHandler]
+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 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 StringClass = DOMWidgetClass :++ ['S.StringValue, 'S.Disabled, 'S.Description, 'S.Placeholder]
 
-type BoolClass = DOMWidgetClass :++ '[S.BoolValue, S.Disabled, S.Description, S.ChangeHandler]
+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 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 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 IntClass = DOMWidgetClass :++ ['S.IntValue, 'S.Disabled, 'S.Description, 'S.ChangeHandler]
 
-type BoundedIntClass = IntClass :++ '[S.StepInt, S.MinInt, S.MaxInt]
+type BoundedIntClass = IntClass :++ ['S.StepInt, 'S.MinInt, 'S.MaxInt]
 
-type IntRangeClass = IntClass :++ '[S.IntPairValue, S.LowerInt, S.UpperInt]
+type IntRangeClass = IntClass :++ ['S.IntPairValue, 'S.LowerInt, 'S.UpperInt]
 
-type BoundedIntRangeClass = IntRangeClass :++ '[S.StepInt, S.MinInt, S.MaxInt]
+type BoundedIntRangeClass = IntRangeClass :++ ['S.StepInt, 'S.MinInt, 'S.MaxInt]
 
-type FloatClass = DOMWidgetClass :++ '[S.FloatValue, S.Disabled, S.Description, S.ChangeHandler]
+type FloatClass = DOMWidgetClass :++ ['S.FloatValue, 'S.Disabled, 'S.Description, 'S.ChangeHandler]
 
-type BoundedFloatClass = FloatClass :++ '[S.StepFloat, S.MinFloat, S.MaxFloat]
+type BoundedFloatClass = FloatClass :++ ['S.StepFloat, 'S.MinFloat, 'S.MaxFloat]
 
-type FloatRangeClass = FloatClass :++ '[S.FloatPairValue, S.LowerFloat, S.UpperFloat]
+type FloatRangeClass = FloatClass :++ ['S.FloatPairValue, 'S.LowerFloat, 'S.UpperFloat]
 
-type BoundedFloatRangeClass = FloatRangeClass :++ '[S.StepFloat, S.MinFloat, S.MaxFloat]
+type BoundedFloatRangeClass = FloatRangeClass :++ ['S.StepFloat, 'S.MinFloat, 'S.MaxFloat]
 
-type BoxClass = DOMWidgetClass :++ '[S.Children, S.OverflowX, S.OverflowY, S.BoxStyle]
+type BoxClass = DOMWidgetClass :++ ['S.Children, 'S.OverflowX, 'S.OverflowY, 'S.BoxStyle]
 
-type SelectionContainerClass = BoxClass :++ '[S.Titles, S.SelectedIndex, S.ChangeHandler]
+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.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 = PixCount
-        FieldType S.Height = PixCount
-        FieldType S.Padding = PixCount
-        FieldType S.Margin = PixCount
-        FieldType S.Color = Text
-        FieldType S.BackgroundColor = Text
-        FieldType S.BorderColor = Text
-        FieldType S.BorderWidth = PixCount
-        FieldType S.BorderRadius = PixCount
-        FieldType S.BorderStyle = BorderStyleValue
-        FieldType S.FontStyle = FontStyleValue
-        FieldType S.FontWeight = FontWeightValue
-        FieldType S.FontSize = PixCount
-        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
+        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 = PixCount
+        FieldType 'S.Height = PixCount
+        FieldType 'S.Padding = PixCount
+        FieldType 'S.Margin = PixCount
+        FieldType 'S.Color = Text
+        FieldType 'S.BackgroundColor = Text
+        FieldType 'S.BorderColor = Text
+        FieldType 'S.BorderWidth = PixCount
+        FieldType 'S.BorderRadius = PixCount
+        FieldType 'S.BorderStyle = BorderStyleValue
+        FieldType 'S.FontStyle = FontStyleValue
+        FieldType 'S.FontWeight = FontWeightValue
+        FieldType 'S.FontSize = PixCount
+        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)
@@ -241,16 +244,16 @@ class CustomBounded a where
 
 -- Set according to what IPython widgets use
 instance CustomBounded PixCount where
-  upperBound = 10 ^ 16 - 1
-  lowerBound = -(10 ^ 16 - 1)
+  lowerBound = - fromIntegral (maxBound :: Int16)
+  upperBound = fromIntegral (maxBound :: Int16)
 
 instance CustomBounded Integer where
-  lowerBound = -(10 ^ 16 - 1)
-  upperBound = 10 ^ 16 - 1
+  lowerBound = - fromIntegral (maxBound :: Int16)
+  upperBound = fromIntegral (maxBound :: Int16)
 
 instance CustomBounded Double where
-  lowerBound = -(10 ** 16 - 1)
-  upperBound = 10 ** 16 - 1
+  lowerBound = - fromIntegral (maxBound :: Int16)
+  upperBound = fromIntegral (maxBound :: Int16)
 
 -- Different types of widgets. Every widget in IPython has a corresponding WidgetType
 data WidgetType = ButtonType
@@ -285,51 +288,52 @@ data WidgetType = ButtonType
 -- 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.Width, S.Height, S.B64Value]
-        WidgetFields OutputType = DOMWidgetClass
-        WidgetFields HTMLType = StringClass
-        WidgetFields LabelType = 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 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 'LabelType = 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 '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
@@ -361,121 +365,121 @@ class ToPairs a where
   toPairs :: a -> [Pair]
 
 -- Attributes that aren't synced with the frontend give [] on toPairs
-instance ToPairs (Attr S.ViewModule) where
+instance ToPairs (Attr 'S.ViewModule) where
   toPairs x = ["_view_module" .= toJSON x]
 
-instance ToPairs (Attr S.ViewName) where
+instance ToPairs (Attr 'S.ViewName) where
   toPairs x = ["_view_name" .= toJSON x]
 
-instance ToPairs (Attr S.ModelModule) where
+instance ToPairs (Attr 'S.ModelModule) where
   toPairs x = ["_model_module" .= toJSON x]
 
-instance ToPairs (Attr S.ModelName) where
+instance ToPairs (Attr 'S.ModelName) where
   toPairs x = ["_model_name" .= toJSON x]
 
-instance ToPairs (Attr S.MsgThrottle) where
+instance ToPairs (Attr 'S.MsgThrottle) where
   toPairs x = ["msg_throttle" .= toJSON x]
 
-instance ToPairs (Attr S.Version) where
+instance ToPairs (Attr 'S.Version) where
   toPairs x = ["version" .= toJSON x]
 
-instance ToPairs (Attr S.DisplayHandler) where
+instance ToPairs (Attr 'S.DisplayHandler) where
   toPairs _ = [] -- Not sent to the frontend
 
-instance ToPairs (Attr S.Visible) where
+instance ToPairs (Attr 'S.Visible) where
   toPairs x = ["visible" .= toJSON x]
 
-instance ToPairs (Attr S.CSS) where
+instance ToPairs (Attr 'S.CSS) where
   toPairs x = ["_css" .= toJSON x]
 
-instance ToPairs (Attr S.DOMClasses) where
+instance ToPairs (Attr 'S.DOMClasses) where
   toPairs x = ["_dom_classes" .= toJSON x]
 
-instance ToPairs (Attr S.Width) where
+instance ToPairs (Attr 'S.Width) where
   toPairs x = ["width" .= toJSON x]
 
-instance ToPairs (Attr S.Height) where
+instance ToPairs (Attr 'S.Height) where
   toPairs x = ["height" .= toJSON x]
 
-instance ToPairs (Attr S.Padding) where
+instance ToPairs (Attr 'S.Padding) where
   toPairs x = ["padding" .= toJSON x]
 
-instance ToPairs (Attr S.Margin) where
+instance ToPairs (Attr 'S.Margin) where
   toPairs x = ["margin" .= toJSON x]
 
-instance ToPairs (Attr S.Color) where
+instance ToPairs (Attr 'S.Color) where
   toPairs x = ["color" .= toJSON x]
 
-instance ToPairs (Attr S.BackgroundColor) where
+instance ToPairs (Attr 'S.BackgroundColor) where
   toPairs x = ["background_color" .= toJSON x]
 
-instance ToPairs (Attr S.BorderColor) where
+instance ToPairs (Attr 'S.BorderColor) where
   toPairs x = ["border_color" .= toJSON x]
 
-instance ToPairs (Attr S.BorderWidth) where
+instance ToPairs (Attr 'S.BorderWidth) where
   toPairs x = ["border_width" .= toJSON x]
 
-instance ToPairs (Attr S.BorderRadius) where
+instance ToPairs (Attr 'S.BorderRadius) where
   toPairs x = ["border_radius" .= toJSON x]
 
-instance ToPairs (Attr S.BorderStyle) where
+instance ToPairs (Attr 'S.BorderStyle) where
   toPairs x = ["border_style" .= toJSON x]
 
-instance ToPairs (Attr S.FontStyle) where
+instance ToPairs (Attr 'S.FontStyle) where
   toPairs x = ["font_style" .= toJSON x]
 
-instance ToPairs (Attr S.FontWeight) where
+instance ToPairs (Attr 'S.FontWeight) where
   toPairs x = ["font_weight" .= toJSON x]
 
-instance ToPairs (Attr S.FontSize) where
+instance ToPairs (Attr 'S.FontSize) where
   toPairs x = ["font_size" .= toJSON x]
 
-instance ToPairs (Attr S.FontFamily) where
+instance ToPairs (Attr 'S.FontFamily) where
   toPairs x = ["font_family" .= toJSON x]
 
-instance ToPairs (Attr S.Description) where
+instance ToPairs (Attr 'S.Description) where
   toPairs x = ["description" .= toJSON x]
 
-instance ToPairs (Attr S.ClickHandler) where
+instance ToPairs (Attr 'S.ClickHandler) where
   toPairs _ = [] -- Not sent to the frontend
 
-instance ToPairs (Attr S.SubmitHandler) where
+instance ToPairs (Attr 'S.SubmitHandler) where
   toPairs _ = [] -- Not sent to the frontend
 
-instance ToPairs (Attr S.Disabled) where
+instance ToPairs (Attr 'S.Disabled) where
   toPairs x = ["disabled" .= toJSON x]
 
-instance ToPairs (Attr S.StringValue) where
+instance ToPairs (Attr 'S.StringValue) where
   toPairs x = ["value" .= toJSON x]
 
-instance ToPairs (Attr S.Placeholder) where
+instance ToPairs (Attr 'S.Placeholder) where
   toPairs x = ["placeholder" .= toJSON x]
 
-instance ToPairs (Attr S.Tooltip) where
+instance ToPairs (Attr 'S.Tooltip) where
   toPairs x = ["tooltip" .= toJSON x]
 
-instance ToPairs (Attr S.Icon) where
+instance ToPairs (Attr 'S.Icon) where
   toPairs x = ["icon" .= toJSON x]
 
-instance ToPairs (Attr S.ButtonStyle) where
+instance ToPairs (Attr 'S.ButtonStyle) where
   toPairs x = ["button_style" .= toJSON x]
 
-instance ToPairs (Attr S.B64Value) where
+instance ToPairs (Attr 'S.B64Value) where
   toPairs x = ["_b64value" .= toJSON x]
 
-instance ToPairs (Attr S.ImageFormat) where
+instance ToPairs (Attr 'S.ImageFormat) where
   toPairs x = ["format" .= toJSON x]
 
-instance ToPairs (Attr S.BoolValue) where
+instance ToPairs (Attr 'S.BoolValue) where
   toPairs x = ["value" .= toJSON x]
 
-instance ToPairs (Attr S.SelectedLabel) where
+instance ToPairs (Attr 'S.SelectedLabel) where
   toPairs x = ["selected_label" .= toJSON x]
 
-instance ToPairs (Attr S.SelectedValue) where
+instance ToPairs (Attr 'S.SelectedValue) where
   toPairs x = ["value" .= toJSON x]
 
-instance ToPairs (Attr S.Options) where
+instance ToPairs (Attr 'S.Options) where
   toPairs x =
     case _value x of
       Dummy _                -> labels ("" :: Text)
@@ -484,115 +488,115 @@ instance ToPairs (Attr S.Options) where
     where
       labels xs = ["_options_labels" .= xs]
 
-instance ToPairs (Attr S.SelectionHandler) where
+instance ToPairs (Attr 'S.SelectionHandler) where
   toPairs _ = [] -- Not sent to the frontend
 
-instance ToPairs (Attr S.Tooltips) where
+instance ToPairs (Attr 'S.Tooltips) where
   toPairs x = ["tooltips" .= toJSON x]
 
-instance ToPairs (Attr S.Icons) where
+instance ToPairs (Attr 'S.Icons) where
   toPairs x = ["icons" .= toJSON x]
 
-instance ToPairs (Attr S.SelectedLabels) where
+instance ToPairs (Attr 'S.SelectedLabels) where
   toPairs x = ["selected_labels" .= toJSON x]
 
-instance ToPairs (Attr S.SelectedValues) where
+instance ToPairs (Attr 'S.SelectedValues) where
   toPairs x = ["values" .= toJSON x]
 
-instance ToPairs (Attr S.IntValue) where
+instance ToPairs (Attr 'S.IntValue) where
   toPairs x = ["value" .= toJSON x]
 
-instance ToPairs (Attr S.StepInt) where
+instance ToPairs (Attr 'S.StepInt) where
   toPairs x = ["step" .= toJSON x]
 
-instance ToPairs (Attr S.MinInt) where
+instance ToPairs (Attr 'S.MinInt) where
   toPairs x = ["min" .= toJSON x]
 
-instance ToPairs (Attr S.MaxInt) where
+instance ToPairs (Attr 'S.MaxInt) where
   toPairs x = ["max" .= toJSON x]
 
-instance ToPairs (Attr S.IntPairValue) where
+instance ToPairs (Attr 'S.IntPairValue) where
   toPairs x = ["value" .= toJSON x]
 
-instance ToPairs (Attr S.LowerInt) where
+instance ToPairs (Attr 'S.LowerInt) where
   toPairs x = ["min" .= toJSON x]
 
-instance ToPairs (Attr S.UpperInt) where
+instance ToPairs (Attr 'S.UpperInt) where
   toPairs x = ["max" .= toJSON x]
 
-instance ToPairs (Attr S.FloatValue) where
+instance ToPairs (Attr 'S.FloatValue) where
   toPairs x = ["value" .= toJSON x]
 
-instance ToPairs (Attr S.StepFloat) where
+instance ToPairs (Attr 'S.StepFloat) where
   toPairs x = ["step" .= toJSON x]
 
-instance ToPairs (Attr S.MinFloat) where
+instance ToPairs (Attr 'S.MinFloat) where
   toPairs x = ["min" .= toJSON x]
 
-instance ToPairs (Attr S.MaxFloat) where
+instance ToPairs (Attr 'S.MaxFloat) where
   toPairs x = ["max" .= toJSON x]
 
-instance ToPairs (Attr S.FloatPairValue) where
+instance ToPairs (Attr 'S.FloatPairValue) where
   toPairs x = ["value" .= toJSON x]
 
-instance ToPairs (Attr S.LowerFloat) where
+instance ToPairs (Attr 'S.LowerFloat) where
   toPairs x = ["min" .= toJSON x]
 
-instance ToPairs (Attr S.UpperFloat) where
+instance ToPairs (Attr 'S.UpperFloat) where
   toPairs x = ["max" .= toJSON x]
 
-instance ToPairs (Attr S.Orientation) where
+instance ToPairs (Attr 'S.Orientation) where
   toPairs x = ["orientation" .= toJSON x]
 
-instance ToPairs (Attr S.ShowRange) where
+instance ToPairs (Attr 'S.ShowRange) where
   toPairs x = ["_range" .= toJSON x]
 
-instance ToPairs (Attr S.ReadOut) where
+instance ToPairs (Attr 'S.ReadOut) where
   toPairs x = ["readout" .= toJSON x]
 
-instance ToPairs (Attr S.SliderColor) where
+instance ToPairs (Attr 'S.SliderColor) where
   toPairs x = ["slider_color" .= toJSON x]
 
-instance ToPairs (Attr S.BarStyle) where
+instance ToPairs (Attr 'S.BarStyle) where
   toPairs x = ["bar_style" .= toJSON x]
 
-instance ToPairs (Attr S.ChangeHandler) where
+instance ToPairs (Attr 'S.ChangeHandler) where
   toPairs _ = [] -- Not sent to the frontend
 
-instance ToPairs (Attr S.Children) where
+instance ToPairs (Attr 'S.Children) where
   toPairs x = ["children" .= toJSON x]
 
-instance ToPairs (Attr S.OverflowX) where
+instance ToPairs (Attr 'S.OverflowX) where
   toPairs x = ["overflow_x" .= toJSON x]
 
-instance ToPairs (Attr S.OverflowY) where
+instance ToPairs (Attr 'S.OverflowY) where
   toPairs x = ["overflow_y" .= toJSON x]
 
-instance ToPairs (Attr S.BoxStyle) where
+instance ToPairs (Attr 'S.BoxStyle) where
   toPairs x = ["box_style" .= toJSON x]
 
-instance ToPairs (Attr S.Flex) where
+instance ToPairs (Attr 'S.Flex) where
   toPairs x = ["flex" .= toJSON x]
 
-instance ToPairs (Attr S.Pack) where
+instance ToPairs (Attr 'S.Pack) where
   toPairs x = ["pack" .= toJSON x]
 
-instance ToPairs (Attr S.Align) where
+instance ToPairs (Attr 'S.Align) where
   toPairs x = ["align" .= toJSON x]
 
-instance ToPairs (Attr S.Titles) where
+instance ToPairs (Attr 'S.Titles) where
   toPairs x = ["_titles" .= toJSON x]
 
-instance ToPairs (Attr S.SelectedIndex) where
+instance ToPairs (Attr 'S.SelectedIndex) where
   toPairs x = ["selected_index" .= toJSON x]
 
-instance ToPairs (Attr S.ReadOutMsg) where
+instance ToPairs (Attr 'S.ReadOutMsg) where
   toPairs x = ["readout" .= toJSON x]
 
-instance ToPairs (Attr S.Child) where
+instance ToPairs (Attr 'S.Child) where
   toPairs x = ["child" .= toJSON x]
 
-instance ToPairs (Attr S.Selector) where
+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
@@ -631,7 +635,7 @@ reflect :: forall (f :: Field). (SingI f) => Sing f -> Field
 reflect = fromSing
 
 -- | A record representing an object of the Widget class from IPython
-defaultWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr WidgetClass
+defaultWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr WidgetClass
 defaultWidget viewName modelName = (ViewModule =:: "jupyter-js-widgets")
                                    :& (ViewName =:: viewName)
                                    :& (ModelModule =:: "jupyter-js-widgets")
@@ -642,7 +646,7 @@ defaultWidget viewName modelName = (ViewModule =:: "jupyter-js-widgets")
                                    :& RNil
 
 -- | A record representing an object of the DOMWidget class from IPython
-defaultDOMWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr DOMWidgetClass
+defaultDOMWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr DOMWidgetClass
 defaultDOMWidget viewName modelName = defaultWidget viewName modelName <+> domAttrs
   where
     domAttrs = (Visible =:: True)
@@ -665,7 +669,7 @@ defaultDOMWidget viewName modelName = defaultWidget viewName modelName <+> domAt
                :& RNil
 
 -- | A record representing a widget of the _String class from IPython
-defaultStringWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr StringClass
+defaultStringWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr StringClass
 defaultStringWidget viewName modelName = defaultDOMWidget viewName modelName <+> strAttrs
   where
     strAttrs = (StringValue =:: "")
@@ -675,7 +679,7 @@ defaultStringWidget viewName modelName = defaultDOMWidget viewName modelName <+>
                :& RNil
 
 -- | A record representing a widget of the _Bool class from IPython
-defaultBoolWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoolClass
+defaultBoolWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr BoolClass
 defaultBoolWidget viewName modelName = defaultDOMWidget viewName modelName <+> boolAttrs
   where
     boolAttrs = (BoolValue =:: False)
@@ -685,7 +689,7 @@ defaultBoolWidget viewName modelName = defaultDOMWidget viewName modelName <+> b
                 :& RNil
 
 -- | A record representing a widget of the _Selection class from IPython
-defaultSelectionWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr SelectionClass
+defaultSelectionWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr SelectionClass
 defaultSelectionWidget viewName modelName = defaultDOMWidget viewName modelName <+> selectionAttrs
   where
     selectionAttrs = (Options =:: OptionLabels [])
@@ -697,7 +701,7 @@ defaultSelectionWidget viewName modelName = defaultDOMWidget viewName modelName
                      :& RNil
 
 -- | A record representing a widget of the _MultipleSelection class from IPython
-defaultMultipleSelectionWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr MultipleSelectionClass
+defaultMultipleSelectionWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr MultipleSelectionClass
 defaultMultipleSelectionWidget viewName modelName = defaultDOMWidget viewName modelName <+> mulSelAttrs
   where
     mulSelAttrs = (Options =:: OptionLabels [])
@@ -709,7 +713,7 @@ defaultMultipleSelectionWidget viewName modelName = defaultDOMWidget viewName mo
                   :& RNil
 
 -- | A record representing a widget of the _Int class from IPython
-defaultIntWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr IntClass
+defaultIntWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr IntClass
 defaultIntWidget viewName modelName = defaultDOMWidget viewName modelName <+> intAttrs
   where
     intAttrs = (IntValue =:: 0)
@@ -719,7 +723,7 @@ defaultIntWidget viewName modelName = defaultDOMWidget viewName modelName <+> in
                :& RNil
 
 -- | A record representing a widget of the _BoundedInt class from IPython
-defaultBoundedIntWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoundedIntClass
+defaultBoundedIntWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr BoundedIntClass
 defaultBoundedIntWidget viewName modelName = defaultIntWidget viewName modelName <+> boundedIntAttrs
   where
     boundedIntAttrs = (StepInt =:: 1)
@@ -728,7 +732,7 @@ defaultBoundedIntWidget viewName modelName = defaultIntWidget viewName modelName
                       :& RNil
 
 -- | A record representing a widget of the _BoundedInt class from IPython
-defaultIntRangeWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr IntRangeClass
+defaultIntRangeWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr IntRangeClass
 defaultIntRangeWidget viewName modelName = defaultIntWidget viewName modelName <+> rangeAttrs
   where
     rangeAttrs = (IntPairValue =:: (25, 75))
@@ -737,7 +741,7 @@ defaultIntRangeWidget viewName modelName = defaultIntWidget viewName modelName <
                  :& RNil
 
 -- | A record representing a widget of the _BoundedIntRange class from IPython
-defaultBoundedIntRangeWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoundedIntRangeClass
+defaultBoundedIntRangeWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr BoundedIntRangeClass
 defaultBoundedIntRangeWidget viewName modelName = defaultIntRangeWidget viewName modelName <+> boundedIntRangeAttrs
   where
     boundedIntRangeAttrs = (StepInt =:+ 1)
@@ -746,7 +750,7 @@ defaultBoundedIntRangeWidget viewName modelName = defaultIntRangeWidget viewName
                            :& RNil
 
 -- | A record representing a widget of the _Float class from IPython
-defaultFloatWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr FloatClass
+defaultFloatWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr FloatClass
 defaultFloatWidget viewName modelName = defaultDOMWidget viewName modelName <+> intAttrs
   where
     intAttrs = (FloatValue =:: 0)
@@ -756,7 +760,7 @@ defaultFloatWidget viewName modelName = defaultDOMWidget viewName modelName <+>
                :& RNil
 
 -- | A record representing a widget of the _BoundedFloat class from IPython
-defaultBoundedFloatWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoundedFloatClass
+defaultBoundedFloatWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr BoundedFloatClass
 defaultBoundedFloatWidget viewName modelName = defaultFloatWidget viewName modelName <+> boundedFloatAttrs
   where
     boundedFloatAttrs = (StepFloat =:+ 1)
@@ -765,7 +769,7 @@ defaultBoundedFloatWidget viewName modelName = defaultFloatWidget viewName model
                         :& RNil
 
 -- | A record representing a widget of the _BoundedFloat class from IPython
-defaultFloatRangeWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr FloatRangeClass
+defaultFloatRangeWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr FloatRangeClass
 defaultFloatRangeWidget viewName modelName = defaultFloatWidget viewName modelName <+> rangeAttrs
   where
     rangeAttrs = (FloatPairValue =:: (25, 75))
@@ -774,7 +778,7 @@ defaultFloatRangeWidget viewName modelName = defaultFloatWidget viewName modelNa
                  :& RNil
 
 -- | A record representing a widget of the _BoundedFloatRange class from IPython
-defaultBoundedFloatRangeWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoundedFloatRangeClass
+defaultBoundedFloatRangeWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr BoundedFloatRangeClass
 defaultBoundedFloatRangeWidget viewName modelName = defaultFloatRangeWidget viewName modelName <+> boundedFloatRangeAttrs
   where
     boundedFloatRangeAttrs = (StepFloat =:+ 1)
@@ -783,7 +787,7 @@ defaultBoundedFloatRangeWidget viewName modelName = defaultFloatRangeWidget view
                              :& RNil
 
 -- | A record representing a widget of the _Box class from IPython
-defaultBoxWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr BoxClass
+defaultBoxWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr BoxClass
 defaultBoxWidget viewName modelName = defaultDOMWidget viewName modelName <+> intAttrs
   where
     intAttrs = (Children =:: [])
@@ -793,7 +797,7 @@ defaultBoxWidget viewName modelName = defaultDOMWidget viewName modelName <+> in
                :& RNil
 
 -- | A record representing a widget of the _SelectionContainer class from IPython
-defaultSelectionContainerWidget :: FieldType S.ViewName -> FieldType S.ModelName -> Rec Attr SelectionContainerClass
+defaultSelectionContainerWidget :: FieldType 'S.ViewName -> FieldType 'S.ModelName -> Rec Attr SelectionContainerClass
 defaultSelectionContainerWidget viewName modelName = defaultBoxWidget viewName modelName <+> selAttrs
   where
     selAttrs = (Titles =:: [])
@@ -876,17 +880,17 @@ noStdin action =
 triggerEvent :: (FieldType f ~ IO (), f ∈ WidgetFields w) => SField f -> IPythonWidget w -> IO ()
 triggerEvent sfield w = noStdin . join $ getField w sfield
 
-triggerChange :: (S.ChangeHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
+triggerChange :: ('S.ChangeHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
 triggerChange = triggerEvent ChangeHandler
 
-triggerClick :: (S.ClickHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
+triggerClick :: ('S.ClickHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
 triggerClick = triggerEvent ClickHandler
 
-triggerSelection :: (S.SelectionHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
+triggerSelection :: ('S.SelectionHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
 triggerSelection = triggerEvent SelectionHandler
 
-triggerSubmit :: (S.SubmitHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
+triggerSubmit :: ('S.SubmitHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
 triggerSubmit = triggerEvent SubmitHandler
 
-triggerDisplay :: (S.DisplayHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
+triggerDisplay :: ('S.DisplayHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
 triggerDisplay = triggerEvent DisplayHandler

stack-8.0.yaml

@@ -23,6 +23,7 @@ ghc-options:
   # Eventually we want "$locals": -Wall -Werror
   ghc-parser: -Wall -Werror
   ihaskell: -Wall -Werror
+  ihaskell-widgets: -Wall -Werror
 
 nix:
   enable: false

stack-8.4.yaml

@@ -24,9 +24,10 @@ extra-deps:
 - plot-0.2.3.9
 
 ghc-options:
-  # Eventually we want "$locals": -Wall -Werror
-  ghc-parser: -Wall -Werror
+  # Eventually we want "$locals": -Wall -Wpartial-fields -Werror
+  ghc-parser: -Wall -Wpartial-fields -Werror
   ihaskell: -Wall -Werror
+  ihaskell-widgets: -Wall -Wpartial-fields -Werror
 
 nix:
   enable: false

stack.yaml

@@ -21,6 +21,7 @@ ghc-options:
   # Eventually we want "$locals": -Wall -Werror
   ghc-parser: -Wall -Werror
   ihaskell: -Wall -Werror
+  ihaskell-widgets: -Wall -Werror
 
 allow-newer: true