@@ -40,7 +40,6 @@ import GHCJS.DOM.Types (File)
4040-- import qualified GHCJS.DOM.File as File
4141import qualified GHCJS.DOM.FileList as FileList
4242
43−
4443import Control.Lens hiding (element, ix)
4544import Control.Monad hiding (forM_)
4645import qualified Data.Bimap as Bimap
@@ -106,6 +105,45 @@ textInput (TextInputConfig inputType initial eSetValue dAttrs) = do
106105textInputGetEnter :: Reflex t => TextInput t -> Event t ()
107106textInputGetEnter i = fmapMaybe (\n -> if keyCodeLookup n == Enter then Just () else Nothing) $ _textInput_keypress i
108107
108+data RangeInputConfig t
109+ = RangeInputConfig { _rangeInputConfig_initialValue :: Float
110+ , _rangeInputConfig_setValue :: Event t Float
111+ , _rangeInputConfig_attributes :: Dynamic t (Map Text Text)
112+ }
113+
114+instance Reflex t => Default (RangeInputConfig t) where
115+ {-# INLINABLE def #-}
116+ def = RangeInputConfig { _rangeInputConfig_initialValue = 0
117+ , _rangeInputConfig_setValue = never
118+ , _rangeInputConfig_attributes = constDyn mempty
119+ }
120+
121+data RangeInput t
122+ = RangeInput { _rangeInput_value :: Dynamic t Float
123+ , _rangeInput_input :: Event t Float
124+ , _rangeInput_mouseup :: Event t (Int, Int)
125+ , _rangeInput_hasFocus :: Dynamic t Bool
126+ , _rangeInput_element :: HTMLInputElement
127+ }
128+
129+-- | Create an input whose value is a float.
130+-- https://www.w3.org/wiki/HTML/Elements/input/range
131+{-# INLINABLE rangeInput #-}
132+rangeInput :: (DomBuilder t m, PostBuild t m, DomBuilderSpace m ~ GhcjsDomSpace) => RangeInputConfig t -> m (RangeInput t)
133+rangeInput (RangeInputConfig initial eSetValue dAttrs) = do
134+ modifyAttrs <- dynamicAttributesToModifyAttributes $ fmap (Map.insert "type" "range") dAttrs
135+ i <- inputElement $ def
136+ & inputElementConfig_initialValue .~ (T.pack . show $ initial)
137+ & inputElementConfig_setValue .~ (T.pack . show <$> eSetValue)
138+ & inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ modifyAttrs
139+ return $ RangeInput
140+ { _rangeInput_value = read . T.unpack <$> _inputElement_value i
141+ , _rangeInput_input = read . T.unpack <$> _inputElement_input i
142+ , _rangeInput_mouseup = domEvent Mouseup i
143+ , _rangeInput_hasFocus = _inputElement_hasFocus i
144+ , _rangeInput_element = castToHTMLInputElement $ _element_raw $ _inputElement_element i
145+ }
146+
109147data TextAreaConfig t
110148 = TextAreaConfig { _textAreaConfig_initialValue :: Text
111149 , _textAreaConfig_setValue :: Event t Text
@@ -418,6 +456,8 @@ concat <$> mapM makeLenses
418456 , ''TextArea
419457 , ''TextInputConfig
420458 , ''TextInput
459+ , ''RangeInputConfig
460+ , ''RangeInput
421461 , ''FileInputConfig
422462 , ''FileInput
423463 , ''DropdownConfig
@@ -434,6 +474,10 @@ instance HasAttributes (TextInputConfig t) where
434474 type Attrs (TextInputConfig t) = Dynamic t (Map Text Text)
435475 attributes = textInputConfig_attributes
436476
477+instance HasAttributes (RangeInputConfig t) where
478+ type Attrs (RangeInputConfig t) = Dynamic t (Map Text Text)
479+ attributes = rangeInputConfig_attributes
480+
437481instance HasAttributes (DropdownConfig t k) where
438482 type Attrs (DropdownConfig t k) = Dynamic t (Map Text Text)
439483 attributes = dropdownConfig_attributes
@@ -458,6 +502,10 @@ instance HasSetValue (TextInputConfig t) where
458502 type SetValue (TextInputConfig t) = Event t Text
459503 setValue = textInputConfig_setValue
460504
505+instance HasSetValue (RangeInputConfig t) where
506+ type SetValue (RangeInputConfig t) = Event t Float
507+ setValue = rangeInputConfig_setValue
508+
461509instance HasSetValue (DropdownConfig t k) where
462510 type SetValue (DropdownConfig t k) = Event t k
463511 setValue = dropdownConfig_setValue