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

git.iko.soy/reflex-dom

on develop help sign in

Add _fileInput_element; make the Raw*Element stuff more complete

59675e7Ryan Trinkle10 years ago

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

compare with develop

unifiedsplit

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

49 type RawEvent d :: EventTag -> *

50 type RawTextNode d :: *

51 type RawElement d :: *

52+ type RawInputElement d :: *

53+ type RawTextAreaElement d :: *

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

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

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

56-- | @'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

186 , _inputElement_input :: Event t Text

188 , _inputElement_input :: Event t Text

187 , _inputElement_hasFocus :: Dynamic t Bool

189 , _inputElement_hasFocus :: Dynamic t Bool

188 , _inputElement_element :: Element er d t

190 , _inputElement_element :: Element er d t

191+ , _inputElement_raw :: RawInputElement d

189 }

192 }

190

193

191data TextAreaElementConfig er t m

194data TextAreaElementConfig er t m

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

207 , _textAreaElement_input :: Event t Text

210 , _textAreaElement_input :: Event t Text

208 , _textAreaElement_hasFocus :: Dynamic t Bool

211 , _textAreaElement_hasFocus :: Dynamic t Bool

209 , _textAreaElement_element :: Element er d t

212 , _textAreaElement_element :: Element er d t

213+ , _textAreaElement_raw :: RawTextAreaElement d

210 }

214 }

211

215

212makeLenses ''TextNodeConfig

216makeLenses ''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

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

129

130{-# 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)

132makeElement elementTag cfg child = do

133 doc <- askDocument

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

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

135 Nothing -> createElement doc (Just elementTag)

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

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

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

191 type DomHandler1 GhcjsDomSpace = GhcjsDomHandler1

192 type RawEvent GhcjsDomSpace = GhcjsDomEvent

193 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

195 {-# INLINABLE defaultEventHandler #-}

197 {-# INLINABLE defaultEventHandler #-}

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

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

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

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

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

258 , _inputElement_input = valueChangedByUI

260 , _inputElement_input = valueChangedByUI

259 , _inputElement_hasFocus = hasFocus

261 , _inputElement_hasFocus = hasFocus

260 , _inputElement_element = e

262 , _inputElement_element = e

263+ , _inputElement_raw = domInputElement

261 }

264 }

262 {-# INLINABLE textAreaElement #-}

265 {-# INLINABLE textAreaElement #-}

263 textAreaElement cfg = do --TODO

266 textAreaElement cfg = do --TODO

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

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

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

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

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

280 ]

283 ]

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

282

291

283{-# INLINABLE insertImmediateAbove #-}

292{-# INLINABLE insertImmediateAbove #-}

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

293insertImmediateAbove :: (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

112instance DomSpace StaticDomSpace where

113 type RawTextNode StaticDomSpace = ()

114 type RawElement StaticDomSpace = ()

115+ type RawInputElement StaticDomSpace = ()

116+ type RawTextAreaElement StaticDomSpace = ()

115 type RawEvent StaticDomSpace = StaticDomEvent

117 type RawEvent StaticDomSpace = StaticDomEvent

116 type DomHandler StaticDomSpace = StaticDomHandler

118 type DomHandler StaticDomSpace = StaticDomHandler

117 type DomHandler1 StaticDomSpace = StaticDomHandler

119 type DomHandler1 StaticDomSpace = StaticDomHandler

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

159 , _inputElement_input = never

161 , _inputElement_input = never

160 , _inputElement_hasFocus = hasFocus

162 , _inputElement_hasFocus = hasFocus

161 , _inputElement_element = e

163 , _inputElement_element = e

164+ , _inputElement_raw = ()

162 }

165 }

163

166

164 {-# INLINABLE textAreaElement #-}

167 {-# INLINABLE textAreaElement #-}

165 textAreaElement cfg = do

168 textAreaElement cfg = do

169+ --TODO: Support setValue event

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

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

167 let v0 = constDyn $ cfg ^. textAreaElementConfig_initialValue

171 let v0 = constDyn $ cfg ^. textAreaElementConfig_initialValue

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

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

170

180

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

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

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

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

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

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

81type AttributeMap = Map String String

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)

84buildElement = buildElementNS Nothing

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

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

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

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)

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

92class 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)

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

96 buildElementNS ns elementTag attrs child = do

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

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

113 return $ cfg & elementConfig_modifyAttributes .~ modifyAttrs

114

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)

116buildElementInternal elementTag child cfg = do

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

118 return (_element_raw e, result)

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

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

304 i <- inputElement inputElementConfig

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

306

307−data FileInput t

307+data FileInput d t

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

309+ , _fileInput_element :: RawInputElement d

309 }

310 }

310

311

311data FileInputConfig t

312data FileInputConfig t

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

317 }

318 }

318

319

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

320fileInput :: 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)

321fileInput config = do

322fileInput config = do

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

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

323 dAttrs = insertType <$> _fileInputConfig_attributes config

324 dAttrs = insertType <$> _fileInputConfig_attributes config

324 modifyAttrs <- dynamicAttributesToModifyAttributes dAttrs

325 modifyAttrs <- dynamicAttributesToModifyAttributes dAttrs

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

326+ let elCfg = (def :: ElementConfig EventResult t m)

326− { _elementConfig_modifyAttributes = modifyAttrs

327+ { _elementConfig_modifyAttributes = modifyAttrs

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

328+ , _elementConfig_eventFilters = DMap.singleton Change . EventFilter . GhcjsDomHandler $ \_ -> do

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

329+ return . (,) mempty . GhcjsDomHandler $ \_ -> return . Just $ EventResult ()

329− }

330+ }

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

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

331− let e = castToHTMLInputElement (_element_raw eRaw)

332+ eRaw <- inputElement cfg

333+ let e = _inputElement_raw eRaw

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

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

333 Just files <- Input.getFiles e

335 Just files <- Input.getFiles e

334 len <- FileList.getLength files

336 len <- FileList.getLength files

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

336 dValue <- holdDyn [] eChange

338 dValue <- holdDyn [] eChange

337 return $ FileInput

339 return $ FileInput

338 { _fileInput_value = dValue

340 { _fileInput_value = dValue

341+ , _fileInput_element = e

339 }

342 }

340

343

341data Dropdown t k

344data Dropdown t k

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

527 type Value (TextInput t) = Dynamic t Text

530 type Value (TextInput t) = Dynamic t Text

528 value = _textInput_value

531 value = _textInput_value

529

532

530−instance HasValue (FileInput t) where

533+instance HasValue (FileInput d t) where

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

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

532 value = _fileInput_value

535 value = _fileInput_value

533

536

534instance HasValue (Dropdown t k) where

537instance HasValue (Dropdown t k) where