More refactoring

- Add `properties` to view properties of widgets.
- Remove use of `Numeric.Natural`.
- Add verification mechanisms to `Attr`.

ihaskell-display/ihaskell-widgets/MsgSpec.md

@@ -2,14 +2,15 @@
 
 > Largely based on: https://github.com/ipython/ipython/wiki/IPEP-23:-Backbone.js-Widgets
 
-> The messaging specification as detailed is riddled with the assumptions IHaskell's widget
+> The messaging specification as detailed is riddled with assumptions IHaskell's widget
 > implementation makes. It works for us, so it should work for everyone.
 
 ## Creating widgets
 
 Let's say the user types in some code, and the only effect of that code is the creation of a widget.
 The kernel will open a comm for the widget, and store a reference to that comm inside it. Then, to
-notify the frontend about the creation of a widget, an initial state update is sent on the widget's comm.
+notify the frontend about the creation of a widget, an initial state update is sent on the widget's
+comm.
 
 > The comm should be opened with a `target_name` of `"ipython.widget"`.
 
@@ -22,7 +23,9 @@ The initial state update message looks like this:
 }
 ```
 
-Any *numeric* property initialized with the empty string is provided the default value by the frontend.
+Any *numeric* property initialized with the empty string is provided the default value by the
+frontend. Some numbers need to be sent as actual numbers (when non-null), whereas some (especially
+those used by sliders) need to be sent as strings.
 
 The initial state update must *at least* have the following fields:
 

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

@@ -33,4 +33,4 @@ import           IHaskell.Display.Widgets.String.Text as X
 import           IHaskell.Display.Widgets.String.TextArea as X
 
 import           IHaskell.Display.Widgets.Common as X
-import           IHaskell.Display.Widgets.Types as X (setField, getField)
+import           IHaskell.Display.Widgets.Types as X (setField, getField, properties)

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

@@ -12,7 +12,7 @@ CheckBox,
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import           Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -61,4 +61,4 @@ instance IHaskellWidget CheckBox where
         key2 = "value" :: Text
         Just (Object dict2) = HM.lookup key1 dict1
         Just (Bool value) = HM.lookup key2 dict2
-    setField' widget SBoolValue value
+    void $ setField' widget SBoolValue value

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

@@ -5,14 +5,14 @@
 
 module IHaskell.Display.Widgets.Bool.ToggleButton (
 -- * The ToggleButton Widget
-ToggleButton, 
+ToggleButton,
               -- * Constructor
               mkToggleButton) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import           Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -66,4 +66,4 @@ instance IHaskellWidget ToggleButton where
         key2 = "value" :: Text
         Just (Object dict2) = HM.lookup key1 dict1
         Just (Bool value) = HM.lookup key2 dict2
-    setField' widget SBoolValue value
+    void $ setField' widget SBoolValue value

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

@@ -6,6 +6,7 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module IHaskell.Display.Widgets.Common where
 
 import Data.Aeson
@@ -81,6 +82,11 @@ singletons [d|
              deriving (Eq, Ord, Show)
              |]
 
+newtype StrInt = StrInt Integer deriving (Num, Ord, Eq, Enum)
+
+instance ToJSON StrInt where
+  toJSON (StrInt x) = toJSON . pack $ show x
+
 -- | Pre-defined border styles
 data BorderStyleValue = NoBorder
                       | HiddenBorder

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

@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.BoundedFloat.BoundedFloatText (
 import           Prelude
 
 import           Control.Exception (throw, ArithException (LossOfPrecision))
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -68,4 +68,4 @@ instance IHaskellWidget BoundedFloatText where
     newValue <- if abs value < 10 ^ 16
                   then return (Sci.toRealFloat value)
                   else throw LossOfPrecision
-    setField' widget SFloatValue newValue
+    void $ setField' widget SFloatValue newValue

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

@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider (
 import           Prelude
 
 import           Control.Exception (throw, ArithException (LossOfPrecision))
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -74,4 +74,4 @@ instance IHaskellWidget FloatSlider where
     newValue <- if abs value < 10 ^ 16
                   then return (Sci.toRealFloat value)
                   else throw LossOfPrecision
-    setField' widget SFloatValue newValue
+    void $ setField' widget SFloatValue newValue

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

@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider (
 import           Prelude
 
 import           Control.Exception (throw, ArithException (LossOfPrecision))
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -73,4 +73,4 @@ instance IHaskellWidget FloatRangeSlider where
         Just (Object dict2) = HM.lookup key1 dict1
         Just (Array values) = HM.lookup key2 dict2
         [x, y] = map (\(Number x) -> Sci.toRealFloat x) $ V.toList values
-    setField' widget SFloatPairValue (x, y)
+    void $ setField' widget SFloatPairValue (x, y)

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

@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.FloatText (
 import           Prelude
 
 import           Control.Exception (throw, ArithException (LossOfPrecision))
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -65,4 +65,4 @@ instance IHaskellWidget FloatText where
     newValue <- if abs value < 10 ^ 16
                   then return (Sci.toRealFloat value)
                   else throw LossOfPrecision
-    setField' widget SFloatValue newValue
+    void $ setField' widget SFloatValue newValue

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

@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText (
 import           Prelude
 
 import           Control.Exception (throw, ArithException (LossOfPrecision))
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -68,4 +68,4 @@ instance IHaskellWidget BoundedIntText where
     newValue <- if abs value < 10 ^ 16
                   then return (Sci.coefficient value)
                   else throw LossOfPrecision
-    setField' widget SIntValue newValue
+    void $ setField' widget SIntValue newValue

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

@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.BoundedInt.IntSlider (
 import           Prelude
 
 import           Control.Exception (throw, ArithException (LossOfPrecision))
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -74,4 +74,4 @@ instance IHaskellWidget IntSlider where
     newValue <- if abs value < 10 ^ 16
                   then return (Sci.coefficient value)
                   else throw LossOfPrecision
-    setField' widget SIntValue newValue
+    void $ setField' widget SIntValue newValue

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

@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider (
 import           Prelude
 
 import           Control.Exception (throw, ArithException (LossOfPrecision))
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -73,4 +73,4 @@ instance IHaskellWidget IntRangeSlider where
         Just (Object dict2) = HM.lookup key1 dict1
         Just (Array values) = HM.lookup key2 dict2
         [x, y] = map (\(Number x) -> Sci.coefficient x) $ V.toList values
-    setField' widget SIntPairValue (x, y)
+    void $ setField' widget SIntPairValue (x, y)

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

@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.IntText (
 import           Prelude
 
 import           Control.Exception (throw, ArithException (LossOfPrecision))
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -65,4 +65,4 @@ instance IHaskellWidget IntText where
     newValue <- if abs value < 10 ^ 16
                   then return (Sci.coefficient value)
                   else throw LossOfPrecision
-    setField' widget SIntValue newValue
+    void $ setField' widget SIntValue newValue

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

@@ -5,14 +5,14 @@
 
 module IHaskell.Display.Widgets.Selection.Dropdown (
 -- * The Dropdown Widget
-Dropdown, 
+Dropdown,
           -- * Constructor
           mkDropdown) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -68,13 +68,13 @@ instance IHaskellWidget Dropdown where
         Just (String label) = HM.lookup key2 dict2
     opts <- getField widget SOptions
     case opts of
-      OptionLabels _ -> do
+      OptionLabels _ -> void $ do
         setField' widget SSelectedLabel label
         setField' widget SSelectedValue label
       OptionDict ps ->
         case lookup label ps of
           Nothing -> return ()
-          Just value -> do
+          Just value -> void $ do
             setField' widget SSelectedLabel label
             setField' widget SSelectedValue value
     triggerSelection widget

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

@@ -5,14 +5,14 @@
 
 module IHaskell.Display.Widgets.Selection.RadioButtons (
 -- * The RadioButtons Widget
-RadioButtons, 
+RadioButtons,
               -- * Constructor
               mkRadioButtons) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -66,13 +66,13 @@ instance IHaskellWidget RadioButtons where
         Just (String label) = HM.lookup key2 dict2
     opts <- getField widget SOptions
     case opts of
-      OptionLabels _ -> do
+      OptionLabels _ -> void $ do
         setField' widget SSelectedLabel label
         setField' widget SSelectedValue label
       OptionDict ps ->
         case lookup label ps of
           Nothing -> return ()
-          Just value -> do
+          Just value -> void $ do
             setField' widget SSelectedLabel label
             setField' widget SSelectedValue value
     triggerSelection widget

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

@@ -12,7 +12,7 @@ Select,
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -65,13 +65,13 @@ instance IHaskellWidget Select where
         Just (String label) = HM.lookup key2 dict2
     opts <- getField widget SOptions
     case opts of
-      OptionLabels _ -> do
+      OptionLabels _ -> void $ do
         setField' widget SSelectedLabel label
         setField' widget SSelectedValue label
       OptionDict ps ->
         case lookup label ps of
           Nothing -> return ()
-          Just value -> do
+          Just value -> void $ do
             setField' widget SSelectedLabel label
             setField' widget SSelectedValue value
     triggerSelection widget

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

@@ -12,7 +12,7 @@ SelectMultiple,
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (fmap, join, sequence)
+import           Control.Monad (fmap, join, sequence, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -70,13 +70,13 @@ instance IHaskellWidget SelectMultiple where
         labelList = map (\(String x) -> x) $ V.toList labels
     opts <- getField widget SOptions
     case opts of
-      OptionLabels _ -> do
+      OptionLabels _ -> void $ do
         setField' widget SSelectedLabels labelList
         setField' widget SSelectedValues labelList
       OptionDict ps ->
         case sequence $ map (`lookup` ps) labelList of
           Nothing -> return ()
-          Just valueList -> do
+          Just valueList -> void $ do
             setField' widget SSelectedLabels labelList
             setField' widget SSelectedValues valueList
     triggerSelection widget

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

@@ -5,14 +5,14 @@
 
 module IHaskell.Display.Widgets.Selection.ToggleButtons (
 -- * The ToggleButtons Widget
-ToggleButtons, 
+ToggleButtons,
                -- * Constructor
                mkToggleButtons) where
 
 -- To keep `cabal repl` happy when running from the ihaskell repo
 import           Prelude
 
-import           Control.Monad (when, join)
+import           Control.Monad (when, join, void)
 import           Data.Aeson
 import qualified Data.HashMap.Strict as HM
 import           Data.IORef (newIORef)
@@ -73,13 +73,13 @@ instance IHaskellWidget ToggleButtons where
         Just (String label) = HM.lookup key2 dict2
     opts <- getField widget SOptions
     case opts of
-      OptionLabels _ -> do
+      OptionLabels _ -> void $ do
         setField' widget SSelectedLabel label
         setField' widget SSelectedValue label
       OptionDict ps ->
         case lookup label ps of
           Nothing -> return ()
-          Just value -> do
+          Just value -> void $ do
             setField' widget SSelectedLabel label
             setField' widget SSelectedValue value
     triggerSelection widget

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

@@ -5,9 +5,9 @@
 
 module IHaskell.Display.Widgets.String.Text (
 -- * The Text Widget
-TextWidget, 
+TextWidget,
             -- * Constructor
-            mkTextWidget, 
+            mkTextWidget,
                           -- * Submit handling
                           triggerSubmit) where
 
@@ -66,7 +66,7 @@ instance IHaskellWidget TextWidget where
     case Map.lookup "sync_data" dict1 of
       Just (Object dict2) ->
         case Map.lookup "value" dict2 of
-          Just (String val) -> setField' tw SStringValue val
+          Just (String val) -> setField' tw SStringValue val >> return ()
           Nothing           -> return ()
       Nothing ->
         case Map.lookup "content" dict1 of

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

@@ -36,14 +36,21 @@ module IHaskell.Display.Widgets.Types where
 -- is a type present in the type-level list @ts@. Thus a 'WidgetState' is essentially a list of field
 -- properties wrapped together with the corresponding promoted Field type. See ('=::') for more.
 --
+-- The properties function can be used to view all the @Field@s associated with a widget object.
+--
+-- Attributes are represented by the @Attr@ data type, which holds the value of a field, along with
+-- the actual @Field@ object and a function to verify validity of changes to the value.
+--
 -- The IPython widgets expect state updates of the form {"property": value}, where an empty string for
--- numeric values is ignored by the frontend and the default value is used instead.
+-- numeric values is ignored by the frontend and the default value is used instead. Some numbers need to
+-- be sent as numbers (represented by @Integer@), whereas some need to be sent as Strings (@StrInt@).
 --
 -- To know more about the IPython messaging specification (as implemented in this package) take a look
 -- at the supplied MsgSpec.md.
 
-import Control.Monad (when)
+import Control.Monad (unless)
 import Control.Applicative ((<$>))
+import qualified Control.Exception as Ex
 
 import Data.Aeson
 import Data.Aeson.Types (emptyObject, Pair)
@@ -58,8 +65,6 @@ import Data.Vinyl.TypeLevel (RecAll (..))
 import Data.Singletons.Prelude ((:++))
 import Data.Singletons.TH
 
-import Numeric.Natural
-
 import IHaskell.Eval.Widgets (widgetSendUpdate)
 import IHaskell.Display (Base64, IHaskellWidget (..))
 import IHaskell.IPython.Message.UUID
@@ -94,25 +99,25 @@ type family FieldType (f :: Field) :: * where
   FieldType ModelName = Text
   FieldType ViewModule = Text
   FieldType ViewName = Text
-  FieldType MsgThrottle = Natural
-  FieldType Version = Natural
+  FieldType MsgThrottle = StrInt
+  FieldType Version = StrInt
   FieldType OnDisplayed = IO ()
   FieldType Visible = Bool
   FieldType CSS = [(Text, Text, Text)]
   FieldType DOMClasses = [Text]
-  FieldType Width = Natural
-  FieldType Height = Natural
-  FieldType Padding = Natural
-  FieldType Margin = Natural
+  FieldType Width = StrInt
+  FieldType Height = StrInt
+  FieldType Padding = StrInt
+  FieldType Margin = StrInt
   FieldType Color = Text
   FieldType BackgroundColor = Text
   FieldType BorderColor = Text
-  FieldType BorderWidth = Natural
-  FieldType BorderRadius = Natural
+  FieldType BorderWidth = StrInt
+  FieldType BorderRadius = StrInt
   FieldType BorderStyle = BorderStyleValue
   FieldType FontStyle = FontStyleValue
   FieldType FontWeight = FontWeightValue
-  FieldType FontSize = Natural
+  FieldType FontSize = StrInt
   FieldType FontFamily = Text
   FieldType Description = Text
   FieldType ClickHandler = IO ()
@@ -135,11 +140,11 @@ type family FieldType (f :: Field) :: * where
   FieldType SelectedLabels = [Text]
   FieldType SelectedValues = [Text]
   FieldType IntValue = Integer
-  FieldType StepInt = Natural
-  FieldType MinInt = Int
-  FieldType MaxInt = Int
-  FieldType LowerInt = Int
-  FieldType UpperInt = Int
+  FieldType StepInt = Integer
+  FieldType MinInt = Integer
+  FieldType MaxInt = Integer
+  FieldType LowerInt = Integer
+  FieldType UpperInt = Integer
   FieldType IntPairValue = (Integer, Integer)
   FieldType Orientation = OrientationValue
   FieldType ShowRange = Bool
@@ -154,6 +159,25 @@ type family FieldType (f :: Field) :: * where
   FieldType UpperFloat = Double
   FieldType FloatPairValue = (Double, Double)
 
+-- Will use a custom class rather than a newtype wrapper with an orphan instance. The main issue is
+-- the need of a Bounded instance for Float / Double.
+class CustomBounded a where
+  lowerBound :: a
+  upperBound :: a
+
+-- Set according to what IPython widgets use
+instance CustomBounded StrInt where
+  upperBound = 10 ^ 16 - 1
+  lowerBound = - (10 ^ 16 - 1)
+
+instance CustomBounded Integer where
+  lowerBound = - (10 ^ 16 - 1)
+  upperBound = 10 ^ 16 - 1
+
+instance CustomBounded Double where
+  lowerBound = - (10 ** 16 - 1)
+  upperBound = 10 ** 16 - 1
+
 -- Different types of widgets. Every widget in IPython has a corresponding WidgetType
 data WidgetType = ButtonType
                 | ImageType
@@ -207,85 +231,127 @@ type family WidgetFields (w :: WidgetType) :: [Field] where
   WidgetFields FloatProgressType = BoundedFloatClass :++ '[BarStyle]
   WidgetFields FloatRangeSliderType = BoundedFloatRangeClass :++ '[Orientation, ShowRange, ReadOut, SliderColor]
 
--- Wrapper around a field
-newtype Attr (f :: Field) = Attr { _unAttr :: FieldType f }
+-- Wrapper around a field's value. A dummy value is sent as an empty string to the frontend.
+data AttrVal a = Dummy a | Real a
+
+unwrap :: AttrVal a -> a
+unwrap (Dummy x) = x
+unwrap (Real x) = x
+
+-- Wrapper around a field.
+data Attr (f :: Field) =
+  Attr { _value :: AttrVal (FieldType f)
+       , _verify :: FieldType f -> IO (FieldType f)
+       , _field :: Field
+       }
+
+instance ToJSON (FieldType f) => ToJSON (Attr f) where
+  toJSON attr = case _value attr of
+    Dummy _ -> ""
+    Real x -> toJSON x
 
 -- Types that can be converted to Aeson Pairs.
 class ToPairs a where
   toPairs :: a -> [Pair]
 
 -- Attributes that aren't synced with the frontend give [] on toPairs
-instance ToPairs (Attr ModelModule) where toPairs (Attr x) = ["_model_module" .= toJSON x]
-instance ToPairs (Attr ModelName) where toPairs (Attr x) = ["_model_name" .= toJSON x]
-instance ToPairs (Attr ViewModule) where toPairs (Attr x) = ["_view_module" .= toJSON x]
-instance ToPairs (Attr ViewName) where toPairs (Attr x) = ["_view_name" .= toJSON x]
-instance ToPairs (Attr MsgThrottle) where toPairs (Attr x) = ["msg_throttle" .= toJSON x]
-instance ToPairs (Attr Version) where toPairs (Attr x) = ["version" .= toJSON x]
+instance ToPairs (Attr ModelModule) where toPairs x = ["_model_module" .= toJSON x]
+instance ToPairs (Attr ModelName) where toPairs x = ["_model_name" .= toJSON x]
+instance ToPairs (Attr ViewModule) where toPairs x = ["_view_module" .= toJSON x]
+instance ToPairs (Attr ViewName) where toPairs x = ["_view_name" .= toJSON x]
+instance ToPairs (Attr MsgThrottle) where toPairs x = ["msg_throttle" .= toJSON x]
+instance ToPairs (Attr Version) where toPairs x = ["version" .= toJSON x]
 instance ToPairs (Attr OnDisplayed) where toPairs _ = [] -- Not sent to the frontend
-instance ToPairs (Attr Visible) where toPairs (Attr x) = ["visible" .= toJSON x]
-instance ToPairs (Attr CSS) where toPairs (Attr x) = ["_css" .= toJSON x]
-instance ToPairs (Attr DOMClasses) where toPairs (Attr x) = ["_dom_classes" .= toJSON x]
-instance ToPairs (Attr Width) where toPairs (Attr x) = ["width" .= toJSON x]
-instance ToPairs (Attr Height) where toPairs (Attr x) = ["height" .= toJSON x]
-instance ToPairs (Attr Padding) where toPairs (Attr x) = ["padding" .= toJSON x]
-instance ToPairs (Attr Margin) where toPairs (Attr x) = ["margin" .= toJSON x]
-instance ToPairs (Attr Color) where toPairs (Attr x) = ["color" .= toJSON x]
-instance ToPairs (Attr BackgroundColor) where toPairs (Attr x) = ["background_color" .= toJSON x]
-instance ToPairs (Attr BorderColor) where toPairs (Attr x) = ["border_color" .= toJSON x]
-instance ToPairs (Attr BorderWidth) where toPairs (Attr x) = ["border_width" .= toJSON x]
-instance ToPairs (Attr BorderRadius) where toPairs (Attr x) = ["border_radius" .= toJSON x]
-instance ToPairs (Attr BorderStyle) where toPairs (Attr x) = ["border_style" .= toJSON x]
-instance ToPairs (Attr FontStyle) where toPairs (Attr x) = ["font_style" .= toJSON x]
-instance ToPairs (Attr FontWeight) where toPairs (Attr x) = ["font_weight" .= toJSON x]
-instance ToPairs (Attr FontSize) where toPairs (Attr x) = ["font_size" .= toJSON x]
-instance ToPairs (Attr FontFamily) where toPairs (Attr x) = ["font_family" .= toJSON x]
-instance ToPairs (Attr Description) where toPairs (Attr x) = ["description" .= toJSON x]
+instance ToPairs (Attr Visible) where toPairs x = ["visible" .= toJSON x]
+instance ToPairs (Attr CSS) where toPairs x = ["_css" .= toJSON x]
+instance ToPairs (Attr DOMClasses) where toPairs x = ["_dom_classes" .= toJSON x]
+instance ToPairs (Attr Width) where toPairs x = ["width" .= toJSON x]
+instance ToPairs (Attr Height) where toPairs x = ["height" .= toJSON x]
+instance ToPairs (Attr Padding) where toPairs x = ["padding" .= toJSON x]
+instance ToPairs (Attr Margin) where toPairs x = ["margin" .= toJSON x]
+instance ToPairs (Attr Color) where toPairs x = ["color" .= toJSON x]
+instance ToPairs (Attr BackgroundColor) where toPairs x = ["background_color" .= toJSON x]
+instance ToPairs (Attr BorderColor) where toPairs x = ["border_color" .= toJSON x]
+instance ToPairs (Attr BorderWidth) where toPairs x = ["border_width" .= toJSON x]
+instance ToPairs (Attr BorderRadius) where toPairs x = ["border_radius" .= toJSON x]
+instance ToPairs (Attr BorderStyle) where toPairs x = ["border_style" .= toJSON x]
+instance ToPairs (Attr FontStyle) where toPairs x = ["font_style" .= toJSON x]
+instance ToPairs (Attr FontWeight) where toPairs x = ["font_weight" .= toJSON x]
+instance ToPairs (Attr FontSize) where toPairs x = ["font_size" .= toJSON x]
+instance ToPairs (Attr FontFamily) where toPairs x = ["font_family" .= toJSON x]
+instance ToPairs (Attr Description) where toPairs x = ["description" .= toJSON x]
 instance ToPairs (Attr ClickHandler) where toPairs _ = [] -- Not sent to the frontend
 instance ToPairs (Attr SubmitHandler) where toPairs _ = [] -- Not sent to the frontend
-instance ToPairs (Attr Disabled) where toPairs (Attr x) = ["disabled" .= toJSON x]
-instance ToPairs (Attr StringValue) where toPairs (Attr x) = ["value" .= toJSON x]
-instance ToPairs (Attr Placeholder) where toPairs (Attr x) = ["placeholder" .= toJSON x]
-instance ToPairs (Attr Tooltip) where toPairs (Attr x) = ["tooltip" .= toJSON x]
-instance ToPairs (Attr Icon) where toPairs (Attr x) = ["icon" .= toJSON x]
-instance ToPairs (Attr ButtonStyle) where toPairs (Attr x) = ["button_style" .= toJSON x]
-instance ToPairs (Attr B64Value) where toPairs (Attr x) = ["_b64value" .= toJSON x]
-instance ToPairs (Attr ImageFormat) where toPairs (Attr x) = ["format" .= toJSON x]
-instance ToPairs (Attr BoolValue) where toPairs (Attr x) = ["value" .= toJSON x]
-instance ToPairs (Attr SelectedLabel) where toPairs (Attr x) = ["selected_label" .= toJSON x]
-instance ToPairs (Attr SelectedValue) where toPairs (Attr x) = ["value" .= toJSON x]
+instance ToPairs (Attr Disabled) where toPairs x = ["disabled" .= toJSON x]
+instance ToPairs (Attr StringValue) where toPairs x = ["value" .= toJSON x]
+instance ToPairs (Attr Placeholder) where toPairs x = ["placeholder" .= toJSON x]
+instance ToPairs (Attr Tooltip) where toPairs x = ["tooltip" .= toJSON x]
+instance ToPairs (Attr Icon) where toPairs x = ["icon" .= toJSON x]
+instance ToPairs (Attr ButtonStyle) where toPairs x = ["button_style" .= toJSON x]
+instance ToPairs (Attr B64Value) where toPairs x = ["_b64value" .= toJSON x]
+instance ToPairs (Attr ImageFormat) where toPairs x = ["format" .= toJSON x]
+instance ToPairs (Attr BoolValue) where toPairs x = ["value" .= toJSON x]
+instance ToPairs (Attr SelectedLabel) where toPairs x = ["selected_label" .= toJSON x]
+instance ToPairs (Attr SelectedValue) where toPairs x = ["value" .= toJSON x]
 instance ToPairs (Attr Options) where
-  toPairs (Attr x) = case x of
-    OptionLabels xs -> labels xs
-    OptionDict xps -> labels $ map fst xps
+  toPairs x = case _value x of
+    Dummy _ -> labels ("" :: Text)
+    Real (OptionLabels xs) -> labels xs
+    Real (OptionDict xps) -> labels $ map fst xps
     where labels xs = ["_options_labels" .= xs]
 instance ToPairs (Attr SelectionHandler) where toPairs _ = [] -- Not sent to the frontend
-instance ToPairs (Attr Tooltips) where toPairs (Attr x) = ["tooltips" .= toJSON x]
-instance ToPairs (Attr Icons) where toPairs (Attr x) = ["icons" .= toJSON x]
-instance ToPairs (Attr SelectedLabels) where toPairs (Attr x) = ["selected_labels" .= toJSON x]
-instance ToPairs (Attr SelectedValues) where toPairs (Attr x) = ["values" .= toJSON x]
-instance ToPairs (Attr IntValue) where toPairs (Attr x) = ["value" .= toJSON x]
-instance ToPairs (Attr StepInt) where toPairs (Attr x) = ["step" .= toJSON x]
-instance ToPairs (Attr MinInt) where toPairs (Attr x) = ["min" .= toJSON x]
-instance ToPairs (Attr MaxInt) where toPairs (Attr x) = ["max" .= toJSON x]
-instance ToPairs (Attr IntPairValue) where toPairs (Attr x) = ["value" .= toJSON x]
-instance ToPairs (Attr LowerInt) where toPairs (Attr x) = ["min" .= toJSON x]
-instance ToPairs (Attr UpperInt) where toPairs (Attr x) = ["max" .= toJSON x]
-instance ToPairs (Attr FloatValue) where toPairs (Attr x) = ["value" .= toJSON x]
-instance ToPairs (Attr StepFloat) where toPairs (Attr x) = ["step" .= toJSON x]
-instance ToPairs (Attr MinFloat) where toPairs (Attr x) = ["min" .= toJSON x]
-instance ToPairs (Attr MaxFloat) where toPairs (Attr x) = ["max" .= toJSON x]
-instance ToPairs (Attr FloatPairValue) where toPairs (Attr x) = ["value" .= toJSON x]
-instance ToPairs (Attr LowerFloat) where toPairs (Attr x) = ["min" .= toJSON x]
-instance ToPairs (Attr UpperFloat) where toPairs (Attr x) = ["max" .= toJSON x]
-instance ToPairs (Attr Orientation) where toPairs (Attr x) = ["orientation" .= toJSON x]
-instance ToPairs (Attr ShowRange) where toPairs (Attr x) = ["_range" .= toJSON x]
-instance ToPairs (Attr ReadOut) where toPairs (Attr x) = ["readout" .= toJSON x]
-instance ToPairs (Attr SliderColor) where toPairs (Attr x) = ["slider_color" .= toJSON x]
-instance ToPairs (Attr BarStyle) where toPairs (Attr x) = ["bar_style" .= toJSON x]
-
--- | Store the value for a field, as an object parametrized by the Field
-(=::) :: sing f -> FieldType f -> Attr f
-_ =:: x = Attr x
+instance ToPairs (Attr Tooltips) where toPairs x = ["tooltips" .= toJSON x]
+instance ToPairs (Attr Icons) where toPairs x = ["icons" .= toJSON x]
+instance ToPairs (Attr SelectedLabels) where toPairs x = ["selected_labels" .= toJSON x]
+instance ToPairs (Attr SelectedValues) where toPairs x = ["values" .= toJSON x]
+instance ToPairs (Attr IntValue) where toPairs x = ["value" .= toJSON x]
+instance ToPairs (Attr StepInt) where toPairs x = ["step" .= toJSON x]
+instance ToPairs (Attr MinInt) where toPairs x = ["min" .= toJSON x]
+instance ToPairs (Attr MaxInt) where toPairs x = ["max" .= toJSON x]
+instance ToPairs (Attr IntPairValue) where toPairs x = ["value" .= toJSON x]
+instance ToPairs (Attr LowerInt) where toPairs x = ["min" .= toJSON x]
+instance ToPairs (Attr UpperInt) where toPairs x = ["max" .= toJSON x]
+instance ToPairs (Attr FloatValue) where toPairs x = ["value" .= toJSON x]
+instance ToPairs (Attr StepFloat) where toPairs x = ["step" .= toJSON x]
+instance ToPairs (Attr MinFloat) where toPairs x = ["min" .= toJSON x]
+instance ToPairs (Attr MaxFloat) where toPairs x = ["max" .= toJSON x]
+instance ToPairs (Attr FloatPairValue) where toPairs x = ["value" .= toJSON x]
+instance ToPairs (Attr LowerFloat) where toPairs x = ["min" .= toJSON x]
+instance ToPairs (Attr UpperFloat) where toPairs x = ["max" .= toJSON x]
+instance ToPairs (Attr Orientation) where toPairs x = ["orientation" .= toJSON x]
+instance ToPairs (Attr ShowRange) where toPairs x = ["_range" .= toJSON x]
+instance ToPairs (Attr ReadOut) where toPairs x = ["readout" .= toJSON x]
+instance ToPairs (Attr SliderColor) where toPairs x = ["slider_color" .= toJSON x]
+instance ToPairs (Attr BarStyle) where toPairs x = ["bar_style" .= toJSON x]
+
+-- | Store the value for a field, as an object parametrized by the Field. No verification is done
+-- for these values.
+(=::) :: SingI f => Sing f -> FieldType f -> Attr f
+s =:: x = Attr { _value = Real x, _verify = return, _field = reflect s }
+
+-- | If the number is in the range, return it. Otherwise raise the appropriate (over/under)flow
+-- exception.
+rangeCheck :: (Num a, Ord a) => (a, a) -> a -> IO a
+rangeCheck (l, u) x
+  | l <= x && x <= u = return x
+  | l > x = Ex.throw Ex.Underflow
+  | u < x = Ex.throw Ex.Overflow
+
+-- | Store a numeric value, with verification mechanism for its range.
+ranged :: (SingI f, Num (FieldType f), Ord (FieldType f))
+       => Sing f -> (FieldType f, FieldType f) -> AttrVal (FieldType f) -> Attr f
+ranged s range x = Attr x (rangeCheck range) (reflect s)
+
+-- | Store a numeric value, with the invariant that it stays non-negative. The value set is set as a
+-- dummy value if it's equal to zero.
+(=:+) :: (SingI f, Num (FieldType f), CustomBounded (FieldType f), Ord (FieldType f))
+      => Sing f -> FieldType f -> Attr f
+s =:+ val = Attr ((if val == 0 then Dummy else Real) val) (rangeCheck (0, upperBound)) (reflect s)
+
+-- | Get a field from a singleton
+-- Adapted from: http://stackoverflow.com/a/28033250/2388535
+reflect :: forall (f :: Field). (SingI f, SingKind ('KProxy :: KProxy Field)) => Sing f -> Field
+reflect = fromSing
 
 -- | A record representing an object of the Widget class from IPython
 defaultWidget :: FieldType ViewName -> Rec Attr WidgetClass
@@ -293,7 +359,7 @@ defaultWidget viewName = (SModelModule =:: "")
                       :& (SModelName =:: "WidgetModel")
                       :& (SViewModule =:: "")
                       :& (SViewName =:: viewName)
-                      :& (SMsgThrottle =:: 3)
+                      :& (SMsgThrottle =:+ 3)
                       :& (SVersion =:: 0)
                       :& (SOnDisplayed =:: return ())
                       :& RNil
@@ -304,19 +370,19 @@ defaultDOMWidget viewName = defaultWidget viewName <+> domAttrs
   where domAttrs = (SVisible =:: True)
                 :& (SCSS =:: [])
                 :& (SDOMClasses =:: [])
-                :& (SWidth =:: 0)
-                :& (SHeight =:: 0)
-                :& (SPadding =:: 0)
-                :& (SMargin =:: 0)
+                :& (SWidth =:+ 0)
+                :& (SHeight =:+ 0)
+                :& (SPadding =:+ 0)
+                :& (SMargin =:+ 0)
                 :& (SColor =:: "")
                 :& (SBackgroundColor =:: "")
                 :& (SBorderColor =:: "")
-                :& (SBorderWidth =:: 0)
-                :& (SBorderRadius =:: 0)
+                :& (SBorderWidth =:+ 0)
+                :& (SBorderRadius =:+ 0)
                 :& (SBorderStyle =:: DefaultBorder)
                 :& (SFontStyle =:: DefaultFont)
                 :& (SFontWeight =:: DefaultWeight)
-                :& (SFontSize =:: 0)
+                :& (SFontSize =:+ 0)
                 :& (SFontFamily =:: "")
                 :& RNil
 
@@ -386,7 +452,7 @@ defaultIntRangeWidget viewName = defaultIntWidget viewName <+> rangeAttrs
 -- | A record representing a widget of the _BoundedIntRange class from IPython
 defaultBoundedIntRangeWidget :: FieldType ViewName -> Rec Attr BoundedIntRangeClass
 defaultBoundedIntRangeWidget viewName = defaultIntRangeWidget viewName <+> boundedIntRangeAttrs
-  where boundedIntRangeAttrs = (SStepInt =:: 1)
+  where boundedIntRangeAttrs = (SStepInt =:+ 1)
                             :& (SMinInt =:: 0)
                             :& (SMaxInt =:: 100)
                             :& RNil
@@ -402,7 +468,7 @@ defaultFloatWidget viewName = defaultDOMWidget viewName <+> intAttrs
 -- | A record representing a widget of the _BoundedFloat class from IPython
 defaultBoundedFloatWidget :: FieldType ViewName -> Rec Attr BoundedFloatClass
 defaultBoundedFloatWidget viewName = defaultFloatWidget viewName <+> boundedFloatAttrs
-  where boundedFloatAttrs = (SStepFloat =:: 1)
+  where boundedFloatAttrs = (SStepFloat =:+ 1)
                        :& (SMinFloat =:: 0)
                        :& (SMaxFloat =:: 100)
                        :& RNil
@@ -418,7 +484,7 @@ defaultFloatRangeWidget viewName = defaultFloatWidget viewName <+> rangeAttrs
 -- | A record representing a widget of the _BoundedFloatRange class from IPython
 defaultBoundedFloatRangeWidget :: FieldType ViewName -> Rec Attr BoundedFloatRangeClass
 defaultBoundedFloatRangeWidget viewName = defaultFloatRangeWidget viewName <+> boundedFloatRangeAttrs
-  where boundedFloatRangeAttrs = (SStepFloat =:: 1)
+  where boundedFloatRangeAttrs = (SStepFloat =:+ 1)
                             :& (SMinFloat =:: 0)
                             :& (SMaxFloat =:: 100)
                             :& RNil
@@ -437,27 +503,38 @@ instance RecAll Attr (WidgetFields w) ToPairs => ToJSON (WidgetState w) where
 data IPythonWidget (w :: WidgetType) = IPythonWidget { uuid :: UUID, state :: IORef (WidgetState w) }
 
 -- | Change the value for a field, and notify the frontend about it.
-setField :: (f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w), ToPairs (Attr f)) => IPythonWidget w -> SField f -> FieldType f -> IO ()
-setField widget (sfield :: SField f) fval = do
-  setField' widget sfield fval
-  let pairs = toPairs (Attr fval :: Attr f)
-  when (not . null $ pairs) $ widgetSendUpdate widget (object pairs)
-
--- | Change the value of a field, without notifying the frontend. For internal use. Uses BangPattern.
-setField' :: (f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w)) => IPythonWidget w -> SField f -> FieldType f -> IO ()
-setField' widget sfield !fval = modifyIORef (state widget) (WidgetState . rput (sfield =:: fval) . _getState)
+setField :: (f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w), ToPairs (Attr f))
+         => IPythonWidget w -> SField f -> FieldType f -> IO ()
+setField widget sfield fval = do
+  !newattr <- setField' widget sfield fval
+  let pairs = toPairs newattr
+  unless (null pairs) $ widgetSendUpdate widget (object pairs)
+
+-- | Change the value of a field, without notifying the frontend. For internal use.
+setField' :: (f ∈ WidgetFields w, IHaskellWidget (IPythonWidget w))
+          => IPythonWidget w -> SField f -> FieldType f -> IO (Attr f)
+setField' widget sfield val = do
+  attr <- getAttr widget sfield
+  newval <- _verify attr val
+  let newattr = attr { _value = Real newval }
+  modifyIORef (state widget) (WidgetState . rput newattr . _getState)
+  return newattr
+
+-- | Pluck an attribute from a record
+getAttr :: (f ∈ WidgetFields w) => IPythonWidget w -> SField f -> IO (Attr f)
+getAttr widget sfield = rget sfield <$> _getState <$> readIORef (state widget)
 
 -- | Get the value of a field.
 getField :: (f ∈ WidgetFields w) => IPythonWidget w -> SField f -> IO (FieldType f)
-getField widget sfield = _unAttr <$> rget sfield <$> _getState <$> readIORef (state widget)
+getField widget sfield = unwrap . _value <$> getAttr widget sfield
 
 -- | Useful with toJSON and OverloadedStrings
 str :: String -> String
 str = id
 
--- | Send zero values as empty strings, which stands for default value in the frontend.
--- Sending non-zero naturals as strings causes issues in the frontend. Specifically, addition
--- becomes string concatenation which creates problems in {Int|Float}RangeSlider.
-instance ToJSON Natural where
-  toJSON 0 = String ""
-  toJSON n = Number . fromInteger $ toInteger n
+properties :: IPythonWidget w -> IO [Field]
+properties widget = do
+  st <- readIORef $ state widget
+  let convert :: Attr f -> Const Field f
+      convert attr = Const { getConst = _field attr }
+  return $ recordToList . rmap convert . _getState $ st