7ca4e27 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Improve efficiency of element for ImmediateDomBuilderT

commit7ca4e2702dd6b8dd04f5f210b54118121a7ec9b6 authorDaniel Haraj <dan@obsidian.systems> dateSat 28 Jan 2017, 20:12 (10 years ago) parente2ff6e8

4 files changed+35−17

compare with develop

unifiedsplit

src/Reflex/Dom/Builder/Class.hs+30−10 src/Reflex/Dom/Builder/Immediate.hs+3−5 src/Reflex/Dom/Builder/InputDisabled.hs+1−1 src/Reflex/Dom/Widget/Input.hs+1−1

src/Reflex/Dom/Builder/Class.hs+30−10

@@ -213,7 +213,7 @@ stopPropagation = mempty { _eventFlags_propagation = Propagation_Stop }

213213data ElementConfig er t m

214214 = ElementConfig { _elementConfig_namespace :: Maybe Namespace

215215 , _elementConfig_initialAttributes :: Map AttributeName Text

216− , _elementConfig_modifyAttributes :: Event t (Map AttributeName (Maybe Text))

216+ , _elementConfig_modifyAttributes :: Maybe (Event t (Map AttributeName (Maybe Text)))

217217 , _elementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

218218 }

219219

@@ -297,13 +297,13 @@ extractRawElementConfig cfg = RawElementConfig

297297 }

298298

299299data RawElementConfig er t m = RawElementConfig

300− { _rawElementConfig_modifyAttributes :: Event t (Map AttributeName (Maybe Text))

300+ { _rawElementConfig_modifyAttributes :: Maybe (Event t (Map AttributeName (Maybe Text)))

301301 , _rawElementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

302302 }

303303

304304instance (Reflex t, DomSpace (DomBuilderSpace m)) => Default (RawElementConfig EventResult t m) where

305305 def = RawElementConfig

306− { _rawElementConfig_modifyAttributes = never

306+ { _rawElementConfig_modifyAttributes = Nothing

307307 , _rawElementConfig_eventSpec = def

308308 }

309309

@@ -328,8 +328,12 @@ data SelectElement er d t = SelectElement

328328 , _selectElement_raw :: RawSelectElement d

329329 }

330330

331−makeLensesWithoutField "_textNodeConfig_setContents" ''TextNodeConfig

332−makeLensesWithoutField "_inputElementConfig_setValue" ''InputElementConfig

331+concat <$> mapM (uncurry makeLensesWithoutField)

332+ [ ("_textNodeConfig_setContents", ''TextNodeConfig)

333+ , ("_inputElementConfig_setValue", ''InputElementConfig)

334+ , ("_rawElementConfig_modifyAttributes", ''RawElementConfig)

335+ , ("_elementConfig_modifyAttributes", ''ElementConfig)

336+ ]

333337

334338-- | This lens is technically illegal. The implementation of 'TextNodeConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'TextNodeConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

335339textNodeConfig_setContents :: Reflex t => Lens (TextNodeConfig t) (TextNodeConfig t) (Event t Text) (Event t Text)

@@ -349,12 +353,28 @@ inputElementConfig_setValue =

349353 setter t e = t { _inputElementConfig_setValue = Just e }

350354 in lens getter setter

351355

356+-- | This lens is technically illegal. The implementation of 'RawElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'RawElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

357+rawElementConfig_modifyAttributes :: Reflex t => Lens (RawElementConfig er t m) (RawElementConfig er t m) (Event t (Map AttributeName (Maybe Text))) (Event t (Map AttributeName (Maybe Text)))

358+rawElementConfig_modifyAttributes =

359+ let getter t = case _rawElementConfig_modifyAttributes t of

360+ Nothing -> never

361+ Just e -> e

362+ setter t e = t { _rawElementConfig_modifyAttributes = Just e }

363+ in lens getter setter

364+

365+-- | This lens is technically illegal. The implementation of 'RawElementConfig' uses a 'Maybe' under the hood for efficiency reasons. However, always interacting with 'RawElementConfig' via lenses will always behave correctly, and if you pattern match on it, you should always treat 'Nothing' as 'never'.

366+elementConfig_modifyAttributes :: Reflex t => Lens (ElementConfig er t m) (ElementConfig er t m) (Event t (Map AttributeName (Maybe Text))) (Event t (Map AttributeName (Maybe Text)))

367+elementConfig_modifyAttributes =

368+ let getter t = case _elementConfig_modifyAttributes t of

369+ Nothing -> never

370+ Just e -> e

371+ setter t e = t { _elementConfig_modifyAttributes = Just e }

372+ in lens getter setter

373+

352374concat <$> mapM makeLenses

353− [ ''ElementConfig

354− , ''PlaceholderConfig

375+ [ ''PlaceholderConfig

355376 , ''TextAreaElementConfig

356377 , ''SelectElementConfig

357− , ''RawElementConfig

358378 ]

359379

360380class CanDeleteSelf t a | a -> t where

@@ -390,7 +410,7 @@ instance InitialAttributes (SelectElementConfig er t m) where

390410 initialAttributes = selectElementConfig_elementConfig . elementConfig_initialAttributes

391411

392412class ModifyAttributes t a | a -> t where

393− modifyAttributes :: Lens' a (Event t (Map AttributeName (Maybe Text)))

413+ modifyAttributes :: Reflex t => Lens' a (Event t (Map AttributeName (Maybe Text)))

394414

395415instance ModifyAttributes t (ElementConfig er t m) where

396416 {-# INLINABLE modifyAttributes #-}

@@ -424,7 +444,7 @@ instance (Reflex t, er ~ EventResult, DomBuilder t m) => Default (ElementConfig

424444 def = ElementConfig

425445 { _elementConfig_namespace = Nothing

426446 , _elementConfig_initialAttributes = mempty

427− , _elementConfig_modifyAttributes = never

447+ , _elementConfig_modifyAttributes = Nothing

428448 , _elementConfig_eventSpec = def

429449 }

430450

src/Reflex/Dom/Builder/Immediate.hs+3−5

@@ -180,9 +180,9 @@ newtype EventFilterTriggerRef t er (en :: EventTag) = EventFilterTriggerRef (IOR

180180wrap :: forall m er t. SupportsImmediateDomBuilder t m => RawElement GhcjsDomSpace -> RawElementConfig er t (ImmediateDomBuilderT t m) -> ImmediateDomBuilderT t m (Element er GhcjsDomSpace t)

181181wrap e cfg = do

182182 events <- askEvents

183− lift $ performEvent_ $ ffor (cfg ^. modifyAttributes) $ imapM_ $ \(AttributeName mAttrNamespace n) mv -> case mAttrNamespace of

183+ mapM_ (performEvent_ . fmap (imapM_ $ \(AttributeName mAttrNamespace n) mv -> case mAttrNamespace of

184184 Nothing -> maybe (removeAttribute e n) (setAttribute e n) mv

185− Just ns -> maybe (removeAttributeNS e (Just ns) n) (setAttributeNS e (Just ns) n) mv

185+ Just ns -> maybe (removeAttributeNS e (Just ns) n) (setAttributeNS e (Just ns) n) mv)) (_rawElementConfig_modifyAttributes cfg)

186186 eventTriggerRefs :: DMap EventName (EventFilterTriggerRef t er) <- liftIO $ fmap DMap.fromList $ forM (DMap.toList $ _ghcjsEventSpec_filters $ _rawElementConfig_eventSpec cfg) $ \(en :=> GhcjsEventFilter f) -> do

187187 triggerRef <- newIORef Nothing

188188 _ <- elementOnEventName en e $ do

@@ -288,9 +288,7 @@ instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t

288288 {-# INLINABLE textNode #-}

289289 textNode (TextNodeConfig initialContents mSetContents) = do

290290 n <- textNodeInternal initialContents

291− case mSetContents of

292− Nothing -> return ()

293− Just eSetContents -> lift $ performEvent_ $ ffor eSetContents $ \t -> setNodeValue n (Just t)

291+ mapM_ (lift . performEvent_ . fmap (\t -> setNodeValue n (Just t))) mSetContents

294292 return $ TextNode n

295293 {-# INLINABLE element #-}

296294 element elementTag cfg child = fst <$> makeElement elementTag cfg child

src/Reflex/Dom/Builder/InputDisabled.hs+1−1

@@ -54,7 +54,7 @@ instance PrimMonad m => PrimMonad (InputDisabledT m) where

5454disableElementConfig :: Reflex t => ElementConfig er t m -> ElementConfig er t m

5555disableElementConfig cfg = cfg

5656 { _elementConfig_initialAttributes = Map.insert "disabled" "disabled" $ _elementConfig_initialAttributes cfg

57− , _elementConfig_modifyAttributes = Map.delete "disabled" <$> _elementConfig_modifyAttributes cfg

57+ , _elementConfig_modifyAttributes = fmap (Map.delete "disabled") <$> _elementConfig_modifyAttributes cfg

5858 }

5959

6060instance PostBuild t m => PostBuild t (InputDisabledT m) where

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

@@ -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 = fmap mapKeysToAttributeName modifyAttrs

292+ { _elementConfig_modifyAttributes = Just $ fmap mapKeysToAttributeName modifyAttrs

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

294294 , _elementConfig_eventSpec = GhcjsEventSpec

295295 { _ghcjsEventSpec_filters = filters