@@ -144,6 +144,16 @@ instance HasStateModeWitness View where
144 stateModeWitness = ViewWitness
144 stateModeWitness = ViewWitness
147+data CheckboxConfig t
148+ = CheckboxConfig { _checkboxConfig_setValue :: Event t Bool
149+ , _checkboxConfig_attributes :: Map String String
152+instance Reflex t => Default (CheckboxConfig t) where
153+ def = CheckboxConfig { _checkboxConfig_setValue = never
154+ , _checkboxConfig_attributes = Map.empty
147data Checkbox t
157data Checkbox t
148 = Checkbox { _checkbox_value :: Dynamic t Bool
158 = Checkbox { _checkbox_value :: Dynamic t Bool
@@ -151,11 +161,12 @@ data Checkbox t
151--TODO: Make attributes possibly dynamic
161--TODO: Make attributes possibly dynamic
152-- | Create an editable checkbox
162-- | Create an editable checkbox
153-- Note: if the "type" or "checked" attributes are provided as attributes, they will be ignored
163-- Note: if the "type" or "checked" attributes are provided as attributes, they will be ignored
154−checkbox :: MonadWidget t m => Bool -> Map String String -> m (Checkbox t)
164+checkbox :: MonadWidget t m => Bool -> CheckboxConfig t -> m (Checkbox t)
155−checkbox checked attrs = do
165+checkbox checked config = do
156− e <- liftM castToHTMLInputElement $ buildEmptyElement "input" $ Map.insert "type" "checkbox" $ (if checked then Map.insert "checked" "checked" else Map.delete "checked") attrs
166+ e <- liftM castToHTMLInputElement $ buildEmptyElement "input" $ Map.insert "type" "checkbox" $ (if checked then Map.insert "checked" "checked" else Map.delete "checked") (_checkboxConfig_attributes config)
157− eChange <- wrapDomEvent e elementOnclick $ liftIO $ htmlInputElementGetChecked e
167+ eClick <- wrapDomEvent e elementOnclick $ liftIO $ htmlInputElementGetChecked e
168+ performEvent_ $ fmap (liftIO . htmlInputElementSetChecked e) $ _checkboxConfig_setValue config
158− dValue <- holdDyn checked eChange
169+ dValue <- holdDyn checked $ leftmost [_checkboxConfig_setValue config, eClick]
159 return $ Checkbox dValue
170 return $ Checkbox dValue
161checkboxView :: MonadWidget t m => Dynamic t (Map String String) -> Dynamic t Bool -> m (Event t Bool)
172checkboxView :: MonadWidget t m => Dynamic t (Map String String) -> Dynamic t Bool -> m (Event t Bool)
@@ -175,7 +186,7 @@ checkboxWithLabel l = checkboxWithLabelAttrs l Map.empty
176checkboxWithLabelAttrs :: forall t m. MonadWidget t m => String -> Map String String -> m (Checkbox t)
187checkboxWithLabelAttrs :: forall t m. MonadWidget t m => String -> Map String String -> m (Checkbox t)
177checkboxWithLabelAttrs l attrs = elAttr "label" attrs $ do
188checkboxWithLabelAttrs l attrs = elAttr "label" attrs $ do
178− c <- checkbox False Map.empty
189+ c <- checkbox False def
179 text $ " " <> l
190 text $ " " <> l