@@ -15,33 +15,10 @@ module Reflex.Dom.Widget.Input (module Reflex.Dom.Widget.Input, def, (&), (.~))
1515
1616import Prelude
1717
18−import Reflex.Dom.Builder.Class
19−import Reflex.Dom.Builder.Immediate
20−import Reflex.Dom.Class
21−import Reflex.Dom.PostBuild.Class
22−import Reflex.Dom.Widget.Basic
23−
24−-- For dropdown
18+import Control.Lens hiding (element, ix)
2519import Control.Monad.Fix
2620import Control.Monad.IO.Class
27−import Data.Maybe
28−import Data.Semigroup
29−import GHCJS.DOM.HTMLInputElement (HTMLInputElement, castToHTMLInputElement)
30−import GHCJS.DOM.HTMLSelectElement (castToHTMLSelectElement)
31−import qualified GHCJS.DOM.HTMLSelectElement as HTMLSelectElement
32−import GHCJS.DOM.HTMLTextAreaElement (HTMLTextAreaElement, castToHTMLTextAreaElement)
33−import Reflex.Dom.PerformEvent.Class
34−import qualified Text.Read as T
35−
36−-- For fileInput
37−import qualified GHCJS.DOM.Element as Element
38−import GHCJS.DOM.EventM (on)
39−import GHCJS.DOM.Types (File)
40−-- import qualified GHCJS.DOM.File as File
41−import qualified GHCJS.DOM.FileList as FileList
42−
43−import Control.Lens hiding (element, ix)
44−import Control.Monad hiding (forM_)
21+import Control.Monad.Reader
4522import qualified Data.Bimap as Bimap
4623import Data.Default
4724import Data.Dependent.Map (DMap)
@@ -49,10 +26,27 @@ import qualified Data.Dependent.Map as DMap
4926import Data.Functor.Misc
5027import Data.Map (Map)
5128import qualified Data.Map as Map
52−import Data.Proxy
29+import Data.Maybe
30+import Data.Semigroup
5331import Data.Text (Text)
5432import qualified Data.Text as T
33+import GHCJS.DOM.Element (castToElement)
34+import qualified GHCJS.DOM.Element as Element
35+import GHCJS.DOM.EventM (on)
36+import qualified GHCJS.DOM.FileList as FileList
37+import GHCJS.DOM.HTMLInputElement (HTMLInputElement, castToHTMLInputElement)
38+import GHCJS.DOM.HTMLSelectElement (castToHTMLSelectElement)
39+import qualified GHCJS.DOM.HTMLSelectElement as HTMLSelectElement
40+import GHCJS.DOM.HTMLTextAreaElement (HTMLTextAreaElement, castToHTMLTextAreaElement)
41+import GHCJS.DOM.Types (File)
5542import Reflex
43+import Reflex.Dom.Builder.Class
44+import Reflex.Dom.Builder.Immediate
45+import Reflex.Dom.Class
46+import Reflex.Dom.PerformEvent.Class
47+import Reflex.Dom.PostBuild.Class
48+import Reflex.Dom.Widget.Basic
49+import qualified Text.Read as T
5650
5751import qualified GHCJS.DOM.Event as Event
5852import qualified GHCJS.DOM.HTMLInputElement as Input
@@ -279,23 +273,24 @@ checkboxView dAttrs dValue = do
279273 let permanentAttrs = "type" =: "checkbox"
280274 modifyAttrs <- dynamicAttributesToModifyAttributes $ fmap (Map.union permanentAttrs) dAttrs
281275 postBuild <- getPostBuild
282− let filters :: DMap EventName (EventFilter (DomBuilderSpace m) CheckboxViewEventResult)
283− filters = DMap.singleton Click $ EventFilter $ GhcjsDomHandler $ \(GhcjsDomEvent evt) -> do
276+ let filters :: DMap EventName (GhcjsEventFilter CheckboxViewEventResult)
277+ filters = DMap.singleton Click $ GhcjsEventFilter $ \(GhcjsDomEvent evt) -> do
284278 Just t <- Event.getTarget evt
285279 b <- Input.getChecked $ Input.castToHTMLInputElement t
286− return $ (,) preventDefault $ GhcjsDomHandler $ \_ -> return $ Just $ CheckboxViewEventResult b
280+ return $ (,) preventDefault $ return $ Just $ CheckboxViewEventResult b
287281 elementConfig :: ElementConfig CheckboxViewEventResult t m
288282 elementConfig = (def :: ElementConfig EventResult t m)
289283 { _elementConfig_modifyAttributes = modifyAttrs
290284 , _elementConfig_initialAttributes = Map.mapKeys ((,) Nothing) permanentAttrs
291− , _elementConfig_eventFilters = filters
292− , _elementConfig_eventHandler = GhcjsDomHandler1 $ \p@(Pair1 en _) -> case en of
293− Click -> error "impossible"
294− _ -> do
295− mr <- unGhcjsDomHandler1 (defaultEventHandler (Proxy :: Proxy (DomBuilderSpace m))) p
296− case mr of
297− Nothing1 -> return Nothing1
298− Just1 (EventResult r) -> return $ Just1 $ CheckboxViewEventResult $ regularToCheckboxViewEventType en r
285+ , _elementConfig_eventSpec = GhcjsEventSpec
286+ { _ghcjsEventSpec_filters = filters
287+ , _ghcjsEventSpec_handler = \(en, GhcjsDomEvent evt) -> case en of
288+ Click -> error "impossible"
289+ _ -> do
290+ Just e <- withIsEvent en $ Event.getTarget evt
291+ mr <- runReaderT (defaultDomEventHandler (castToElement e) en) evt
292+ return $ ffor mr $ \(EventResult r) -> CheckboxViewEventResult $ regularToCheckboxViewEventType en r
293+ }
299294 }
300295 inputElementConfig :: InputElementConfig CheckboxViewEventResult t m
301296 inputElementConfig = (def :: InputElementConfig EventResult t m)
@@ -323,11 +318,11 @@ fileInput config = do
323318 let insertType = Map.insert "type" "file"
324319 dAttrs = insertType <$> _fileInputConfig_attributes config
325320 modifyAttrs <- dynamicAttributesToModifyAttributes dAttrs
326− let elCfg = (def :: ElementConfig EventResult t m)
327− { _elementConfig_modifyAttributes = modifyAttrs
328− , _elementConfig_eventFilters = DMap.singleton Change . EventFilter . GhcjsDomHandler $ \_ -> do
329− return . (,) mempty . GhcjsDomHandler $ \_ -> return . Just $ EventResult ()
330− }
321+ let filters = DMap.singleton Change . GhcjsEventFilter $ \_ -> do
322+ return . (,) mempty $ return . Just $ EventResult ()
323+ elCfg = (def :: ElementConfig EventResult t m)
324+ & modifyAttributes .~ modifyAttrs
325+ & elementConfig_eventSpec . ghcjsEventSpec_filters .~ filters
331326 cfg = (def :: InputElementConfig EventResult t m) & inputElementConfig_elementConfig .~ elCfg
332327 eRaw <- inputElement cfg
333328 let e = _inputElement_raw eRaw
@@ -426,17 +421,18 @@ dropdown k0 options (DropdownConfig setK attrs) = do
426421 modifyAttrs <- dynamicAttributesToModifyAttributes attrs
427422 let cfg = (def :: ElementConfig EventResult t m)
428423 { _elementConfig_modifyAttributes = modifyAttrs
429− , _elementConfig_eventFilters = DMap.singleton Change $ EventFilter $ GhcjsDomHandler $ \(GhcjsDomEvent evt) -> do
430− Just t <- Event.getTarget evt
431− Just v <- HTMLSelectElement.getValue $ HTMLSelectElement.castToHTMLSelectElement t
432− return $ (,) mempty $ GhcjsDomHandler $ \_ -> return $ Just $ DropdownViewEventResult v
433− , _elementConfig_eventHandler = GhcjsDomHandler1 $ \p@(Pair1 en _) -> case en of
434− Click -> error "impossible"
435− _ -> do
436− mr <- unGhcjsDomHandler1 (defaultEventHandler (Proxy :: Proxy (DomBuilderSpace m))) p
437− case mr of
438− Nothing1 -> return Nothing1
439− Just1 (EventResult r) -> return $ Just1 $ DropdownViewEventResult $ regularToDropdownViewEventType en r
424+ , _elementConfig_eventSpec = GhcjsEventSpec
425+ { _ghcjsEventSpec_filters = DMap.singleton Change $ GhcjsEventFilter $ \(GhcjsDomEvent evt) -> do
426+ Just t <- Event.getTarget evt
427+ Just v <- HTMLSelectElement.getValue $ HTMLSelectElement.castToHTMLSelectElement t
428+ return $ (,) mempty $ return $ Just $ DropdownViewEventResult v
429+ , _ghcjsEventSpec_handler = \(en, GhcjsDomEvent evt) -> case en of
430+ Click -> error "impossible"
431+ _ -> do
432+ Just e <- withIsEvent en $ Event.getTarget evt
433+ mr <- runReaderT (defaultDomEventHandler (castToElement e) en) evt
434+ return $ ffor mr $ \(EventResult r) -> DropdownViewEventResult $ regularToDropdownViewEventType en r
435+ }
440436 }
441437 (eRaw, _) <- element "select" cfg $ listWithKey indexedOptions $ \(ix, k) v -> do
442438 let optionAttrs = fmap (\dk -> "value" =: T.pack (show ix) <> if dk == k then "selected" =: "selected" else mempty) defaultKey