Added ChangeHandlers to picker widgets

This commit is contained in:
David Davó 2021-08-15 10:36:55 +02:00
parent 5cf832629b
commit 6dbb61ef42
4 changed files with 12 additions and 4 deletions

View File

@ -77,4 +77,4 @@ import IHaskell.Display.Widgets.Common as X
import IHaskell.Display.Widgets.Types as X (setField, getField, properties, triggerDisplay,
triggerChange, triggerClick, triggerSelection,
triggerSubmit, ChildWidget(..), StyleWidget(..),
WidgetFieldPair(..), Date(..), unlink)
WidgetFieldPair(..), Date(..), unlink, JSONByteString(..))

View File

@ -43,6 +43,7 @@ mkColorPicker = do
color = (StringValue =:: "black")
:& (Concise =:: False)
:& (Disabled =:: False)
:& (ChangeHandler =:: return ())
:& RNil
colorPickerState = WidgetState (ddw <+> color)
@ -58,3 +59,9 @@ mkColorPicker = do
instance IHaskellWidget ColorPicker where
getCommUUID = uuid
comm widget val _ =
case nestedObjectLookup val ["state", "value"] of
Just o -> case fromJSON o of
Success (String color) -> setField' widget StringValue color >> triggerChange widget
_ -> pure ()
_ -> pure ()

View File

@ -44,6 +44,7 @@ mkDatePicker = do
let ddw = defaultDescriptionWidget "DatePickerView" "DatePickerModel" layout $ StyleWidget dstyle
date = (DateValue =:: defaultDate)
:& (Disabled =:: False)
:& (ChangeHandler =:: return ())
:& RNil
datePickerState = WidgetState (ddw <+> date)
@ -62,6 +63,6 @@ instance IHaskellWidget DatePicker where
comm widget val _ =
case nestedObjectLookup val ["state", "value"] of
Just o -> case fromJSON o of
Success date -> void $ setField' widget DateValue date
Success date -> setField' widget DateValue date >> triggerChange widget
_ -> pure ()
_ -> pure ()

View File

@ -374,10 +374,10 @@ type instance WidgetFields 'ButtonType =
['S.Disabled, 'S.Icon, 'S.ButtonStyle,'S.ClickHandler]
type instance WidgetFields 'ColorPickerType =
DescriptionWidgetClass :++
['S.StringValue, 'S.Concise, 'S.Disabled]
['S.StringValue, 'S.Concise, 'S.Disabled, 'S.ChangeHandler]
type instance WidgetFields 'DatePickerType =
DescriptionWidgetClass :++
['S.DateValue, 'S.Disabled]
['S.DateValue, 'S.Disabled, 'S.ChangeHandler]
type instance WidgetFields 'AudioType =
MediaClass :++ ['S.AudioFormat, 'S.AutoPlay, 'S.Loop, 'S.Controls]