on develop help sign in
Re-add fileInput widget
516a0f4Cale Gibbard
src/Reflex/Dom/Widget/Input.hs+28−13
@@ -20,6 +20,14 @@ import Data.Semigroup
20import Control.Monad.Fix
20import Control.Monad.Fix
21import Control.Monad.IO.Class
21import Control.Monad.IO.Class
22
22
23+-- For fileInput
24+import GHCJS.DOM.EventM (on)
25+import GHCJS.DOM.Types (File)
26+import qualified GHCJS.DOM.Element as Element
27+import qualified GHCJS.DOM.File as File
28+import qualified GHCJS.DOM.FileList as FileList
29+
30+
23import Reflex
31import Reflex
24import qualified Data.Map as Map
32import qualified Data.Map as Map
25import Control.Lens hiding (ix, element)
33import Control.Lens hiding (ix, element)
@@ -300,11 +308,9 @@ checkboxView dAttrs dValue = do
300 performEvent_ $ fmap (\v -> Input.setChecked e $! v) $ updated dValue
308 performEvent_ $ fmap (\v -> Input.setChecked e $! v) $ updated dValue
301 return eClicked
309 return eClicked
302-}
310-}
303−{-
304
311
305data FileInput t
312data FileInput t
306 = FileInput { _fileInput_value :: Dynamic t [File]
313 = FileInput { _fileInput_value :: Dynamic t [File]
307− , _fileInput_element :: HTMLInputElement
308 }
314 }
309
315
310data FileInputConfig t
316data FileInputConfig t
@@ -315,16 +321,27 @@ instance Reflex t => Default (FileInputConfig t) where
315 def = FileInputConfig { _fileInputConfig_attributes = constDyn mempty
321 def = FileInputConfig { _fileInputConfig_attributes = constDyn mempty
316 }
322 }
317
323
324+fileInput :: forall t m. (MonadIO m, MonadFix m, MonadHold t m, TriggerEvent t m, DomBuilder t m, PostBuild t m, DomBuilderSpace m ~ GhcjsDomSpace)
318−fileInput :: DomBuilder t m => FileInputConfig t -> m (FileInput t)
325+ => FileInputConfig t -> m (FileInput t)
319−fileInput (FileInputConfig dAttrs) = do
326+fileInput config = do
320− e <- liftM castToHTMLInputElement $ buildEmptyElement "input" =<< mapDyn (Map.insert "type" "file") dAttrs
327+ let insertType = Map.insert "type" "file"
328+ dAttrs = fmap insertType $ _fileInputConfig_attributes config
329+ modifyAttrs <- dynamicAttributesToModifyAttributes dAttrs
330+ let cfg = (def :: ElementConfig EventResult t m)
331+ { _elementConfig_modifyAttributes = modifyAttrs
332+ , _elementConfig_eventFilters = DMap.singleton Change . EventFilter . GhcjsDomHandler $ \(GhcjsDomEvent evt) -> do
333+ return . (,) mempty . GhcjsDomHandler $ \_ -> return . Just $ EventResult ()
334+ }
335+ (eRaw, _) <- element "input" cfg blank
336+ let e = castToHTMLInputElement (_element_raw eRaw)
321− eChange <- wrapDomEvent e (flip on change) $ do
337+ eChange <- wrapDomEvent e (`on` Element.change) $ do
322− Just files <- getFiles e
338+ Just files <- Input.getFiles e
323− len <- FileList.getLength files
339+ len <- FileList.getLength files
324− mapM (liftM (fromMaybe (error "fileInput: fileListItem returned null")) . FileList.item files) $ init [0..len]
340+ mapM (liftM (fromMaybe (error "fileInput: fileList.item returned null")) . FileList.item files) $ [0 .. len-1]
325 dValue <- holdDyn [] eChange
341 dValue <- holdDyn [] eChange
326− return $ FileInput dValue e
342+ return $ FileInput
343+ { _fileInput_value = dValue
327−-}
344+ }
328
345
329data Dropdown t k
346data Dropdown t k
330 = Dropdown { _dropdown_value :: Dynamic t k
347 = Dropdown { _dropdown_value :: Dynamic t k
@@ -505,11 +522,9 @@ instance HasValue (TextInput t) where
505 type Value (TextInput t) = Dynamic t Text
522 type Value (TextInput t) = Dynamic t Text
506 value = _textInput_value
523 value = _textInput_value
507
524
508−{-
509instance HasValue (FileInput t) where
525instance HasValue (FileInput t) where
510 type Value (FileInput t) = Dynamic t [File]
526 type Value (FileInput t) = Dynamic t [File]
511 value = _fileInput_value
527 value = _fileInput_value
512−-}
513
528
514instance HasValue (Dropdown t k) where
529instance HasValue (Dropdown t k) where
515 type Value (Dropdown t k) = Dynamic t k
530 type Value (Dropdown t k) = Dynamic t k