Commit 3466245b authored by Sumit Sahrawat's avatar Sumit Sahrawat

More refactoring

- Add `properties` to view properties of widgets.
- Remove use of `Numeric.Natural`.
- Add verification mechanisms to `Attr`.
parent 26addb62
...@@ -2,14 +2,15 @@ ...@@ -2,14 +2,15 @@
> Largely based on: https://github.com/ipython/ipython/wiki/IPEP-23:-Backbone.js-Widgets > Largely based on: https://github.com/ipython/ipython/wiki/IPEP-23:-Backbone.js-Widgets
> The messaging specification as detailed is riddled with the assumptions IHaskell's widget > The messaging specification as detailed is riddled with assumptions IHaskell's widget
> implementation makes. It works for us, so it should work for everyone. > implementation makes. It works for us, so it should work for everyone.
## Creating widgets ## Creating widgets
Let's say the user types in some code, and the only effect of that code is the creation of a widget. Let's say the user types in some code, and the only effect of that code is the creation of a widget.
The kernel will open a comm for the widget, and store a reference to that comm inside it. Then, to The kernel will open a comm for the widget, and store a reference to that comm inside it. Then, to
notify the frontend about the creation of a widget, an initial state update is sent on the widget's comm. notify the frontend about the creation of a widget, an initial state update is sent on the widget's
comm.
> The comm should be opened with a `target_name` of `"ipython.widget"`. > The comm should be opened with a `target_name` of `"ipython.widget"`.
...@@ -22,7 +23,9 @@ The initial state update message looks like this: ...@@ -22,7 +23,9 @@ The initial state update message looks like this:
} }
``` ```
Any *numeric* property initialized with the empty string is provided the default value by the frontend. Any *numeric* property initialized with the empty string is provided the default value by the
frontend. Some numbers need to be sent as actual numbers (when non-null), whereas some (especially
those used by sliders) need to be sent as strings.
The initial state update must *at least* have the following fields: The initial state update must *at least* have the following fields:
......
...@@ -33,4 +33,4 @@ import IHaskell.Display.Widgets.String.Text as X ...@@ -33,4 +33,4 @@ import IHaskell.Display.Widgets.String.Text as X
import IHaskell.Display.Widgets.String.TextArea as X import IHaskell.Display.Widgets.String.TextArea as X
import IHaskell.Display.Widgets.Common as X import IHaskell.Display.Widgets.Common as X
import IHaskell.Display.Widgets.Types as X (setField, getField) import IHaskell.Display.Widgets.Types as X (setField, getField, properties)
...@@ -12,7 +12,7 @@ CheckBox, ...@@ -12,7 +12,7 @@ CheckBox,
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import Data.HashMap.Strict as HM import Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -61,4 +61,4 @@ instance IHaskellWidget CheckBox where ...@@ -61,4 +61,4 @@ instance IHaskellWidget CheckBox where
key2 = "value" :: Text key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Bool value) = HM.lookup key2 dict2 Just (Bool value) = HM.lookup key2 dict2
setField' widget SBoolValue value void $ setField' widget SBoolValue value
...@@ -5,14 +5,14 @@ ...@@ -5,14 +5,14 @@
module IHaskell.Display.Widgets.Bool.ToggleButton ( module IHaskell.Display.Widgets.Bool.ToggleButton (
-- * The ToggleButton Widget -- * The ToggleButton Widget
ToggleButton, ToggleButton,
-- * Constructor -- * Constructor
mkToggleButton) where mkToggleButton) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import Data.HashMap.Strict as HM import Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -66,4 +66,4 @@ instance IHaskellWidget ToggleButton where ...@@ -66,4 +66,4 @@ instance IHaskellWidget ToggleButton where
key2 = "value" :: Text key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Bool value) = HM.lookup key2 dict2 Just (Bool value) = HM.lookup key2 dict2
setField' widget SBoolValue value void $ setField' widget SBoolValue value
...@@ -6,6 +6,7 @@ ...@@ -6,6 +6,7 @@
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-} {-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module IHaskell.Display.Widgets.Common where module IHaskell.Display.Widgets.Common where
import Data.Aeson import Data.Aeson
...@@ -81,6 +82,11 @@ singletons [d| ...@@ -81,6 +82,11 @@ singletons [d|
deriving (Eq, Ord, Show) deriving (Eq, Ord, Show)
|] |]
newtype StrInt = StrInt Integer deriving (Num, Ord, Eq, Enum)
instance ToJSON StrInt where
toJSON (StrInt x) = toJSON . pack $ show x
-- | Pre-defined border styles -- | Pre-defined border styles
data BorderStyleValue = NoBorder data BorderStyleValue = NoBorder
| HiddenBorder | HiddenBorder
......
...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.BoundedFloat.BoundedFloatText ( ...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.BoundedFloat.BoundedFloatText (
import Prelude import Prelude
import Control.Exception (throw, ArithException (LossOfPrecision)) import Control.Exception (throw, ArithException (LossOfPrecision))
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -68,4 +68,4 @@ instance IHaskellWidget BoundedFloatText where ...@@ -68,4 +68,4 @@ instance IHaskellWidget BoundedFloatText where
newValue <- if abs value < 10 ^ 16 newValue <- if abs value < 10 ^ 16
then return (Sci.toRealFloat value) then return (Sci.toRealFloat value)
else throw LossOfPrecision else throw LossOfPrecision
setField' widget SFloatValue newValue void $ setField' widget SFloatValue newValue
...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider ( ...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.BoundedFloat.FloatSlider (
import Prelude import Prelude
import Control.Exception (throw, ArithException (LossOfPrecision)) import Control.Exception (throw, ArithException (LossOfPrecision))
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -74,4 +74,4 @@ instance IHaskellWidget FloatSlider where ...@@ -74,4 +74,4 @@ instance IHaskellWidget FloatSlider where
newValue <- if abs value < 10 ^ 16 newValue <- if abs value < 10 ^ 16
then return (Sci.toRealFloat value) then return (Sci.toRealFloat value)
else throw LossOfPrecision else throw LossOfPrecision
setField' widget SFloatValue newValue void $ setField' widget SFloatValue newValue
...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider ( ...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.BoundedFloatRange.FloatRangeSlider (
import Prelude import Prelude
import Control.Exception (throw, ArithException (LossOfPrecision)) import Control.Exception (throw, ArithException (LossOfPrecision))
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -73,4 +73,4 @@ instance IHaskellWidget FloatRangeSlider where ...@@ -73,4 +73,4 @@ instance IHaskellWidget FloatRangeSlider where
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Array values) = HM.lookup key2 dict2 Just (Array values) = HM.lookup key2 dict2
[x, y] = map (\(Number x) -> Sci.toRealFloat x) $ V.toList values [x, y] = map (\(Number x) -> Sci.toRealFloat x) $ V.toList values
setField' widget SFloatPairValue (x, y) void $ setField' widget SFloatPairValue (x, y)
...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.FloatText ( ...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Float.FloatText (
import Prelude import Prelude
import Control.Exception (throw, ArithException (LossOfPrecision)) import Control.Exception (throw, ArithException (LossOfPrecision))
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -65,4 +65,4 @@ instance IHaskellWidget FloatText where ...@@ -65,4 +65,4 @@ instance IHaskellWidget FloatText where
newValue <- if abs value < 10 ^ 16 newValue <- if abs value < 10 ^ 16
then return (Sci.toRealFloat value) then return (Sci.toRealFloat value)
else throw LossOfPrecision else throw LossOfPrecision
setField' widget SFloatValue newValue void $ setField' widget SFloatValue newValue
...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText ( ...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.BoundedInt.BoundedIntText (
import Prelude import Prelude
import Control.Exception (throw, ArithException (LossOfPrecision)) import Control.Exception (throw, ArithException (LossOfPrecision))
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -68,4 +68,4 @@ instance IHaskellWidget BoundedIntText where ...@@ -68,4 +68,4 @@ instance IHaskellWidget BoundedIntText where
newValue <- if abs value < 10 ^ 16 newValue <- if abs value < 10 ^ 16
then return (Sci.coefficient value) then return (Sci.coefficient value)
else throw LossOfPrecision else throw LossOfPrecision
setField' widget SIntValue newValue void $ setField' widget SIntValue newValue
...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.BoundedInt.IntSlider ( ...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.BoundedInt.IntSlider (
import Prelude import Prelude
import Control.Exception (throw, ArithException (LossOfPrecision)) import Control.Exception (throw, ArithException (LossOfPrecision))
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -74,4 +74,4 @@ instance IHaskellWidget IntSlider where ...@@ -74,4 +74,4 @@ instance IHaskellWidget IntSlider where
newValue <- if abs value < 10 ^ 16 newValue <- if abs value < 10 ^ 16
then return (Sci.coefficient value) then return (Sci.coefficient value)
else throw LossOfPrecision else throw LossOfPrecision
setField' widget SIntValue newValue void $ setField' widget SIntValue newValue
...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider ( ...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.BoundedIntRange.IntRangeSlider (
import Prelude import Prelude
import Control.Exception (throw, ArithException (LossOfPrecision)) import Control.Exception (throw, ArithException (LossOfPrecision))
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -73,4 +73,4 @@ instance IHaskellWidget IntRangeSlider where ...@@ -73,4 +73,4 @@ instance IHaskellWidget IntRangeSlider where
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Array values) = HM.lookup key2 dict2 Just (Array values) = HM.lookup key2 dict2
[x, y] = map (\(Number x) -> Sci.coefficient x) $ V.toList values [x, y] = map (\(Number x) -> Sci.coefficient x) $ V.toList values
setField' widget SIntPairValue (x, y) void $ setField' widget SIntPairValue (x, y)
...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.IntText ( ...@@ -13,7 +13,7 @@ module IHaskell.Display.Widgets.Int.IntText (
import Prelude import Prelude
import Control.Exception (throw, ArithException (LossOfPrecision)) import Control.Exception (throw, ArithException (LossOfPrecision))
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -65,4 +65,4 @@ instance IHaskellWidget IntText where ...@@ -65,4 +65,4 @@ instance IHaskellWidget IntText where
newValue <- if abs value < 10 ^ 16 newValue <- if abs value < 10 ^ 16
then return (Sci.coefficient value) then return (Sci.coefficient value)
else throw LossOfPrecision else throw LossOfPrecision
setField' widget SIntValue newValue void $ setField' widget SIntValue newValue
...@@ -5,14 +5,14 @@ ...@@ -5,14 +5,14 @@
module IHaskell.Display.Widgets.Selection.Dropdown ( module IHaskell.Display.Widgets.Selection.Dropdown (
-- * The Dropdown Widget -- * The Dropdown Widget
Dropdown, Dropdown,
-- * Constructor -- * Constructor
mkDropdown) where mkDropdown) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -68,13 +68,13 @@ instance IHaskellWidget Dropdown where ...@@ -68,13 +68,13 @@ instance IHaskellWidget Dropdown where
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue label setField' widget SSelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue value setField' widget SSelectedValue value
triggerSelection widget triggerSelection widget
...@@ -5,14 +5,14 @@ ...@@ -5,14 +5,14 @@
module IHaskell.Display.Widgets.Selection.RadioButtons ( module IHaskell.Display.Widgets.Selection.RadioButtons (
-- * The RadioButtons Widget -- * The RadioButtons Widget
RadioButtons, RadioButtons,
-- * Constructor -- * Constructor
mkRadioButtons) where mkRadioButtons) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -66,13 +66,13 @@ instance IHaskellWidget RadioButtons where ...@@ -66,13 +66,13 @@ instance IHaskellWidget RadioButtons where
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue label setField' widget SSelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue value setField' widget SSelectedValue value
triggerSelection widget triggerSelection widget
...@@ -12,7 +12,7 @@ Select, ...@@ -12,7 +12,7 @@ Select,
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -65,13 +65,13 @@ instance IHaskellWidget Select where ...@@ -65,13 +65,13 @@ instance IHaskellWidget Select where
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue label setField' widget SSelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue value setField' widget SSelectedValue value
triggerSelection widget triggerSelection widget
...@@ -12,7 +12,7 @@ SelectMultiple, ...@@ -12,7 +12,7 @@ SelectMultiple,
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (fmap, join, sequence) import Control.Monad (fmap, join, sequence, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -70,13 +70,13 @@ instance IHaskellWidget SelectMultiple where ...@@ -70,13 +70,13 @@ instance IHaskellWidget SelectMultiple where
labelList = map (\(String x) -> x) $ V.toList labels labelList = map (\(String x) -> x) $ V.toList labels
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabels labelList setField' widget SSelectedLabels labelList
setField' widget SSelectedValues labelList setField' widget SSelectedValues labelList
OptionDict ps -> OptionDict ps ->
case sequence $ map (`lookup` ps) labelList of case sequence $ map (`lookup` ps) labelList of
Nothing -> return () Nothing -> return ()
Just valueList -> do Just valueList -> void $ do
setField' widget SSelectedLabels labelList setField' widget SSelectedLabels labelList
setField' widget SSelectedValues valueList setField' widget SSelectedValues valueList
triggerSelection widget triggerSelection widget
...@@ -5,14 +5,14 @@ ...@@ -5,14 +5,14 @@
module IHaskell.Display.Widgets.Selection.ToggleButtons ( module IHaskell.Display.Widgets.Selection.ToggleButtons (
-- * The ToggleButtons Widget -- * The ToggleButtons Widget
ToggleButtons, ToggleButtons,
-- * Constructor -- * Constructor
mkToggleButtons) where mkToggleButtons) where
-- To keep `cabal repl` happy when running from the ihaskell repo -- To keep `cabal repl` happy when running from the ihaskell repo
import Prelude import Prelude
import Control.Monad (when, join) import Control.Monad (when, join, void)
import Data.Aeson import Data.Aeson
import qualified Data.HashMap.Strict as HM import qualified Data.HashMap.Strict as HM
import Data.IORef (newIORef) import Data.IORef (newIORef)
...@@ -73,13 +73,13 @@ instance IHaskellWidget ToggleButtons where ...@@ -73,13 +73,13 @@ instance IHaskellWidget ToggleButtons where
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget SOptions
case opts of case opts of
OptionLabels _ -> do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue label setField' widget SSelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SSelectedLabel label
setField' widget SSelectedValue value setField' widget SSelectedValue value
triggerSelection widget triggerSelection widget
...@@ -5,9 +5,9 @@ ...@@ -5,9 +5,9 @@
module IHaskell.Display.Widgets.String.Text ( module IHaskell.Display.Widgets.String.Text (
-- * The Text Widget -- * The Text Widget
TextWidget, TextWidget,
-- * Constructor -- * Constructor
mkTextWidget, mkTextWidget,
-- * Submit handling -- * Submit handling
triggerSubmit) where triggerSubmit) where
...@@ -66,7 +66,7 @@ instance IHaskellWidget TextWidget where ...@@ -66,7 +66,7 @@ instance IHaskellWidget TextWidget where
case Map.lookup "sync_data" dict1 of case Map.lookup "sync_data" dict1 of
Just (Object dict2) -> Just (Object dict2) ->
case Map.lookup "value" dict2 of case Map.lookup "value" dict2 of
Just (String val) -> setField' tw SStringValue val Just (String val) -> setField' tw SStringValue val >> return ()
Nothing -> return () Nothing -> return ()
Nothing -> Nothing ->
case Map.lookup "content" dict1 of case Map.lookup "content" dict1 of
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment