59675e7 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Add _fileInput_element; make the Raw*Element stuff more complete

commit59675e7bc0cbb85f55e635795c6f60619ca678fd authorRyan Trinkle <ryan.trinkle@gmail.com> dateSun 7 Aug 2016, 12:22 (10 years ago) parent48a3398

5 files changed+47−21

compare with develop

unifiedsplit

src/Reflex/Dom/Builder/Class.hs+4 src/Reflex/Dom/Builder/Immediate.hs+13−4 src/Reflex/Dom/Builder/Static.hs+11−1 src/Reflex/Dom/Old.hs+5−5 src/Reflex/Dom/Widget/Input.hs+14−11

src/Reflex/Dom/Builder/Class.hs+4

@@ -49,6 +49,8 @@ class DomSpace d where

4949 type RawEvent d :: EventTag -> *

5050 type RawTextNode d :: *

5151 type RawElement d :: *

52+ type RawInputElement d :: *

53+ type RawTextAreaElement d :: *

5254 defaultEventHandler :: proxy d -> DomHandler1 d (Pair1 EventName (RawEvent d)) (Maybe1 EventResult)

5355

5456-- | @'DomBuilder' t m@ indicates that @m@ is a 'Monad' capable of building dynamic DOM in the 'Reflex' timeline @t@

@@ -186,6 +188,7 @@ data InputElement er d t

186188 , _inputElement_input :: Event t Text

187189 , _inputElement_hasFocus :: Dynamic t Bool

188190 , _inputElement_element :: Element er d t

191+ , _inputElement_raw :: RawInputElement d

189192 }

190193

191194data TextAreaElementConfig er t m

@@ -207,6 +210,7 @@ data TextAreaElement er d t

207210 , _textAreaElement_input :: Event t Text

208211 , _textAreaElement_hasFocus :: Dynamic t Bool

209212 , _textAreaElement_element :: Element er d t

213+ , _textAreaElement_raw :: RawTextAreaElement d

210214 }

211215

212216makeLenses ''TextNodeConfig

src/Reflex/Dom/Builder/Immediate.hs+13−4

@@ -128,10 +128,10 @@ type SupportsImmediateDomBuilder t m = (Reflex t, MonadIO m, MonadHold t m, Mona

128128newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IORef (Maybe (EventTrigger t (er en))))

129129

130130{-# INLINABLE makeElement #-}

131−makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.Element)

131+makeElement :: forall er t m a. SupportsImmediateDomBuilder t m => Text -> ElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m a -> ImmediateDomBuilderT t m ((Element er GhcjsDomSpace t, a), DOM.HTMLElement)

132132makeElement elementTag cfg child = do

133133 doc <- askDocument

134− Just e <- ImmediateDomBuilderT $ case cfg ^. namespace of

134+ Just e <- ImmediateDomBuilderT $ fmap DOM.castToHTMLElement <$> case cfg ^. namespace of

135135 Nothing -> createElement doc (Just elementTag)

136136 Just ens -> createElementNS doc (Just ens) (Just elementTag)

137137 ImmediateDomBuilderT $ iforM_ (cfg ^. initialAttributes) $ \(mAttrNamespace, n) v -> case mAttrNamespace of

@@ -191,7 +191,9 @@ instance DomSpace GhcjsDomSpace where

191191 type DomHandler1 GhcjsDomSpace = GhcjsDomHandler1

192192 type RawEvent GhcjsDomSpace = GhcjsDomEvent

193193 type RawTextNode GhcjsDomSpace = DOM.Text

194− type RawElement GhcjsDomSpace = DOM.Element

194+ type RawElement GhcjsDomSpace = DOM.HTMLElement

195+ type RawInputElement GhcjsDomSpace = DOM.HTMLInputElement

196+ type RawTextAreaElement GhcjsDomSpace = DOM.HTMLTextAreaElement

195197 {-# INLINABLE defaultEventHandler #-}

196198 defaultEventHandler _ = GhcjsDomHandler1 $ \(Pair1 en (GhcjsDomEvent evt)) -> do

197199 Just t <- withIsEvent en $ Event.getTarget evt

@@ -258,6 +260,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

258260 , _inputElement_input = valueChangedByUI

259261 , _inputElement_hasFocus = hasFocus

260262 , _inputElement_element = e

263+ , _inputElement_raw = domInputElement

261264 }

262265 {-# INLINABLE textAreaElement #-}

263266 textAreaElement cfg = do --TODO

@@ -278,7 +281,13 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

278281 [ False <$ Reflex.select (_element_events e) (WrapArg Blur)

279282 , True <$ Reflex.select (_element_events e) (WrapArg Focus)

280283 ]

281− return $ TextAreaElement v valueChangedByUI hasFocus e

284+ return $ TextAreaElement

285+ { _textAreaElement_value = v

286+ , _textAreaElement_input = valueChangedByUI

287+ , _textAreaElement_hasFocus = hasFocus

288+ , _textAreaElement_element = e

289+ , _textAreaElement_raw = domTextAreaElement

290+ }

282291

283292{-# INLINABLE insertImmediateAbove #-}

284293insertImmediateAbove :: (Reflex t, IsNode placeholder, PerformEvent t m, MonadIO (Performable m)) => placeholder -> Event t (ImmediateDomBuilderT t (Performable m) a) -> ImmediateDomBuilderT t m (Event t a)

src/Reflex/Dom/Builder/Static.hs+11−1

@@ -112,6 +112,8 @@ data StaticDomHandler (a :: k) (b :: k) = StaticDomHandler

112112instance DomSpace StaticDomSpace where

113113 type RawTextNode StaticDomSpace = ()

114114 type RawElement StaticDomSpace = ()

115+ type RawInputElement StaticDomSpace = ()

116+ type RawTextAreaElement StaticDomSpace = ()

115117 type RawEvent StaticDomSpace = StaticDomEvent

116118 type DomHandler StaticDomSpace = StaticDomHandler

117119 type DomHandler1 StaticDomSpace = StaticDomHandler

@@ -159,14 +161,22 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh

159161 , _inputElement_input = never

160162 , _inputElement_hasFocus = hasFocus

161163 , _inputElement_element = e

164+ , _inputElement_raw = ()

162165 }

163166

164167 {-# INLINABLE textAreaElement #-}

165168 textAreaElement cfg = do

169+ --TODO: Support setValue event

166170 (e, _domElement) <- element "textarea" (cfg ^. textAreaElementConfig_elementConfig) $ return ()

167171 let v0 = constDyn $ cfg ^. textAreaElementConfig_initialValue

168172 let hasFocus = constDyn False -- TODO should this be coming from initialAtttributes

169− return $ TextAreaElement v0 never hasFocus e

173+ return $ TextAreaElement

174+ { _textAreaElement_value = v0

175+ , _textAreaElement_input = never

176+ , _textAreaElement_hasFocus = hasFocus

177+ , _textAreaElement_element = e

178+ , _textAreaElement_raw = ()

179+ }

170180

171181--TODO: Make this more abstract --TODO: Put the WithWebView underneath PerformEventT - I think this would perform better

172182type StaticWidget x = PostBuildT Spider (StaticDomBuilderT Spider (PerformEventT Spider (SpiderHost Global)))

src/Reflex/Dom/Old.hs+5−5

@@ -80,17 +80,17 @@ addVoidAction = performEvent_

8080

8181type AttributeMap = Map String String

8282

83−buildElement :: Attributes m attrs => String -> attrs -> m a -> m (DOM.Element, a)

83+buildElement :: Attributes m attrs => String -> attrs -> m a -> m (RawElement GhcjsDomSpace, a)

8484buildElement = buildElementNS Nothing

8585

86−buildEmptyElement :: Monad m => Attributes m attrs => String -> attrs -> m DOM.Element

86+buildEmptyElement :: Monad m => Attributes m attrs => String -> attrs -> m (RawElement GhcjsDomSpace)

8787buildEmptyElement elementTag attrs = fst <$> buildElementNS Nothing elementTag attrs blank

8888

89−buildEmptyElementNS :: Monad m => Attributes m attrs => Maybe String -> String -> attrs -> m DOM.Element

89+buildEmptyElementNS :: Monad m => Attributes m attrs => Maybe String -> String -> attrs -> m (RawElement GhcjsDomSpace)

9090buildEmptyElementNS ns elementTag attrs = fst <$> buildElementNS ns elementTag attrs blank

9191

9292class Attributes m attrs where

93− buildElementNS :: Maybe String -> String -> attrs -> m a -> m (DOM.Element, a)

93+ buildElementNS :: Maybe String -> String -> attrs -> m a -> m (RawElement GhcjsDomSpace, a)

9494

9595instance MonadWidget t m => Attributes m (Map String String) where

9696 buildElementNS ns elementTag attrs child = do

@@ -112,7 +112,7 @@ addDynamicAttributes attrs cfg = do

112112 modifyAttrs <- dynamicAttributesToModifyAttributes $ fmap (Map.fromList . fmap (T.pack *** T.pack) . Map.toList) attrs

113113 return $ cfg & elementConfig_modifyAttributes .~ modifyAttrs

114114

115−buildElementInternal :: MonadWidget t m => String -> m a -> ElementConfig en t m -> m (DOM.Element, a)

115+buildElementInternal :: MonadWidget t m => String -> m a -> ElementConfig en t m -> m (DOM.HTMLElement, a)

116116buildElementInternal elementTag child cfg = do

117117 (e, result) <- element (T.pack elementTag) cfg child

118118 return (_element_raw e, result)

src/Reflex/Dom/Widget/Input.hs+14−11

@@ -304,8 +304,9 @@ checkboxView dAttrs dValue = do

304304 i <- inputElement inputElementConfig

305305 return $ unCheckboxViewEventResult <$> select (_element_events $ _inputElement_element i) (WrapArg Click)

306306

307−data FileInput t

307+data FileInput d t

308308 = FileInput { _fileInput_value :: Dynamic t [File]

309+ , _fileInput_element :: RawInputElement d

309310 }

310311

311312data FileInputConfig t

@@ -317,18 +318,19 @@ instance Reflex t => Default (FileInputConfig t) where

317318 }

318319

319320fileInput :: forall t m. (MonadIO m, MonadFix m, MonadHold t m, TriggerEvent t m, DomBuilder t m, PostBuild t m, DomBuilderSpace m ~ GhcjsDomSpace)

320− => FileInputConfig t -> m (FileInput t)

321+ => FileInputConfig t -> m (FileInput (DomBuilderSpace m) t)

321322fileInput config = do

322323 let insertType = Map.insert "type" "file"

323324 dAttrs = insertType <$> _fileInputConfig_attributes config

324325 modifyAttrs <- dynamicAttributesToModifyAttributes dAttrs

325− let cfg = (def :: ElementConfig EventResult t m)

326− { _elementConfig_modifyAttributes = modifyAttrs

327− , _elementConfig_eventFilters = DMap.singleton Change . EventFilter . GhcjsDomHandler $ \_ -> do

328− return . (,) mempty . GhcjsDomHandler $ \_ -> return . Just $ EventResult ()

329− }

330− (eRaw, _) <- element "input" cfg blank

331− let e = castToHTMLInputElement (_element_raw eRaw)

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+ }

331+ cfg = (def :: InputElementConfig EventResult t m) & inputElementConfig_elementConfig .~ elCfg

332+ eRaw <- inputElement cfg

333+ let e = _inputElement_raw eRaw

332334 eChange <- wrapDomEvent e (`on` Element.change) $ do

333335 Just files <- Input.getFiles e

334336 len <- FileList.getLength files

@@ -336,6 +338,7 @@ fileInput config = do

336338 dValue <- holdDyn [] eChange

337339 return $ FileInput

338340 { _fileInput_value = dValue

341+ , _fileInput_element = e

339342 }

340343

341344data Dropdown t k

@@ -527,8 +530,8 @@ instance HasValue (TextInput t) where

527530 type Value (TextInput t) = Dynamic t Text

528531 value = _textInput_value

529532

530−instance HasValue (FileInput t) where

531− type Value (FileInput t) = Dynamic t [File]

533+instance HasValue (FileInput d t) where

534+ type Value (FileInput d t) = Dynamic t [File]

532535 value = _fileInput_value

533536

534537instance HasValue (Dropdown t k) where