2a473ae · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Add dynamicAttributesToModifyAttributesWithInitial

commit2a473aed0f28463c2cdbdf20cb50b37f980b757f authorAli Abrar <aliabrar@gmail.com> dateTue 30 Aug 2016, 17:52 (10 years ago) parent2b52a41

4 files changed+22−14

compare with develop

unifiedsplit

src/Reflex/Dom/Builder/Class.hs+3 src/Reflex/Dom/Old.hs+1−1 src/Reflex/Dom/Widget/Basic.hs+11−6 src/Reflex/Dom/Widget/Input.hs+7−7

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

@@ -166,6 +166,9 @@ data TextNode d t = TextNode

166166

167167data AttributeName = AttributeName !(Maybe Namespace) !Text deriving (Show, Read, Eq, Ord)

168168

169+mapKeysToAttributeName :: Map Text v -> Map AttributeName v

170+mapKeysToAttributeName = Map.mapKeysMonotonic (AttributeName Nothing)

171+

169172-- | By default, AttributeNames are unnamespaced

170173instance IsString AttributeName where

171174 fromString = AttributeName Nothing . fromString

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

@@ -145,7 +145,7 @@ instance PostBuild t m => Attributes m (Dynamic t (Map Text Text)) t where

145145addDynamicAttributes :: PostBuild t m => Dynamic t (Map Text Text) -> ElementConfig er t m -> m (ElementConfig er t m)

146146addDynamicAttributes attrs cfg = do

147147 modifyAttrs <- dynamicAttributesToModifyAttributes attrs

148− return $ cfg & elementConfig_modifyAttributes .~ modifyAttrs

148+ return $ cfg & elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

149149

150150buildElementCommon :: MonadWidget t m => Text -> m a -> ElementConfig er t m -> m (Element er (DomBuilderSpace m) t, a)

151151buildElementCommon elementTag child cfg = element elementTag cfg child

src/Reflex/Dom/Widget/Basic.hs+11−6

@@ -262,19 +262,24 @@ elDynAttrNS' mns elementTag attrs child = do

262262 modifyAttrs <- dynamicAttributesToModifyAttributes attrs

263263 let cfg = def

264264 & elementConfig_namespace .~ mns

265− & modifyAttributes .~ modifyAttrs

265+ & modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

266266 element elementTag cfg child

267267

268−dynamicAttributesToModifyAttributes :: PostBuild t m => Dynamic t (Map Text Text) -> m (Event t (Map AttributeName (Maybe Text)))

269−dynamicAttributesToModifyAttributes d = do

268+dynamicAttributesToModifyAttributes :: (Ord k, PostBuild t m) => Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))

269+dynamicAttributesToModifyAttributes = dynamicAttributesToModifyAttributesWithInitial mempty

270+

271+dynamicAttributesToModifyAttributesWithInitial :: (Ord k, PostBuild t m) => Map k Text -> Dynamic t (Map k Text) -> m (Event t (Map k (Maybe Text)))

272+dynamicAttributesToModifyAttributesWithInitial attrs0 d = do

270273 postBuild <- getPostBuild

271274 let modificationsNeeded = flip pushAlways (align postBuild $ updated d) $ \case

272− This () -> fmap (fmap Just) $ sample $ current d

273− These () new -> return $ fmap Just new

275+ This () -> do

276+ new <- sample $ current d

277+ return $ diffMap attrs0 new

278+ These () new -> return $ diffMap attrs0 new

274279 That new -> do

275280 old <- sample $ current d

276281 return $ diffMap old new

277− return $ Map.fromList . fmap (first (AttributeName Nothing)) . Map.toList <$> modificationsNeeded

282+ return modificationsNeeded

278283

279284--------------------------------------------------------------------------------

280285-- Copied and pasted from Reflex.Widget.Class

src/Reflex/Dom/Widget/Input.hs+7−7

@@ -90,7 +90,7 @@ textInput (TextInputConfig inputType initial eSetValue dAttrs) = do

9090 i <- inputElement $ def

9191 & inputElementConfig_initialValue .~ initial

9292 & inputElementConfig_setValue .~ eSetValue

93− & inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ modifyAttrs

93+ & inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

9494 return $ TextInput

9595 { _textInput_value = _inputElement_value i

9696 , _textInput_input = _inputElement_input i

@@ -140,7 +140,7 @@ rangeInput (RangeInputConfig initial eSetValue dAttrs) = do

140140 i <- inputElement $ def

141141 & inputElementConfig_initialValue .~ (T.pack . show $ initial)

142142 & inputElementConfig_setValue .~ (T.pack . show <$> eSetValue)

143− & inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ modifyAttrs

143+ & inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

144144 return $ RangeInput

145145 { _rangeInput_value = read . T.unpack <$> _inputElement_value i

146146 , _rangeInput_input = read . T.unpack <$> _inputElement_input i

@@ -177,7 +177,7 @@ textArea (TextAreaConfig initial eSet attrs) = do

177177 i <- textAreaElement $ def

178178 & textAreaElementConfig_initialValue .~ initial

179179 & textAreaElementConfig_setValue .~ eSet

180− & textAreaElementConfig_elementConfig . elementConfig_modifyAttributes .~ modifyAttrs

180+ & textAreaElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

181181 return $ TextArea

182182 { _textArea_value = _textAreaElement_value i

183183 , _textArea_input = _textAreaElement_input i

@@ -214,7 +214,7 @@ checkbox checked config = do

214214 & inputElementConfig_initialChecked .~ checked

215215 & inputElementConfig_setChecked .~ _checkboxConfig_setValue config

216216 & inputElementConfig_elementConfig . elementConfig_initialAttributes .~ Map.mapKeys (AttributeName Nothing) permanentAttrs

217− & inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ modifyAttrs

217+ & inputElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

218218 return $ Checkbox

219219 { _checkbox_value = _inputElement_checked i

220220 , _checkbox_change = _inputElement_checkedChange i

@@ -289,7 +289,7 @@ checkboxView dAttrs dValue = do

289289 return $ (,) preventDefault $ return $ Just $ CheckboxViewEventResult b

290290 elementConfig :: ElementConfig CheckboxViewEventResult t m

291291 elementConfig = (def :: ElementConfig EventResult t m)

292− { _elementConfig_modifyAttributes = modifyAttrs

292+ { _elementConfig_modifyAttributes = fmap mapKeysToAttributeName modifyAttrs

293293 , _elementConfig_initialAttributes = Map.mapKeys (AttributeName Nothing) permanentAttrs

294294 , _elementConfig_eventSpec = GhcjsEventSpec

295295 { _ghcjsEventSpec_filters = filters

@@ -330,7 +330,7 @@ fileInput config = do

330330 let filters = DMap.singleton Change . GhcjsEventFilter $ \_ -> do

331331 return . (,) mempty $ return . Just $ EventResult ()

332332 elCfg = (def :: ElementConfig EventResult t m)

333− & modifyAttributes .~ modifyAttrs

333+ & modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

334334 & elementConfig_eventSpec . ghcjsEventSpec_filters .~ filters

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

336336 eRaw <- inputElement cfg

@@ -427,7 +427,7 @@ dropdown k0 options (DropdownConfig setK attrs) = do

427427 in (Map.fromList $ map snd xs, Bimap.fromList $ map fst xs)

428428 modifyAttrs <- dynamicAttributesToModifyAttributes attrs

429429 let cfg = def

430− & selectElementConfig_elementConfig . elementConfig_modifyAttributes .~ modifyAttrs

430+ & selectElementConfig_elementConfig . elementConfig_modifyAttributes .~ fmap mapKeysToAttributeName modifyAttrs

431431 & selectElementConfig_setValue .~ fmap (T.pack . show) (attachPromptlyDynWithMaybe (flip Bimap.lookupR) ixKeys setK)

432432 (eRaw, _) <- selectElement cfg $ listWithKey indexedOptions $ \(ix, k) v -> do

433433 let optionAttrs = fmap (\dk -> "value" =: T.pack (show ix) <> if dk == k then "selected" =: "selected" else mempty) defaultKey