Skip to content

G
gargantext-ihaskell
Commit 6622b260 authored by Sumit Sahrawat's avatar Sumit Sahrawat
Browse files
Options

Get rid of S prefix on singletons

parent 3a2228d2
Show whitespace changes
Inline Side-by-side
Showing with 525 additions and 442 deletions
ihaskell-display/ihaskell-widgets/ihaskell-widgets.cabal
View file @ 6622b260
...@@ -85,6 +85,7 @@ library ...@@ -85,6 +85,7 @@ library
IHaskell.Display.Widgets.Types IHaskell.Display.Widgets.Types
IHaskell.Display.Widgets.Common IHaskell.Display.Widgets.Common
IHaskell.Display.Widgets.Singletons
-- LANGUAGE extensions used by modules in this package. -- LANGUAGE extensions used by modules in this package.
-- other-extensions: -- other-extensions:
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Bool/CheckBox.hs
View file @ 6622b260
...@@ -61,5 +61,5 @@ instance IHaskellWidget CheckBox where ...@@ -61,5 +61,5 @@ 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 setField' widget BoolValue value
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Bool/ToggleButton.hs
View file @ 6622b260
...@@ -36,9 +36,9 @@ mkToggleButton = do ...@@ -36,9 +36,9 @@ mkToggleButton = do
uuid <- U.random uuid <- U.random
let boolState = defaultBoolWidget "ToggleButtonView" let boolState = defaultBoolWidget "ToggleButtonView"
toggleState = (STooltip =:: "") toggleState = (Tooltip =:: "")
:& (SIcon =:: "") :& (Icon =:: "")
:& (SButtonStyle =:: DefaultButton) :& (ButtonStyle =:: DefaultButton)
:& RNil :& RNil
widgetState = WidgetState (boolState <+> toggleState) widgetState = WidgetState (boolState <+> toggleState)
...@@ -66,5 +66,5 @@ instance IHaskellWidget ToggleButton where ...@@ -66,5 +66,5 @@ 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 setField' widget BoolValue value
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/FlexBox.hs
View file @ 6622b260
...@@ -36,10 +36,10 @@ mkFlexBox = do ...@@ -36,10 +36,10 @@ mkFlexBox = do
uuid <- U.random uuid <- U.random
let boxAttrs = defaultBoxWidget "FlexBoxView" let boxAttrs = defaultBoxWidget "FlexBoxView"
flxAttrs = (SOrientation =:: HorizontalOrientation) flxAttrs = (Orientation =:: HorizontalOrientation)
:& (SFlex =:: 0) :& (Flex =:: 0)
:& (SPack =:: StartLocation) :& (Pack =:: StartLocation)
:& (SAlign =:: StartLocation) :& (Align =:: StartLocation)
:& RNil :& RNil
widgetState = WidgetState $ boxAttrs <+> flxAttrs widgetState = WidgetState $ boxAttrs <+> flxAttrs
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/SelectionContainer/Accordion.hs
View file @ 6622b260
...@@ -62,5 +62,5 @@ instance IHaskellWidget Accordion where ...@@ -62,5 +62,5 @@ instance IHaskellWidget Accordion where
key2 = "selected_index" :: Text key2 = "selected_index" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Number num) = HM.lookup key2 dict2 Just (Number num) = HM.lookup key2 dict2
setField' widget SSelectedIndex (Sci.coefficient num) setField' widget SelectedIndex (Sci.coefficient num)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Box/SelectionContainer/Tab.hs
View file @ 6622b260
...@@ -61,5 +61,5 @@ instance IHaskellWidget TabWidget where ...@@ -61,5 +61,5 @@ instance IHaskellWidget TabWidget where
key2 = "selected_index" :: Text key2 = "selected_index" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Number num) = HM.lookup key2 dict2 Just (Number num) = HM.lookup key2 dict2
setField' widget SSelectedIndex (Sci.coefficient num) setField' widget SelectedIndex (Sci.coefficient num)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Button.hs
View file @ 6622b260
...@@ -36,12 +36,12 @@ mkButton = do ...@@ -36,12 +36,12 @@ mkButton = do
uuid <- U.random uuid <- U.random
let dom = defaultDOMWidget "ButtonView" let dom = defaultDOMWidget "ButtonView"
but = (SDescription =:: "") but = (Description =:: "")
:& (STooltip =:: "") :& (Tooltip =:: "")
:& (SDisabled =:: False) :& (Disabled =:: False)
:& (SIcon =:: "") :& (Icon =:: "")
:& (SButtonStyle =:: DefaultButton) :& (ButtonStyle =:: DefaultButton)
:& (SClickHandler =:: return ()) :& (ClickHandler =:: return ())
:& RNil :& RNil
buttonState = WidgetState (dom <+> but) buttonState = WidgetState (dom <+> but)
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Common.hs
View file @ 6622b260
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE DataKinds #-} {-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-} {-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module IHaskell.Display.Widgets.Common where module IHaskell.Display.Widgets.Common where
import Data.Aeson import Data.Aeson
import Data.Aeson.Types (emptyObject) import Data.Aeson.Types (emptyObject)
import Data.Text (pack, Text) import Data.Text (pack, Text)
import Data.Singletons.TH
import IHaskell.Display (IHaskellWidget) import IHaskell.Display (IHaskellWidget)
import IHaskell.Eval.Widgets (widgetSendClose) import IHaskell.Eval.Widgets (widgetSendClose)
import qualified IHaskell.Display.Widgets.Singletons as S
pattern ViewModule = S.SViewModule
pattern ViewName = S.SViewName
pattern MsgThrottle = S.SMsgThrottle
pattern Version = S.SVersion
pattern DisplayHandler = S.SDisplayHandler
pattern Visible = S.SVisible
pattern CSS = S.SCSS
pattern DOMClasses = S.SDOMClasses
pattern Width = S.SWidth
pattern Height = S.SHeight
pattern Padding = S.SPadding
pattern Margin = S.SMargin
pattern Color = S.SColor
pattern BackgroundColor = S.SBackgroundColor
pattern BorderColor = S.SBorderColor
pattern BorderWidth = S.SBorderWidth
pattern BorderRadius = S.SBorderRadius
pattern BorderStyle = S.SBorderStyle
pattern FontStyle = S.SFontStyle
pattern FontWeight = S.SFontWeight
pattern FontSize = S.SFontSize
pattern FontFamily = S.SFontFamily
pattern Description = S.SDescription
pattern ClickHandler = S.SClickHandler
pattern SubmitHandler = S.SSubmitHandler
pattern Disabled = S.SDisabled
pattern StringValue = S.SStringValue
pattern Placeholder = S.SPlaceholder
pattern Tooltip = S.STooltip
pattern Icon = S.SIcon
pattern ButtonStyle = S.SButtonStyle
pattern B64Value = S.SB64Value
pattern ImageFormat = S.SImageFormat
pattern BoolValue = S.SBoolValue
pattern Options = S.SOptions
pattern SelectedLabel = S.SSelectedLabel
pattern SelectedValue = S.SSelectedValue
pattern SelectionHandler = S.SSelectionHandler
pattern Tooltips = S.STooltips
pattern Icons = S.SIcons
pattern SelectedLabels = S.SSelectedLabels
pattern SelectedValues = S.SSelectedValues
pattern IntValue = S.SIntValue
pattern StepInt = S.SStepInt
pattern MaxInt = S.SMaxInt
pattern MinInt = S.SMinInt
pattern IntPairValue = S.SIntPairValue
pattern LowerInt = S.SLowerInt
pattern UpperInt = S.SUpperInt
pattern FloatValue = S.SFloatValue
pattern StepFloat = S.SStepFloat
pattern MaxFloat = S.SMaxFloat
pattern MinFloat = S.SMinFloat
pattern FloatPairValue = S.SFloatPairValue
pattern LowerFloat = S.SLowerFloat
pattern UpperFloat = S.SUpperFloat
pattern Orientation = S.SOrientation
pattern ShowRange = S.SShowRange
pattern ReadOut = S.SReadOut
pattern SliderColor = S.SSliderColor
pattern BarStyle = S.SBarStyle
pattern ChangeHandler = S.SChangeHandler
pattern Children = S.SChildren
pattern OverflowX = S.SOverflowX
pattern OverflowY = S.SOverflowY
pattern BoxStyle = S.SBoxStyle
pattern Flex = S.SFlex
pattern Pack = S.SPack
pattern Align = S.SAlign
pattern Titles = S.STitles
pattern SelectedIndex = S.SSelectedIndex
-- | Close a widget's comm -- | Close a widget's comm
closeWidget :: IHaskellWidget w => w -> IO () closeWidget :: IHaskellWidget w => w -> IO ()
closeWidget w = widgetSendClose w emptyObject closeWidget w = widgetSendClose w emptyObject
-- Widget properties
singletons [d|
data Field = ViewModule
| ViewName
| MsgThrottle
| Version
| DisplayHandler
| Visible
| CSS
| DOMClasses
| Width
| Height
| Padding
| Margin
| Color
| BackgroundColor
| BorderColor
| BorderWidth
| BorderRadius
| BorderStyle
| FontStyle
| FontWeight
| FontSize
| FontFamily
| Description
| ClickHandler
| SubmitHandler
| Disabled
| StringValue
| Placeholder
| Tooltip
| Icon
| ButtonStyle
| B64Value
| ImageFormat
| BoolValue
| Options
| SelectedLabel
| SelectedValue
| SelectionHandler
| Tooltips
| Icons
| SelectedLabels
| SelectedValues
| IntValue
| StepInt
| MaxInt
| MinInt
| IntPairValue
| LowerInt
| UpperInt
| FloatValue
| StepFloat
| MaxFloat
| MinFloat
| FloatPairValue
| LowerFloat
| UpperFloat
| Orientation
| ShowRange
| ReadOut
| SliderColor
| BarStyle
| ChangeHandler
| Children
| OverflowX
| OverflowY
| BoxStyle
| Flex
| Pack
| Align
| Titles
| SelectedIndex
deriving (Eq, Ord, Show)
|]
newtype StrInt = StrInt Integer deriving (Num, Ord, Eq, Enum) newtype StrInt = StrInt Integer deriving (Num, Ord, Eq, Enum)
instance ToJSON StrInt where instance ToJSON StrInt where
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/BoundedFloatText.hs
View file @ 6622b260
...@@ -65,5 +65,5 @@ instance IHaskellWidget BoundedFloatText where ...@@ -65,5 +65,5 @@ instance IHaskellWidget BoundedFloatText where
key2 = "value" :: Text key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2 Just (Number value) = HM.lookup key2 dict2
setField' widget SFloatValue (Sci.toRealFloat value) setField' widget FloatValue (Sci.toRealFloat value)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatProgress.hs
View file @ 6622b260
...@@ -38,7 +38,7 @@ mkFloatProgress = do ...@@ -38,7 +38,7 @@ mkFloatProgress = do
uuid <- U.random uuid <- U.random
let boundedFloatAttrs = defaultBoundedFloatWidget "ProgressView" let boundedFloatAttrs = defaultBoundedFloatWidget "ProgressView"
progressAttrs = (SBarStyle =:: DefaultBar) :& RNil progressAttrs = (BarStyle =:: DefaultBar) :& RNil
widgetState = WidgetState $ boundedFloatAttrs <+> progressAttrs widgetState = WidgetState $ boundedFloatAttrs <+> progressAttrs
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloat/FloatSlider.hs
View file @ 6622b260
...@@ -37,10 +37,10 @@ mkFloatSlider = do ...@@ -37,10 +37,10 @@ mkFloatSlider = do
uuid <- U.random uuid <- U.random
let boundedFloatAttrs = defaultBoundedFloatWidget "FloatSliderView" let boundedFloatAttrs = defaultBoundedFloatWidget "FloatSliderView"
sliderAttrs = (SOrientation =:: HorizontalOrientation) sliderAttrs = (Orientation =:: HorizontalOrientation)
:& (SShowRange =:: False) :& (ShowRange =:: False)
:& (SReadOut =:: True) :& (ReadOut =:: True)
:& (SSliderColor =:: "") :& (SliderColor =:: "")
:& RNil :& RNil
widgetState = WidgetState $ boundedFloatAttrs <+> sliderAttrs widgetState = WidgetState $ boundedFloatAttrs <+> sliderAttrs
...@@ -68,5 +68,5 @@ instance IHaskellWidget FloatSlider where ...@@ -68,5 +68,5 @@ instance IHaskellWidget FloatSlider where
key2 = "value" :: Text key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2 Just (Number value) = HM.lookup key2 dict2
setField' widget SFloatValue (Sci.toRealFloat value) setField' widget FloatValue (Sci.toRealFloat value)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/BoundedFloatRange/FloatRangeSlider.hs
View file @ 6622b260
...@@ -40,10 +40,10 @@ mkFloatRangeSlider = do ...@@ -40,10 +40,10 @@ mkFloatRangeSlider = do
uuid <- U.random uuid <- U.random
let boundedFloatAttrs = defaultBoundedFloatRangeWidget "FloatSliderView" let boundedFloatAttrs = defaultBoundedFloatRangeWidget "FloatSliderView"
sliderAttrs = (SOrientation =:: HorizontalOrientation) sliderAttrs = (Orientation =:: HorizontalOrientation)
:& (SShowRange =:: True) :& (ShowRange =:: True)
:& (SReadOut =:: True) :& (ReadOut =:: True)
:& (SSliderColor =:: "") :& (SliderColor =:: "")
:& RNil :& RNil
widgetState = WidgetState $ boundedFloatAttrs <+> sliderAttrs widgetState = WidgetState $ boundedFloatAttrs <+> sliderAttrs
...@@ -74,5 +74,5 @@ instance IHaskellWidget FloatRangeSlider where ...@@ -74,5 +74,5 @@ 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) setField' widget FloatPairValue (x, y)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Float/FloatText.hs
View file @ 6622b260
...@@ -62,5 +62,5 @@ instance IHaskellWidget FloatText where ...@@ -62,5 +62,5 @@ instance IHaskellWidget FloatText where
key2 = "value" :: Text key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2 Just (Number value) = HM.lookup key2 dict2
setField' widget SFloatValue (Sci.toRealFloat value) setField' widget FloatValue (Sci.toRealFloat value)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Image.hs
View file @ 6622b260
...@@ -37,8 +37,8 @@ mkImageWidget = do ...@@ -37,8 +37,8 @@ mkImageWidget = do
uuid <- U.random uuid <- U.random
let dom = defaultDOMWidget "ImageView" let dom = defaultDOMWidget "ImageView"
img = (SImageFormat =:: PNG) img = (ImageFormat =:: PNG)
:& (SB64Value =:: mempty) :& (B64Value =:: mempty)
:& RNil :& RNil
widgetState = WidgetState (dom <+> img) widgetState = WidgetState (dom <+> img)
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/BoundedIntText.hs
View file @ 6622b260
...@@ -64,5 +64,5 @@ instance IHaskellWidget BoundedIntText where ...@@ -64,5 +64,5 @@ instance IHaskellWidget BoundedIntText where
key2 = "value" :: Text key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2 Just (Number value) = HM.lookup key2 dict2
setField' widget SIntValue (Sci.coefficient value) setField' widget IntValue (Sci.coefficient value)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntProgress.hs
View file @ 6622b260
...@@ -38,7 +38,7 @@ mkIntProgress = do ...@@ -38,7 +38,7 @@ mkIntProgress = do
uuid <- U.random uuid <- U.random
let boundedIntAttrs = defaultBoundedIntWidget "ProgressView" let boundedIntAttrs = defaultBoundedIntWidget "ProgressView"
progressAttrs = (SBarStyle =:: DefaultBar) :& RNil progressAttrs = (BarStyle =:: DefaultBar) :& RNil
widgetState = WidgetState $ boundedIntAttrs <+> progressAttrs widgetState = WidgetState $ boundedIntAttrs <+> progressAttrs
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedInt/IntSlider.hs
View file @ 6622b260
...@@ -37,10 +37,10 @@ mkIntSlider = do ...@@ -37,10 +37,10 @@ mkIntSlider = do
uuid <- U.random uuid <- U.random
let boundedIntAttrs = defaultBoundedIntWidget "IntSliderView" let boundedIntAttrs = defaultBoundedIntWidget "IntSliderView"
sliderAttrs = (SOrientation =:: HorizontalOrientation) sliderAttrs = (Orientation =:: HorizontalOrientation)
:& (SShowRange =:: False) :& (ShowRange =:: False)
:& (SReadOut =:: True) :& (ReadOut =:: True)
:& (SSliderColor =:: "") :& (SliderColor =:: "")
:& RNil :& RNil
widgetState = WidgetState $ boundedIntAttrs <+> sliderAttrs widgetState = WidgetState $ boundedIntAttrs <+> sliderAttrs
...@@ -68,5 +68,5 @@ instance IHaskellWidget IntSlider where ...@@ -68,5 +68,5 @@ instance IHaskellWidget IntSlider where
key2 = "value" :: Text key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2 Just (Number value) = HM.lookup key2 dict2
setField' widget SIntValue (Sci.coefficient value) setField' widget IntValue (Sci.coefficient value)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/BoundedIntRange/IntRangeSlider.hs
View file @ 6622b260
...@@ -38,10 +38,10 @@ mkIntRangeSlider = do ...@@ -38,10 +38,10 @@ mkIntRangeSlider = do
uuid <- U.random uuid <- U.random
let boundedIntAttrs = defaultBoundedIntRangeWidget "IntSliderView" let boundedIntAttrs = defaultBoundedIntRangeWidget "IntSliderView"
sliderAttrs = (SOrientation =:: HorizontalOrientation) sliderAttrs = (Orientation =:: HorizontalOrientation)
:& (SShowRange =:: True) :& (ShowRange =:: True)
:& (SReadOut =:: True) :& (ReadOut =:: True)
:& (SSliderColor =:: "") :& (SliderColor =:: "")
:& RNil :& RNil
widgetState = WidgetState $ boundedIntAttrs <+> sliderAttrs widgetState = WidgetState $ boundedIntAttrs <+> sliderAttrs
...@@ -72,5 +72,5 @@ instance IHaskellWidget IntRangeSlider where ...@@ -72,5 +72,5 @@ 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) setField' widget IntPairValue (x, y)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Int/IntText.hs
View file @ 6622b260
...@@ -61,5 +61,5 @@ instance IHaskellWidget IntText where ...@@ -61,5 +61,5 @@ instance IHaskellWidget IntText where
key2 = "value" :: Text key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Number value) = HM.lookup key2 dict2 Just (Number value) = HM.lookup key2 dict2
setField' widget SIntValue (Sci.coefficient value) setField' widget IntValue (Sci.coefficient value)
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/Dropdown.hs
View file @ 6622b260
...@@ -35,7 +35,7 @@ mkDropdown = do ...@@ -35,7 +35,7 @@ mkDropdown = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
uuid <- U.random uuid <- U.random
let selectionAttrs = defaultSelectionWidget "DropdownView" let selectionAttrs = defaultSelectionWidget "DropdownView"
dropdownAttrs = (SButtonStyle =:: DefaultButton) :& RNil dropdownAttrs = (ButtonStyle =:: DefaultButton) :& RNil
widgetState = WidgetState $ selectionAttrs <+> dropdownAttrs widgetState = WidgetState $ selectionAttrs <+> dropdownAttrs
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
...@@ -62,15 +62,15 @@ instance IHaskellWidget Dropdown where ...@@ -62,15 +62,15 @@ instance IHaskellWidget Dropdown where
key2 = "selected_label" :: Text key2 = "selected_label" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget Options
case opts of case opts of
OptionLabels _ -> void $ do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SelectedLabel label
setField' widget SSelectedValue label setField' widget SelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> void $ do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SelectedLabel label
setField' widget SSelectedValue value setField' widget SelectedValue value
triggerSelection widget triggerSelection widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/RadioButtons.hs
View file @ 6622b260
...@@ -60,15 +60,15 @@ instance IHaskellWidget RadioButtons where ...@@ -60,15 +60,15 @@ instance IHaskellWidget RadioButtons where
key2 = "selected_label" :: Text key2 = "selected_label" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget Options
case opts of case opts of
OptionLabels _ -> void $ do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SelectedLabel label
setField' widget SSelectedValue label setField' widget SelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> void $ do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SelectedLabel label
setField' widget SSelectedValue value setField' widget SelectedValue value
triggerSelection widget triggerSelection widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/Select.hs
View file @ 6622b260
...@@ -59,15 +59,15 @@ instance IHaskellWidget Select where ...@@ -59,15 +59,15 @@ instance IHaskellWidget Select where
key2 = "selected_label" :: Text key2 = "selected_label" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget Options
case opts of case opts of
OptionLabels _ -> void $ do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SelectedLabel label
setField' widget SSelectedValue label setField' widget SelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> void $ do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SelectedLabel label
setField' widget SSelectedValue value setField' widget SelectedValue value
triggerSelection widget triggerSelection widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/SelectMultiple.hs
View file @ 6622b260
...@@ -64,15 +64,15 @@ instance IHaskellWidget SelectMultiple where ...@@ -64,15 +64,15 @@ instance IHaskellWidget SelectMultiple where
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (Array labels) = HM.lookup key2 dict2 Just (Array labels) = HM.lookup key2 dict2
labelList = map (\(String x) -> x) $ V.toList labels labelList = map (\(String x) -> x) $ V.toList labels
opts <- getField widget SOptions opts <- getField widget Options
case opts of case opts of
OptionLabels _ -> void $ do OptionLabels _ -> void $ do
setField' widget SSelectedLabels labelList setField' widget SelectedLabels labelList
setField' widget SSelectedValues labelList setField' widget SelectedValues 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 -> void $ do Just valueList -> void $ do
setField' widget SSelectedLabels labelList setField' widget SelectedLabels labelList
setField' widget SSelectedValues valueList setField' widget SelectedValues valueList
triggerSelection widget triggerSelection widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Selection/ToggleButtons.hs
View file @ 6622b260
...@@ -35,9 +35,9 @@ mkToggleButtons = do ...@@ -35,9 +35,9 @@ mkToggleButtons = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
uuid <- U.random uuid <- U.random
let selectionAttrs = defaultSelectionWidget "ToggleButtonsView" let selectionAttrs = defaultSelectionWidget "ToggleButtonsView"
toggleButtonsAttrs = (STooltips =:: []) toggleButtonsAttrs = (Tooltips =:: [])
:& (SIcons =:: []) :& (Icons =:: [])
:& (SButtonStyle =:: DefaultButton) :& (ButtonStyle =:: DefaultButton)
:& RNil :& RNil
widgetState = WidgetState $ selectionAttrs <+> toggleButtonsAttrs widgetState = WidgetState $ selectionAttrs <+> toggleButtonsAttrs
...@@ -67,15 +67,15 @@ instance IHaskellWidget ToggleButtons where ...@@ -67,15 +67,15 @@ instance IHaskellWidget ToggleButtons where
key2 = "selected_label" :: Text key2 = "selected_label" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (String label) = HM.lookup key2 dict2 Just (String label) = HM.lookup key2 dict2
opts <- getField widget SOptions opts <- getField widget Options
case opts of case opts of
OptionLabels _ -> void $ do OptionLabels _ -> void $ do
setField' widget SSelectedLabel label setField' widget SelectedLabel label
setField' widget SSelectedValue label setField' widget SelectedValue label
OptionDict ps -> OptionDict ps ->
case lookup label ps of case lookup label ps of
Nothing -> return () Nothing -> return ()
Just value -> void $ do Just value -> void $ do
setField' widget SSelectedLabel label setField' widget SelectedLabel label
setField' widget SSelectedValue value setField' widget SelectedValue value
triggerSelection widget triggerSelection widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Singletons.hs 0 → 100644
View file @ 6622b260
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
module IHaskell.Display.Widgets.Singletons where
import Data.Singletons.TH
-- Widget properties
singletons [d|
data Field = ViewModule
| ViewName
| MsgThrottle
| Version
| DisplayHandler
| Visible
| CSS
| DOMClasses
| Width
| Height
| Padding
| Margin
| Color
| BackgroundColor
| BorderColor
| BorderWidth
| BorderRadius
| BorderStyle
| FontStyle
| FontWeight
| FontSize
| FontFamily
| Description
| ClickHandler
| SubmitHandler
| Disabled
| StringValue
| Placeholder
| Tooltip
| Icon
| ButtonStyle
| B64Value
| ImageFormat
| BoolValue
| Options
| SelectedLabel
| SelectedValue
| SelectionHandler
| Tooltips
| Icons
| SelectedLabels
| SelectedValues
| IntValue
| StepInt
| MaxInt
| MinInt
| IntPairValue
| LowerInt
| UpperInt
| FloatValue
| StepFloat
| MaxFloat
| MinFloat
| FloatPairValue
| LowerFloat
| UpperFloat
| Orientation
| ShowRange
| ReadOut
| SliderColor
| BarStyle
| ChangeHandler
| Children
| OverflowX
| OverflowY
| BoxStyle
| Flex
| Pack
| Align
| Titles
| SelectedIndex
deriving (Eq, Ord, Show)
|]
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/Text.hs
View file @ 6622b260
...@@ -35,7 +35,7 @@ mkTextWidget = do ...@@ -35,7 +35,7 @@ mkTextWidget = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
uuid <- U.random uuid <- U.random
let strWidget = defaultStringWidget "TextView" let strWidget = defaultStringWidget "TextView"
txtWidget = (SSubmitHandler =:: return ()) :& (SChangeHandler =:: return ()) :& RNil txtWidget = (SubmitHandler =:: return ()) :& (ChangeHandler =:: return ()) :& RNil
widgetState = WidgetState $ strWidget <+> txtWidget widgetState = WidgetState $ strWidget <+> txtWidget
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
...@@ -61,7 +61,7 @@ instance IHaskellWidget TextWidget where ...@@ -61,7 +61,7 @@ instance IHaskellWidget TextWidget where
case Map.lookup "sync_data" dict1 of case Map.lookup "sync_data" dict1 of
Just (Object dict2) -> Just (Object dict2) ->
case Map.lookup "value" dict2 of case Map.lookup "value" dict2 of
Just (String val) -> setField' tw SStringValue val >> triggerChange tw Just (String val) -> setField' tw StringValue val >> triggerChange tw
Nothing -> return () Nothing -> return ()
Nothing -> Nothing ->
case Map.lookup "content" dict1 of case Map.lookup "content" dict1 of
......
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/String/TextArea.hs
View file @ 6622b260
...@@ -35,7 +35,7 @@ mkTextArea = do ...@@ -35,7 +35,7 @@ mkTextArea = do
-- Default properties, with a random uuid -- Default properties, with a random uuid
uuid <- U.random uuid <- U.random
let strAttrs = defaultStringWidget "TextareaView" let strAttrs = defaultStringWidget "TextareaView"
wgtAttrs = (SChangeHandler =:: return ()) :& RNil wgtAttrs = (ChangeHandler =:: return ()) :& RNil
widgetState = WidgetState $ strAttrs <+> wgtAttrs widgetState = WidgetState $ strAttrs <+> wgtAttrs
stateIO <- newIORef widgetState stateIO <- newIORef widgetState
...@@ -62,5 +62,5 @@ instance IHaskellWidget TextArea where ...@@ -62,5 +62,5 @@ instance IHaskellWidget TextArea where
key2 = "value" :: Text key2 = "value" :: Text
Just (Object dict2) = HM.lookup key1 dict1 Just (Object dict2) = HM.lookup key1 dict1
Just (String value) = HM.lookup key2 dict2 Just (String value) = HM.lookup key2 dict2
setField' widget SStringValue value setField' widget StringValue value
triggerChange widget triggerChange widget
ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets/Types.hs
View file @ 6622b260
...@@ -54,7 +54,7 @@ module IHaskell.Display.Widgets.Types where ...@@ -54,7 +54,7 @@ module IHaskell.Display.Widgets.Types where
-- --
-- Widgets are not able to do console input, the reason for that can also be found in the messaging -- Widgets are not able to do console input, the reason for that can also be found in the messaging
-- specification -- specification
import Control.Monad (unless, join, when, void) import Control.Monad (unless, join, when, void, mapM_)
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import qualified Control.Exception as Ex import qualified Control.Exception as Ex
...@@ -79,105 +79,107 @@ import IHaskell.Eval.Widgets (widgetSendUpdate) ...@@ -79,105 +79,107 @@ import IHaskell.Eval.Widgets (widgetSendUpdate)
import IHaskell.Display (Base64, IHaskellWidget (..)) import IHaskell.Display (Base64, IHaskellWidget (..))
import IHaskell.IPython.Message.UUID import IHaskell.IPython.Message.UUID
import IHaskell.Display.Widgets.Singletons (Field, SField (..))
import qualified IHaskell.Display.Widgets.Singletons as S
import IHaskell.Display.Widgets.Common import IHaskell.Display.Widgets.Common
-- Classes from IPython's widget hierarchy. Defined as such to reduce code duplication. -- Classes from IPython's widget hierarchy. Defined as such to reduce code duplication.
type WidgetClass = '[ViewModule, ViewName, MsgThrottle, Version, DisplayHandler] type WidgetClass = '[ S.ViewModule, S.ViewName, S.MsgThrottle, S.Version, S.DisplayHandler ]
type DOMWidgetClass = WidgetClass :++ type DOMWidgetClass = WidgetClass :++
'[ Visible, CSS, DOMClasses, Width, Height, Padding, Margin, Color '[ S.Visible, S.CSS, S.DOMClasses, S.Width, S.Height, S.Padding, S.Margin, S.Color
, BackgroundColor, BorderColor, BorderWidth, BorderRadius, BorderStyle, FontStyle , S.BackgroundColor, S.BorderColor, S.BorderWidth, S.BorderRadius, S.BorderStyle, S.FontStyle
, FontWeight, FontSize, FontFamily , S.FontWeight, S.FontSize, S.FontFamily
] ]
type StringClass = DOMWidgetClass :++ '[StringValue, Disabled, Description, Placeholder] type StringClass = DOMWidgetClass :++ '[S.StringValue, S.Disabled, S.Description, S.Placeholder]
type BoolClass = DOMWidgetClass :++ '[BoolValue, Disabled, Description, ChangeHandler] type BoolClass = DOMWidgetClass :++ '[S.BoolValue, S.Disabled, S.Description, S.ChangeHandler]
type SelectionClass = DOMWidgetClass :++ type SelectionClass = DOMWidgetClass :++
'[Options, SelectedValue, SelectedLabel, Disabled, Description, SelectionHandler] '[S.Options, S.SelectedValue, S.SelectedLabel, S.Disabled, S.Description, S.SelectionHandler]
type MultipleSelectionClass = DOMWidgetClass :++ type MultipleSelectionClass = DOMWidgetClass :++
'[Options, SelectedLabels, SelectedValues, Disabled, Description, SelectionHandler] '[S.Options, S.SelectedLabels, S.SelectedValues, S.Disabled, S.Description, S.SelectionHandler]
type IntClass = DOMWidgetClass :++ '[IntValue, Disabled, Description, ChangeHandler] type IntClass = DOMWidgetClass :++ '[S.IntValue, S.Disabled, S.Description, S.ChangeHandler]
type BoundedIntClass = IntClass :++ '[StepInt, MinInt, MaxInt] type BoundedIntClass = IntClass :++ '[S.StepInt, S.MinInt, S.MaxInt]
type IntRangeClass = IntClass :++ '[IntPairValue, LowerInt, UpperInt] type IntRangeClass = IntClass :++ '[S.IntPairValue, S.LowerInt, S.UpperInt]
type BoundedIntRangeClass = IntRangeClass :++ '[StepInt, MinInt, MaxInt] type BoundedIntRangeClass = IntRangeClass :++ '[S.StepInt, S.MinInt, S.MaxInt]
type FloatClass = DOMWidgetClass :++ '[FloatValue, Disabled, Description, ChangeHandler] type FloatClass = DOMWidgetClass :++ '[S.FloatValue, S.Disabled, S.Description, S.ChangeHandler]
type BoundedFloatClass = FloatClass :++ '[StepFloat, MinFloat, MaxFloat] type BoundedFloatClass = FloatClass :++ '[S.StepFloat, S.MinFloat, S.MaxFloat]
type FloatRangeClass = FloatClass :++ '[FloatPairValue, LowerFloat, UpperFloat] type FloatRangeClass = FloatClass :++ '[S.FloatPairValue, S.LowerFloat, S.UpperFloat]
type BoundedFloatRangeClass = FloatRangeClass :++ '[StepFloat, MinFloat, MaxFloat] type BoundedFloatRangeClass = FloatRangeClass :++ '[S.StepFloat, S.MinFloat, S.MaxFloat]
type BoxClass = DOMWidgetClass :++ '[Children, OverflowX, OverflowY, BoxStyle] type BoxClass = DOMWidgetClass :++ '[S.Children, S.OverflowX, S.OverflowY, S.BoxStyle]
type SelectionContainerClass = BoxClass :++ '[Titles, SelectedIndex, ChangeHandler] type SelectionContainerClass = BoxClass :++ '[S.Titles, S.SelectedIndex, S.ChangeHandler]
-- Types associated with Fields. -- Types associated with Fields.
type family FieldType (f :: Field) :: * where type family FieldType (f :: Field) :: * where
FieldType ViewModule = Text FieldType S.ViewModule = Text
FieldType ViewName = Text FieldType S.ViewName = Text
FieldType MsgThrottle = Integer FieldType S.MsgThrottle = Integer
FieldType Version = Integer FieldType S.Version = Integer
FieldType DisplayHandler = IO () FieldType S.DisplayHandler = IO ()
FieldType Visible = Bool FieldType S.Visible = Bool
FieldType CSS = [(Text, Text, Text)] FieldType S.CSS = [(Text, Text, Text)]
FieldType DOMClasses = [Text] FieldType S.DOMClasses = [Text]
FieldType Width = StrInt FieldType S.Width = StrInt
FieldType Height = StrInt FieldType S.Height = StrInt
FieldType Padding = StrInt FieldType S.Padding = StrInt
FieldType Margin = StrInt FieldType S.Margin = StrInt
FieldType Color = Text FieldType S.Color = Text
FieldType BackgroundColor = Text FieldType S.BackgroundColor = Text
FieldType BorderColor = Text FieldType S.BorderColor = Text
FieldType BorderWidth = StrInt FieldType S.BorderWidth = StrInt
FieldType BorderRadius = StrInt FieldType S.BorderRadius = StrInt
FieldType BorderStyle = BorderStyleValue FieldType S.BorderStyle = BorderStyleValue
FieldType FontStyle = FontStyleValue FieldType S.FontStyle = FontStyleValue
FieldType FontWeight = FontWeightValue FieldType S.FontWeight = FontWeightValue
FieldType FontSize = StrInt FieldType S.FontSize = StrInt
FieldType FontFamily = Text FieldType S.FontFamily = Text
FieldType Description = Text FieldType S.Description = Text
FieldType ClickHandler = IO () FieldType S.ClickHandler = IO ()
FieldType SubmitHandler = IO () FieldType S.SubmitHandler = IO ()
FieldType Disabled = Bool FieldType S.Disabled = Bool
FieldType StringValue = Text FieldType S.StringValue = Text
FieldType Placeholder = Text FieldType S.Placeholder = Text
FieldType Tooltip = Text FieldType S.Tooltip = Text
FieldType Icon = Text FieldType S.Icon = Text
FieldType ButtonStyle = ButtonStyleValue FieldType S.ButtonStyle = ButtonStyleValue
FieldType B64Value = Base64 FieldType S.B64Value = Base64
FieldType ImageFormat = ImageFormatValue FieldType S.ImageFormat = ImageFormatValue
FieldType BoolValue = Bool FieldType S.BoolValue = Bool
FieldType Options = SelectionOptions FieldType S.Options = SelectionOptions
FieldType SelectedLabel = Text FieldType S.SelectedLabel = Text
FieldType SelectedValue = Text FieldType S.SelectedValue = Text
FieldType SelectionHandler = IO () FieldType S.SelectionHandler = IO ()
FieldType Tooltips = [Text] FieldType S.Tooltips = [Text]
FieldType Icons = [Text] FieldType S.Icons = [Text]
FieldType SelectedLabels = [Text] FieldType S.SelectedLabels = [Text]
FieldType SelectedValues = [Text] FieldType S.SelectedValues = [Text]
FieldType IntValue = Integer FieldType S.IntValue = Integer
FieldType StepInt = Integer FieldType S.StepInt = Integer
FieldType MinInt = Integer FieldType S.MinInt = Integer
FieldType MaxInt = Integer FieldType S.MaxInt = Integer
FieldType LowerInt = Integer FieldType S.LowerInt = Integer
FieldType UpperInt = Integer FieldType S.UpperInt = Integer
FieldType IntPairValue = (Integer, Integer) FieldType S.IntPairValue = (Integer, Integer)
FieldType Orientation = OrientationValue FieldType S.Orientation = OrientationValue
FieldType ShowRange = Bool FieldType S.ShowRange = Bool
FieldType ReadOut = Bool FieldType S.ReadOut = Bool
FieldType SliderColor = Text FieldType S.SliderColor = Text
FieldType BarStyle = BarStyleValue FieldType S.BarStyle = BarStyleValue
FieldType FloatValue = Double FieldType S.FloatValue = Double
FieldType StepFloat = Double FieldType S.StepFloat = Double
FieldType MinFloat = Double FieldType S.MinFloat = Double
FieldType MaxFloat = Double FieldType S.MaxFloat = Double
FieldType LowerFloat = Double FieldType S.LowerFloat = Double
FieldType UpperFloat = Double FieldType S.UpperFloat = Double
FieldType FloatPairValue = (Double, Double) FieldType S.FloatPairValue = (Double, Double)
FieldType ChangeHandler = IO () FieldType S.ChangeHandler = IO ()
FieldType Children = [ChildWidget] FieldType S.Children = [ChildWidget]
FieldType OverflowX = OverflowValue FieldType S.OverflowX = OverflowValue
FieldType OverflowY = OverflowValue FieldType S.OverflowY = OverflowValue
FieldType BoxStyle = BoxStyleValue FieldType S.BoxStyle = BoxStyleValue
FieldType Flex = Int FieldType S.Flex = Int
FieldType Pack = LocationValue FieldType S.Pack = LocationValue
FieldType Align = LocationValue FieldType S.Align = LocationValue
FieldType Titles = [Text] FieldType S.Titles = [Text]
FieldType SelectedIndex = Integer FieldType S.SelectedIndex = Integer
-- | Can be used to put different widgets in a list. Useful for dealing with children widgets. -- | 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) data ChildWidget = forall w. RecAll Attr (WidgetFields w) ToPairs => ChildWidget (IPythonWidget w)
...@@ -236,32 +238,32 @@ data WidgetType = ButtonType ...@@ -236,32 +238,32 @@ data WidgetType = ButtonType
-- Fields associated with a widget -- Fields associated with a widget
type family WidgetFields (w :: WidgetType) :: [Field] where type family WidgetFields (w :: WidgetType) :: [Field] where
WidgetFields ButtonType = DOMWidgetClass :++ '[Description, Tooltip, Disabled, Icon, ButtonStyle, ClickHandler] WidgetFields ButtonType = DOMWidgetClass :++ '[S.Description, S.Tooltip, S.Disabled, S.Icon, S.ButtonStyle, S.ClickHandler]
WidgetFields ImageType = DOMWidgetClass :++ '[ImageFormat, B64Value] WidgetFields ImageType = DOMWidgetClass :++ '[S.ImageFormat, S.B64Value]
WidgetFields OutputType = DOMWidgetClass WidgetFields OutputType = DOMWidgetClass
WidgetFields HTMLType = StringClass WidgetFields HTMLType = StringClass
WidgetFields LatexType = StringClass WidgetFields LatexType = StringClass
WidgetFields TextType = StringClass :++ '[SubmitHandler, ChangeHandler] WidgetFields TextType = StringClass :++ '[S.SubmitHandler, S.ChangeHandler]
WidgetFields TextAreaType = StringClass :++ '[ChangeHandler] WidgetFields TextAreaType = StringClass :++ '[S.ChangeHandler]
WidgetFields CheckBoxType = BoolClass WidgetFields CheckBoxType = BoolClass
WidgetFields ToggleButtonType = BoolClass :++ '[Tooltip, Icon, ButtonStyle] WidgetFields ToggleButtonType = BoolClass :++ '[S.Tooltip, S.Icon, S.ButtonStyle]
WidgetFields DropdownType = SelectionClass :++ '[ButtonStyle] WidgetFields DropdownType = SelectionClass :++ '[S.ButtonStyle]
WidgetFields RadioButtonsType = SelectionClass WidgetFields RadioButtonsType = SelectionClass
WidgetFields SelectType = SelectionClass WidgetFields SelectType = SelectionClass
WidgetFields ToggleButtonsType = SelectionClass :++ '[Tooltips, Icons, ButtonStyle] WidgetFields ToggleButtonsType = SelectionClass :++ '[S.Tooltips, S.Icons, S.ButtonStyle]
WidgetFields SelectMultipleType = MultipleSelectionClass WidgetFields SelectMultipleType = MultipleSelectionClass
WidgetFields IntTextType = IntClass WidgetFields IntTextType = IntClass
WidgetFields BoundedIntTextType = BoundedIntClass WidgetFields BoundedIntTextType = BoundedIntClass
WidgetFields IntSliderType = BoundedIntClass :++ '[Orientation, ShowRange, ReadOut, SliderColor] WidgetFields IntSliderType = BoundedIntClass :++ '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]
WidgetFields IntProgressType = BoundedIntClass :++ '[BarStyle] WidgetFields IntProgressType = BoundedIntClass :++ '[S.BarStyle]
WidgetFields IntRangeSliderType = BoundedIntRangeClass :++ '[Orientation, ShowRange, ReadOut, SliderColor] WidgetFields IntRangeSliderType = BoundedIntRangeClass :++ '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]
WidgetFields FloatTextType = FloatClass WidgetFields FloatTextType = FloatClass
WidgetFields BoundedFloatTextType = BoundedFloatClass WidgetFields BoundedFloatTextType = BoundedFloatClass
WidgetFields FloatSliderType = BoundedFloatClass :++ '[Orientation, ShowRange, ReadOut, SliderColor] WidgetFields FloatSliderType = BoundedFloatClass :++ '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]
WidgetFields FloatProgressType = BoundedFloatClass :++ '[BarStyle] WidgetFields FloatProgressType = BoundedFloatClass :++ '[S.BarStyle]
WidgetFields FloatRangeSliderType = BoundedFloatRangeClass :++ '[Orientation, ShowRange, ReadOut, SliderColor] WidgetFields FloatRangeSliderType = BoundedFloatRangeClass :++ '[S.Orientation, S.ShowRange, S.ReadOut, S.SliderColor]
WidgetFields BoxType = BoxClass WidgetFields BoxType = BoxClass
WidgetFields FlexBoxType = BoxClass :++ '[Orientation, Flex, Pack, Align] WidgetFields FlexBoxType = BoxClass :++ '[S.Orientation, S.Flex, S.Pack, S.Align]
WidgetFields AccordionType = SelectionContainerClass WidgetFields AccordionType = SelectionContainerClass
WidgetFields TabType = SelectionContainerClass WidgetFields TabType = SelectionContainerClass
...@@ -289,82 +291,82 @@ class ToPairs a where ...@@ -289,82 +291,82 @@ class ToPairs a where
toPairs :: a -> [Pair] toPairs :: a -> [Pair]
-- Attributes that aren't synced with the frontend give [] on toPairs -- Attributes that aren't synced with the frontend give [] on toPairs
instance ToPairs (Attr ViewModule) where toPairs x = ["_view_module" .= toJSON x] instance ToPairs (Attr S.ViewModule) where toPairs x = ["_view_module" .= toJSON x]
instance ToPairs (Attr ViewName) where toPairs x = ["_view_name" .= toJSON x] instance ToPairs (Attr S.ViewName) where toPairs x = ["_view_name" .= toJSON x]
instance ToPairs (Attr MsgThrottle) where toPairs x = ["msg_throttle" .= toJSON x] instance ToPairs (Attr S.MsgThrottle) where toPairs x = ["msg_throttle" .= toJSON x]
instance ToPairs (Attr Version) where toPairs x = ["version" .= toJSON x] instance ToPairs (Attr S.Version) where toPairs x = ["version" .= toJSON x]
instance ToPairs (Attr DisplayHandler) where toPairs _ = [] -- Not sent to the frontend instance ToPairs (Attr S.DisplayHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr Visible) where toPairs x = ["visible" .= toJSON x] instance ToPairs (Attr S.Visible) where toPairs x = ["visible" .= toJSON x]
instance ToPairs (Attr CSS) where toPairs x = ["_css" .= toJSON x] instance ToPairs (Attr S.CSS) where toPairs x = ["_css" .= toJSON x]
instance ToPairs (Attr DOMClasses) where toPairs x = ["_dom_classes" .= toJSON x] instance ToPairs (Attr S.DOMClasses) where toPairs x = ["_dom_classes" .= toJSON x]
instance ToPairs (Attr Width) where toPairs x = ["width" .= toJSON x] instance ToPairs (Attr S.Width) where toPairs x = ["width" .= toJSON x]
instance ToPairs (Attr Height) where toPairs x = ["height" .= toJSON x] instance ToPairs (Attr S.Height) where toPairs x = ["height" .= toJSON x]
instance ToPairs (Attr Padding) where toPairs x = ["padding" .= toJSON x] instance ToPairs (Attr S.Padding) where toPairs x = ["padding" .= toJSON x]
instance ToPairs (Attr Margin) where toPairs x = ["margin" .= toJSON x] instance ToPairs (Attr S.Margin) where toPairs x = ["margin" .= toJSON x]
instance ToPairs (Attr Color) where toPairs x = ["color" .= toJSON x] instance ToPairs (Attr S.Color) where toPairs x = ["color" .= toJSON x]
instance ToPairs (Attr BackgroundColor) where toPairs x = ["background_color" .= toJSON x] instance ToPairs (Attr S.BackgroundColor) where toPairs x = ["background_color" .= toJSON x]
instance ToPairs (Attr BorderColor) where toPairs x = ["border_color" .= toJSON x] instance ToPairs (Attr S.BorderColor) where toPairs x = ["border_color" .= toJSON x]
instance ToPairs (Attr BorderWidth) where toPairs x = ["border_width" .= toJSON x] instance ToPairs (Attr S.BorderWidth) where toPairs x = ["border_width" .= toJSON x]
instance ToPairs (Attr BorderRadius) where toPairs x = ["border_radius" .= toJSON x] instance ToPairs (Attr S.BorderRadius) where toPairs x = ["border_radius" .= toJSON x]
instance ToPairs (Attr BorderStyle) where toPairs x = ["border_style" .= toJSON x] instance ToPairs (Attr S.BorderStyle) where toPairs x = ["border_style" .= toJSON x]
instance ToPairs (Attr FontStyle) where toPairs x = ["font_style" .= toJSON x] instance ToPairs (Attr S.FontStyle) where toPairs x = ["font_style" .= toJSON x]
instance ToPairs (Attr FontWeight) where toPairs x = ["font_weight" .= toJSON x] instance ToPairs (Attr S.FontWeight) where toPairs x = ["font_weight" .= toJSON x]
instance ToPairs (Attr FontSize) where toPairs x = ["font_size" .= toJSON x] instance ToPairs (Attr S.FontSize) where toPairs x = ["font_size" .= toJSON x]
instance ToPairs (Attr FontFamily) where toPairs x = ["font_family" .= toJSON x] instance ToPairs (Attr S.FontFamily) where toPairs x = ["font_family" .= toJSON x]
instance ToPairs (Attr Description) where toPairs x = ["description" .= toJSON x] instance ToPairs (Attr S.Description) where toPairs x = ["description" .= toJSON x]
instance ToPairs (Attr ClickHandler) where toPairs _ = [] -- Not sent to the frontend instance ToPairs (Attr S.ClickHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr SubmitHandler) where toPairs _ = [] -- Not sent to the frontend instance ToPairs (Attr S.SubmitHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr Disabled) where toPairs x = ["disabled" .= toJSON x] instance ToPairs (Attr S.Disabled) where toPairs x = ["disabled" .= toJSON x]
instance ToPairs (Attr StringValue) where toPairs x = ["value" .= toJSON x] instance ToPairs (Attr S.StringValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr Placeholder) where toPairs x = ["placeholder" .= toJSON x] instance ToPairs (Attr S.Placeholder) where toPairs x = ["placeholder" .= toJSON x]
instance ToPairs (Attr Tooltip) where toPairs x = ["tooltip" .= toJSON x] instance ToPairs (Attr S.Tooltip) where toPairs x = ["tooltip" .= toJSON x]
instance ToPairs (Attr Icon) where toPairs x = ["icon" .= toJSON x] instance ToPairs (Attr S.Icon) where toPairs x = ["icon" .= toJSON x]
instance ToPairs (Attr ButtonStyle) where toPairs x = ["button_style" .= toJSON x] instance ToPairs (Attr S.ButtonStyle) where toPairs x = ["button_style" .= toJSON x]
instance ToPairs (Attr B64Value) where toPairs x = ["_b64value" .= toJSON x] instance ToPairs (Attr S.B64Value) where toPairs x = ["_b64value" .= toJSON x]
instance ToPairs (Attr ImageFormat) where toPairs x = ["format" .= toJSON x] instance ToPairs (Attr S.ImageFormat) where toPairs x = ["format" .= toJSON x]
instance ToPairs (Attr BoolValue) where toPairs x = ["value" .= toJSON x] instance ToPairs (Attr S.BoolValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr SelectedLabel) where toPairs x = ["selected_label" .= toJSON x] instance ToPairs (Attr S.SelectedLabel) where toPairs x = ["selected_label" .= toJSON x]
instance ToPairs (Attr SelectedValue) where toPairs x = ["value" .= toJSON x] instance ToPairs (Attr S.SelectedValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr Options) where instance ToPairs (Attr S.Options) where
toPairs x = case _value x of toPairs x = case _value x of
Dummy _ -> labels ("" :: Text) Dummy _ -> labels ("" :: Text)
Real (OptionLabels xs) -> labels xs Real (OptionLabels xs) -> labels xs
Real (OptionDict xps) -> labels $ map fst xps Real (OptionDict xps) -> labels $ map fst xps
where labels xs = ["_options_labels" .= xs] where labels xs = ["_options_labels" .= xs]
instance ToPairs (Attr SelectionHandler) where toPairs _ = [] -- Not sent to the frontend instance ToPairs (Attr S.SelectionHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr Tooltips) where toPairs x = ["tooltips" .= toJSON x] instance ToPairs (Attr S.Tooltips) where toPairs x = ["tooltips" .= toJSON x]
instance ToPairs (Attr Icons) where toPairs x = ["icons" .= toJSON x] instance ToPairs (Attr S.Icons) where toPairs x = ["icons" .= toJSON x]
instance ToPairs (Attr SelectedLabels) where toPairs x = ["selected_labels" .= toJSON x] instance ToPairs (Attr S.SelectedLabels) where toPairs x = ["selected_labels" .= toJSON x]
instance ToPairs (Attr SelectedValues) where toPairs x = ["values" .= toJSON x] instance ToPairs (Attr S.SelectedValues) where toPairs x = ["values" .= toJSON x]
instance ToPairs (Attr IntValue) where toPairs x = ["value" .= toJSON x] instance ToPairs (Attr S.IntValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr StepInt) where toPairs x = ["step" .= toJSON x] instance ToPairs (Attr S.StepInt) where toPairs x = ["step" .= toJSON x]
instance ToPairs (Attr MinInt) where toPairs x = ["min" .= toJSON x] instance ToPairs (Attr S.MinInt) where toPairs x = ["min" .= toJSON x]
instance ToPairs (Attr MaxInt) where toPairs x = ["max" .= toJSON x] instance ToPairs (Attr S.MaxInt) where toPairs x = ["max" .= toJSON x]
instance ToPairs (Attr IntPairValue) where toPairs x = ["value" .= toJSON x] instance ToPairs (Attr S.IntPairValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr LowerInt) where toPairs x = ["min" .= toJSON x] instance ToPairs (Attr S.LowerInt) where toPairs x = ["min" .= toJSON x]
instance ToPairs (Attr UpperInt) where toPairs x = ["max" .= toJSON x] instance ToPairs (Attr S.UpperInt) where toPairs x = ["max" .= toJSON x]
instance ToPairs (Attr FloatValue) where toPairs x = ["value" .= toJSON x] instance ToPairs (Attr S.FloatValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr StepFloat) where toPairs x = ["step" .= toJSON x] instance ToPairs (Attr S.StepFloat) where toPairs x = ["step" .= toJSON x]
instance ToPairs (Attr MinFloat) where toPairs x = ["min" .= toJSON x] instance ToPairs (Attr S.MinFloat) where toPairs x = ["min" .= toJSON x]
instance ToPairs (Attr MaxFloat) where toPairs x = ["max" .= toJSON x] instance ToPairs (Attr S.MaxFloat) where toPairs x = ["max" .= toJSON x]
instance ToPairs (Attr FloatPairValue) where toPairs x = ["value" .= toJSON x] instance ToPairs (Attr S.FloatPairValue) where toPairs x = ["value" .= toJSON x]
instance ToPairs (Attr LowerFloat) where toPairs x = ["min" .= toJSON x] instance ToPairs (Attr S.LowerFloat) where toPairs x = ["min" .= toJSON x]
instance ToPairs (Attr UpperFloat) where toPairs x = ["max" .= toJSON x] instance ToPairs (Attr S.UpperFloat) where toPairs x = ["max" .= toJSON x]
instance ToPairs (Attr Orientation) where toPairs x = ["orientation" .= toJSON x] instance ToPairs (Attr S.Orientation) where toPairs x = ["orientation" .= toJSON x]
instance ToPairs (Attr ShowRange) where toPairs x = ["_range" .= toJSON x] instance ToPairs (Attr S.ShowRange) where toPairs x = ["_range" .= toJSON x]
instance ToPairs (Attr ReadOut) where toPairs x = ["readout" .= toJSON x] instance ToPairs (Attr S.ReadOut) where toPairs x = ["readout" .= toJSON x]
instance ToPairs (Attr SliderColor) where toPairs x = ["slider_color" .= toJSON x] instance ToPairs (Attr S.SliderColor) where toPairs x = ["slider_color" .= toJSON x]
instance ToPairs (Attr BarStyle) where toPairs x = ["bar_style" .= toJSON x] instance ToPairs (Attr S.BarStyle) where toPairs x = ["bar_style" .= toJSON x]
instance ToPairs (Attr ChangeHandler) where toPairs _ = [] -- Not sent to the frontend instance ToPairs (Attr S.ChangeHandler) where toPairs _ = [] -- Not sent to the frontend
instance ToPairs (Attr Children) where toPairs x = ["children" .= toJSON x] instance ToPairs (Attr S.Children) where toPairs x = ["children" .= toJSON x]
instance ToPairs (Attr OverflowX) where toPairs x = ["overflow_x" .= toJSON x] instance ToPairs (Attr S.OverflowX) where toPairs x = ["overflow_x" .= toJSON x]
instance ToPairs (Attr OverflowY) where toPairs x = ["overflow_y" .= toJSON x] instance ToPairs (Attr S.OverflowY) where toPairs x = ["overflow_y" .= toJSON x]
instance ToPairs (Attr BoxStyle) where toPairs x = ["box_style" .= toJSON x] instance ToPairs (Attr S.BoxStyle) where toPairs x = ["box_style" .= toJSON x]
instance ToPairs (Attr Flex) where toPairs x = ["flex" .= toJSON x] instance ToPairs (Attr S.Flex) where toPairs x = ["flex" .= toJSON x]
instance ToPairs (Attr Pack) where toPairs x = ["pack" .= toJSON x] instance ToPairs (Attr S.Pack) where toPairs x = ["pack" .= toJSON x]
instance ToPairs (Attr Align) where toPairs x = ["align" .= toJSON x] instance ToPairs (Attr S.Align) where toPairs x = ["align" .= toJSON x]
instance ToPairs (Attr Titles) where toPairs x = ["_titles" .= toJSON x] instance ToPairs (Attr S.Titles) where toPairs x = ["_titles" .= toJSON x]
instance ToPairs (Attr SelectedIndex) where toPairs x = ["selected_index" .= toJSON x] instance ToPairs (Attr S.SelectedIndex) where toPairs x = ["selected_index" .= toJSON x]
-- | Store the value for a field, as an object parametrized by the Field. No verification is done -- | Store the value for a field, as an object parametrized by the Field. No verification is done
-- for these values. -- for these values.
...@@ -396,157 +398,157 @@ reflect :: forall (f :: Field). (SingI f, SingKind ('KProxy :: KProxy Field)) => ...@@ -396,157 +398,157 @@ reflect :: forall (f :: Field). (SingI f, SingKind ('KProxy :: KProxy Field)) =>
reflect = fromSing reflect = fromSing
-- | A record representing an object of the Widget class from IPython -- | A record representing an object of the Widget class from IPython
defaultWidget :: FieldType ViewName -> Rec Attr WidgetClass defaultWidget :: FieldType S.ViewName -> Rec Attr WidgetClass
defaultWidget viewName = (SViewModule =:: "") defaultWidget viewName = (ViewModule =:: "")
:& (SViewName =:: viewName) :& (ViewName =:: viewName)
:& (SMsgThrottle =:+ 3) :& (MsgThrottle =:+ 3)
:& (SVersion =:: 0) :& (Version =:: 0)
:& (SDisplayHandler =:: return ()) :& (DisplayHandler =:: return ())
:& RNil :& RNil
-- | A record representing an object of the DOMWidget class from IPython -- | A record representing an object of the DOMWidget class from IPython
defaultDOMWidget :: FieldType ViewName -> Rec Attr DOMWidgetClass defaultDOMWidget :: FieldType S.ViewName -> Rec Attr DOMWidgetClass
defaultDOMWidget viewName = defaultWidget viewName <+> domAttrs defaultDOMWidget viewName = defaultWidget viewName <+> domAttrs
where domAttrs = (SVisible =:: True) where domAttrs = (Visible =:: True)
:& (SCSS =:: []) :& (CSS =:: [])
:& (SDOMClasses =:: []) :& (DOMClasses =:: [])
:& (SWidth =:+ 0) :& (Width =:+ 0)
:& (SHeight =:+ 0) :& (Height =:+ 0)
:& (SPadding =:+ 0) :& (Padding =:+ 0)
:& (SMargin =:+ 0) :& (Margin =:+ 0)
:& (SColor =:: "") :& (Color =:: "")
:& (SBackgroundColor =:: "") :& (BackgroundColor =:: "")
:& (SBorderColor =:: "") :& (BorderColor =:: "")
:& (SBorderWidth =:+ 0) :& (BorderWidth =:+ 0)
:& (SBorderRadius =:+ 0) :& (BorderRadius =:+ 0)
:& (SBorderStyle =:: DefaultBorder) :& (BorderStyle =:: DefaultBorder)
:& (SFontStyle =:: DefaultFont) :& (FontStyle =:: DefaultFont)
:& (SFontWeight =:: DefaultWeight) :& (FontWeight =:: DefaultWeight)
:& (SFontSize =:+ 0) :& (FontSize =:+ 0)
:& (SFontFamily =:: "") :& (FontFamily =:: "")
:& RNil :& RNil
-- | A record representing a widget of the _String class from IPython -- | A record representing a widget of the _String class from IPython
defaultStringWidget :: FieldType ViewName -> Rec Attr StringClass defaultStringWidget :: FieldType S.ViewName -> Rec Attr StringClass
defaultStringWidget viewName = defaultDOMWidget viewName <+> strAttrs defaultStringWidget viewName = defaultDOMWidget viewName <+> strAttrs
where strAttrs = (SStringValue =:: "") where strAttrs = (StringValue =:: "")
:& (SDisabled =:: False) :& (Disabled =:: False)
:& (SDescription =:: "") :& (Description =:: "")
:& (SPlaceholder =:: "") :& (Placeholder =:: "")
:& RNil :& RNil
-- | A record representing a widget of the _Bool class from IPython -- | A record representing a widget of the _Bool class from IPython
defaultBoolWidget :: FieldType ViewName -> Rec Attr BoolClass defaultBoolWidget :: FieldType S.ViewName -> Rec Attr BoolClass
defaultBoolWidget viewName = defaultDOMWidget viewName <+> boolAttrs defaultBoolWidget viewName = defaultDOMWidget viewName <+> boolAttrs
where boolAttrs = (SBoolValue =:: False) where boolAttrs = (BoolValue =:: False)
:& (SDisabled =:: False) :& (Disabled =:: False)
:& (SDescription =:: "") :& (Description =:: "")
:& (SChangeHandler =:: return ()) :& (ChangeHandler =:: return ())
:& RNil :& RNil
-- | A record representing a widget of the _Selection class from IPython -- | A record representing a widget of the _Selection class from IPython
defaultSelectionWidget :: FieldType ViewName -> Rec Attr SelectionClass defaultSelectionWidget :: FieldType S.ViewName -> Rec Attr SelectionClass
defaultSelectionWidget viewName = defaultDOMWidget viewName <+> selectionAttrs defaultSelectionWidget viewName = defaultDOMWidget viewName <+> selectionAttrs
where selectionAttrs = (SOptions =:: OptionLabels []) where selectionAttrs = (Options =:: OptionLabels [])
:& (SSelectedValue =:: "") :& (SelectedValue =:: "")
:& (SSelectedLabel =:: "") :& (SelectedLabel =:: "")
:& (SDisabled =:: False) :& (Disabled =:: False)
:& (SDescription =:: "") :& (Description =:: "")
:& (SSelectionHandler =:: return ()) :& (SelectionHandler =:: return ())
:& RNil :& RNil
-- | A record representing a widget of the _MultipleSelection class from IPython -- | A record representing a widget of the _MultipleSelection class from IPython
defaultMultipleSelectionWidget :: FieldType ViewName -> Rec Attr MultipleSelectionClass defaultMultipleSelectionWidget :: FieldType S.ViewName -> Rec Attr MultipleSelectionClass
defaultMultipleSelectionWidget viewName = defaultDOMWidget viewName <+> mulSelAttrs defaultMultipleSelectionWidget viewName = defaultDOMWidget viewName <+> mulSelAttrs
where mulSelAttrs = (SOptions =:: OptionLabels []) where mulSelAttrs = (Options =:: OptionLabels [])
:& (SSelectedLabels =:: []) :& (SelectedLabels =:: [])
:& (SSelectedValues =:: []) :& (SelectedValues =:: [])
:& (SDisabled =:: False) :& (Disabled =:: False)
:& (SDescription =:: "") :& (Description =:: "")
:& (SSelectionHandler =:: return ()) :& (SelectionHandler =:: return ())
:& RNil :& RNil
-- | A record representing a widget of the _Int class from IPython -- | A record representing a widget of the _Int class from IPython
defaultIntWidget :: FieldType ViewName -> Rec Attr IntClass defaultIntWidget :: FieldType S.ViewName -> Rec Attr IntClass
defaultIntWidget viewName = defaultDOMWidget viewName <+> intAttrs defaultIntWidget viewName = defaultDOMWidget viewName <+> intAttrs
where intAttrs = (SIntValue =:: 0) where intAttrs = (IntValue =:: 0)
:& (SDisabled =:: False) :& (Disabled =:: False)
:& (SDescription =:: "") :& (Description =:: "")
:& (SChangeHandler =:: return ()) :& (ChangeHandler =:: return ())
:& RNil :& RNil
-- | A record representing a widget of the _BoundedInt class from IPython -- | A record representing a widget of the _BoundedInt class from IPython
defaultBoundedIntWidget :: FieldType ViewName -> Rec Attr BoundedIntClass defaultBoundedIntWidget :: FieldType S.ViewName -> Rec Attr BoundedIntClass
defaultBoundedIntWidget viewName = defaultIntWidget viewName <+> boundedIntAttrs defaultBoundedIntWidget viewName = defaultIntWidget viewName <+> boundedIntAttrs
where boundedIntAttrs = (SStepInt =:: 1) where boundedIntAttrs = (StepInt =:: 1)
:& (SMinInt =:: 0) :& (MinInt =:: 0)
:& (SMaxInt =:: 100) :& (MaxInt =:: 100)
:& RNil :& RNil
-- | A record representing a widget of the _BoundedInt class from IPython -- | A record representing a widget of the _BoundedInt class from IPython
defaultIntRangeWidget :: FieldType ViewName -> Rec Attr IntRangeClass defaultIntRangeWidget :: FieldType S.ViewName -> Rec Attr IntRangeClass
defaultIntRangeWidget viewName = defaultIntWidget viewName <+> rangeAttrs defaultIntRangeWidget viewName = defaultIntWidget viewName <+> rangeAttrs
where rangeAttrs = (SIntPairValue =:: (25, 75)) where rangeAttrs = (IntPairValue =:: (25, 75))
:& (SLowerInt =:: 0) :& (LowerInt =:: 0)
:& (SUpperInt =:: 100) :& (UpperInt =:: 100)
:& RNil :& RNil
-- | A record representing a widget of the _BoundedIntRange class from IPython -- | A record representing a widget of the _BoundedIntRange class from IPython
defaultBoundedIntRangeWidget :: FieldType ViewName -> Rec Attr BoundedIntRangeClass defaultBoundedIntRangeWidget :: FieldType S.ViewName -> Rec Attr BoundedIntRangeClass
defaultBoundedIntRangeWidget viewName = defaultIntRangeWidget viewName <+> boundedIntRangeAttrs defaultBoundedIntRangeWidget viewName = defaultIntRangeWidget viewName <+> boundedIntRangeAttrs
where boundedIntRangeAttrs = (SStepInt =:+ 1) where boundedIntRangeAttrs = (StepInt =:+ 1)
:& (SMinInt =:: 0) :& (MinInt =:: 0)
:& (SMaxInt =:: 100) :& (MaxInt =:: 100)
:& RNil :& RNil
-- | A record representing a widget of the _Float class from IPython -- | A record representing a widget of the _Float class from IPython
defaultFloatWidget :: FieldType ViewName -> Rec Attr FloatClass defaultFloatWidget :: FieldType S.ViewName -> Rec Attr FloatClass
defaultFloatWidget viewName = defaultDOMWidget viewName <+> intAttrs defaultFloatWidget viewName = defaultDOMWidget viewName <+> intAttrs
where intAttrs = (SFloatValue =:: 0) where intAttrs = (FloatValue =:: 0)
:& (SDisabled =:: False) :& (Disabled =:: False)
:& (SDescription =:: "") :& (Description =:: "")
:& (SChangeHandler =:: return ()) :& (ChangeHandler =:: return ())
:& RNil :& RNil
-- | A record representing a widget of the _BoundedFloat class from IPython -- | A record representing a widget of the _BoundedFloat class from IPython
defaultBoundedFloatWidget :: FieldType ViewName -> Rec Attr BoundedFloatClass defaultBoundedFloatWidget :: FieldType S.ViewName -> Rec Attr BoundedFloatClass
defaultBoundedFloatWidget viewName = defaultFloatWidget viewName <+> boundedFloatAttrs defaultBoundedFloatWidget viewName = defaultFloatWidget viewName <+> boundedFloatAttrs
where boundedFloatAttrs = (SStepFloat =:+ 1) where boundedFloatAttrs = (StepFloat =:+ 1)
:& (SMinFloat =:: 0) :& (MinFloat =:: 0)
:& (SMaxFloat =:: 100) :& (MaxFloat =:: 100)
:& RNil :& RNil
-- | A record representing a widget of the _BoundedFloat class from IPython -- | A record representing a widget of the _BoundedFloat class from IPython
defaultFloatRangeWidget :: FieldType ViewName -> Rec Attr FloatRangeClass defaultFloatRangeWidget :: FieldType S.ViewName -> Rec Attr FloatRangeClass
defaultFloatRangeWidget viewName = defaultFloatWidget viewName <+> rangeAttrs defaultFloatRangeWidget viewName = defaultFloatWidget viewName <+> rangeAttrs
where rangeAttrs = (SFloatPairValue =:: (25, 75)) where rangeAttrs = (FloatPairValue =:: (25, 75))
:& (SLowerFloat =:: 0) :& (LowerFloat =:: 0)
:& (SUpperFloat =:: 100) :& (UpperFloat =:: 100)
:& RNil :& RNil
-- | A record representing a widget of the _BoundedFloatRange class from IPython -- | A record representing a widget of the _BoundedFloatRange class from IPython
defaultBoundedFloatRangeWidget :: FieldType ViewName -> Rec Attr BoundedFloatRangeClass defaultBoundedFloatRangeWidget :: FieldType S.ViewName -> Rec Attr BoundedFloatRangeClass
defaultBoundedFloatRangeWidget viewName = defaultFloatRangeWidget viewName <+> boundedFloatRangeAttrs defaultBoundedFloatRangeWidget viewName = defaultFloatRangeWidget viewName <+> boundedFloatRangeAttrs
where boundedFloatRangeAttrs = (SStepFloat =:+ 1) where boundedFloatRangeAttrs = (StepFloat =:+ 1)
:& (SMinFloat =:: 0) :& (MinFloat =:: 0)
:& (SMaxFloat =:: 100) :& (MaxFloat =:: 100)
:& RNil :& RNil
-- | A record representing a widget of the _Box class from IPython -- | A record representing a widget of the _Box class from IPython
defaultBoxWidget :: FieldType ViewName -> Rec Attr BoxClass defaultBoxWidget :: FieldType S.ViewName -> Rec Attr BoxClass
defaultBoxWidget viewName = defaultDOMWidget viewName <+> boxAttrs defaultBoxWidget viewName = defaultDOMWidget viewName <+> boxAttrs
where boxAttrs = (SChildren =:: []) where boxAttrs = (Children =:: [])
:& (SOverflowX =:: DefaultOverflow) :& (OverflowX =:: DefaultOverflow)
:& (SOverflowY =:: DefaultOverflow) :& (OverflowY =:: DefaultOverflow)
:& (SBoxStyle =:: DefaultBox) :& (BoxStyle =:: DefaultBox)
:& RNil :& RNil
-- | A record representing a widget of the _SelectionContainer class from IPython -- | A record representing a widget of the _SelectionContainer class from IPython
defaultSelectionContainerWidget :: FieldType ViewName -> Rec Attr SelectionContainerClass defaultSelectionContainerWidget :: FieldType S.ViewName -> Rec Attr SelectionContainerClass
defaultSelectionContainerWidget viewName = defaultBoxWidget viewName <+> selAttrs defaultSelectionContainerWidget viewName = defaultBoxWidget viewName <+> selAttrs
where selAttrs = (STitles =:: []) where selAttrs = (Titles =:: [])
:& (SSelectedIndex =:: 0) :& (SelectedIndex =:: 0)
:& (SChangeHandler =:: return ()) :& (ChangeHandler =:: return ())
:& RNil :& RNil
newtype WidgetState w = WidgetState { _getState :: Rec Attr (WidgetFields w) } newtype WidgetState w = WidgetState { _getState :: Rec Attr (WidgetFields w) }
...@@ -592,12 +594,12 @@ getField widget sfield = unwrap . _value <$> getAttr widget sfield ...@@ -592,12 +594,12 @@ getField widget sfield = unwrap . _value <$> getAttr widget sfield
str :: String -> String str :: String -> String
str = id str = id
properties :: IPythonWidget w -> IO [Field] properties :: IPythonWidget w -> IO ()
properties widget = do properties widget = do
st <- readIORef $ state widget st <- readIORef $ state widget
let convert :: Attr f -> Const Field f let convert :: Attr f -> Const Field f
convert attr = Const { getConst = _field attr } convert attr = Const { getConst = _field attr }
return $ recordToList . rmap convert . _getState $ st mapM_ print $ recordToList . rmap convert . _getState $ st
-- Helper function for widget to enforce their inability to fetch console input -- Helper function for widget to enforce their inability to fetch console input
noStdin :: IO a -> IO () noStdin :: IO a -> IO ()
...@@ -617,17 +619,17 @@ noStdin action = ...@@ -617,17 +619,17 @@ noStdin action =
triggerEvent :: (FieldType f ~ IO (), f ∈ WidgetFields w) => SField f -> IPythonWidget w -> IO () triggerEvent :: (FieldType f ~ IO (), f ∈ WidgetFields w) => SField f -> IPythonWidget w -> IO ()
triggerEvent sfield w = noStdin . join $ getField w sfield triggerEvent sfield w = noStdin . join $ getField w sfield
triggerChange :: (ChangeHandler ∈ WidgetFields w) => IPythonWidget w -> IO () triggerChange :: (S.ChangeHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerChange = triggerEvent SChangeHandler triggerChange = triggerEvent ChangeHandler
triggerClick :: (ClickHandler ∈ WidgetFields w) => IPythonWidget w -> IO () triggerClick :: (S.ClickHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerClick = triggerEvent SClickHandler triggerClick = triggerEvent ClickHandler
triggerSelection :: (SelectionHandler ∈ WidgetFields w) => IPythonWidget w -> IO () triggerSelection :: (S.SelectionHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerSelection = triggerEvent SSelectionHandler triggerSelection = triggerEvent SelectionHandler
triggerSubmit :: (SubmitHandler ∈ WidgetFields w) => IPythonWidget w -> IO () triggerSubmit :: (S.SubmitHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerSubmit = triggerEvent SSubmitHandler triggerSubmit = triggerEvent SubmitHandler
triggerDisplay :: (DisplayHandler ∈ WidgetFields w) => IPythonWidget w -> IO () triggerDisplay :: (S.DisplayHandler ∈ WidgetFields w) => IPythonWidget w -> IO ()
triggerDisplay = triggerEvent SDisplayHandler triggerDisplay = triggerEvent DisplayHandler
verify_formatting.py
View file @ 6622b260
...@@ -54,7 +54,7 @@ for source_dir in ["src", "ipython-kernel", "ihaskell-display"]: ...@@ -54,7 +54,7 @@ for source_dir in ["src", "ipython-kernel", "ihaskell-display"]:
if "ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets" in root: if "ihaskell-display/ihaskell-widgets/src/IHaskell/Display/Widgets" in root:
# Ignore Types.hs and Common.hs from ihaskell-widgets # Ignore Types.hs and Common.hs from ihaskell-widgets
# They cause issues with hindent, due to promoted types # They cause issues with hindent, due to promoted types
ignored_files = ["Types.hs", "Common.hs"] ignored_files = ["Types.hs", "Common.hs", "Singletons.hs"]
else: else:
# Take Haskell files, but ignore the Cabal Setup.hs # Take Haskell files, but ignore the Cabal Setup.hs
# Also ignore IHaskellPrelude.hs, it uses CPP in weird places # Also ignore IHaskellPrelude.hs, it uses CPP in weird places
......
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