git.iko.soy/reflex-dom
on develop help sign in
Add FileInput control
commit488646b91ff93a89435c474a87fc5dadb9a1df9c authorRyan Trinkle <ryan.trinkle@gmail.com> dateMon 17 Aug 2015, 23:53 (11 years ago) parentc25f17f
2 files changed+38−5
compare with develop
unifiedsplit
src/Reflex/Dom/Widget/Basic.hs+2 src/Reflex/Dom/Widget/Input.hs+36−5
src/Reflex/Dom/Widget/Basic.hs+2
@@ -611,6 +611,7 @@ type family EventResultType (en :: EventTag) :: * where
611611 EventResultType 'MouseleaveTag = ()
612612 EventResultType 'FocusTag = ()
613613 EventResultType 'BlurTag = ()
614+ EventResultType 'ChangeTag = ()
614615
615616wrapDomEventsMaybe :: (Functor (Event t), IsElement e, MonadIO m, MonadSample t m, MonadReflexCreateTrigger t m, Reflex t, HasPostGui t h m) => e -> (forall en. EventName en -> EventM (EventType en) e (Maybe (f en))) -> m (EventSelector t (WrapArg f EventName))
616617wrapDomEventsMaybe element handlers = do
@@ -652,6 +653,7 @@ defaultDomEventHandler e evt = liftM (Just . EventResult) $ case evt of
652653 Mouseleave -> return ()
653654 Focus -> return ()
654655 Blur -> return ()
656+ Change -> return ()
655657
656658wrapElement :: forall t h m. (Functor (Event t), MonadIO m, MonadSample t m, MonadReflexCreateTrigger t m, Reflex t, HasPostGui t h m) => HTMLElement -> m (El t)
657659wrapElement e = do
src/Reflex/Dom/Widget/Input.hs+36−5
@@ -14,6 +14,8 @@ import GHCJS.DOM.Element
1414import GHCJS.DOM.HTMLSelectElement
1515import GHCJS.DOM.EventM
1616import GHCJS.DOM.UIEvent
17+import GHCJS.DOM.File
18+import GHCJS.DOM.FileList
1719import Data.Monoid
1820import Data.Map as Map
1921import Control.Lens
@@ -35,11 +37,11 @@ data TextInput t
3537 }
3638
3739data TextInputConfig t
38− = TextInputConfig { _textInputConfig_inputType :: String
39− , _textInputConfig_initialValue :: String
40− , _textInputConfig_setValue :: Event t String
41− , _textInputConfig_attributes :: Dynamic t (Map String String)
42− }
40+ = TextInputConfig { _textInputConfig_inputType :: String
41+ , _textInputConfig_initialValue :: String
42+ , _textInputConfig_setValue :: Event t String
43+ , _textInputConfig_attributes :: Dynamic t (Map String String)
44+ }
4345
4446instance Reflex t => Default (TextInputConfig t) where
4547 def = TextInputConfig { _textInputConfig_inputType = "text"
@@ -150,6 +152,31 @@ checkboxView dAttrs dValue = do
150152 performEvent_ $ fmap (\v -> liftIO $ htmlInputElementSetChecked e $! v) $ updated dValue
151153 return eClicked
152154
155+data FileInput t
156+ = FileInput { _fileInput_value :: Dynamic t [File]
157+ , _fileInput_element :: HTMLInputElement
158+ }
159+
160+data FileInputConfig t
161+ = FileInputConfig { _fileInputConfig_clearValue :: Event t ()
162+ , _fileInputConfig_attributes :: Dynamic t (Map String String)
163+ }
164+
165+instance Reflex t => Default (FileInputConfig t) where
166+ def = FileInputConfig { _fileInputConfig_clearValue = never
167+ , _fileInputConfig_attributes = constDyn mempty
168+ }
169+
170+fileInput :: MonadWidget t m => FileInputConfig t -> m (FileInput t)
171+fileInput (FileInputConfig clearValue dAttrs) = do
172+ e <- liftM castToHTMLInputElement $ buildEmptyElement "input" =<< mapDyn (Map.insert "type" "file") dAttrs
173+ eChange <- wrapDomEvent e elementOnchange $ liftIO $ do
174+ Just files <- htmlInputElementGetFiles e
175+ len <- fileListGetLength files
176+ mapM (liftM (fromMaybe (error "fileInput: fileListItem returned null")) . fileListItem files) $ init [0..len]
177+ dValue <- holdDyn [] eChange
178+ return $ FileInput dValue e
179+
153180data Dropdown t k
154181 = Dropdown { _dropdown_value :: Dynamic t k
155182 , _dropdown_change :: Event t k
@@ -250,6 +277,10 @@ instance HasValue (TextInput t) where
250277 type Value (TextInput t) = Dynamic t String
251278 value = _textInput_value
252279
280+instance HasValue (FileInput t) where
281+ type Value (FileInput t) = Dynamic t [File]
282+ value = _fileInput_value
283+
253284instance HasValue (Dropdown t k) where
254285 type Value (Dropdown t k) = Dynamic t k
255286 value = _dropdown_value