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

git.iko.soy/reflex-dom

on develop help sign in

Improve efficiency of element for ImmediateDomBuilderT

7ca4e27Daniel Haraj10 years ago

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

compare with develop

unifiedsplit

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

213data ElementConfig er t m

214 = ElementConfig { _elementConfig_namespace :: Maybe Namespace

215 , _elementConfig_initialAttributes :: Map AttributeName Text

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

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

217 , _elementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

218 }

219

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

297 }

298

299data RawElementConfig er t m = RawElementConfig

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

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

301 , _rawElementConfig_eventSpec :: EventSpec (DomBuilderSpace m) er

302 }

303

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

305 def = RawElementConfig

306− { _rawElementConfig_modifyAttributes = never

306+ { _rawElementConfig_modifyAttributes = Nothing

307 , _rawElementConfig_eventSpec = def

308 }

309

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

328 , _selectElement_raw :: RawSelectElement d

329 }

330

331+concat <$> mapM (uncurry makeLensesWithoutField)

331−makeLensesWithoutField "_textNodeConfig_setContents" ''TextNodeConfig

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

332−makeLensesWithoutField "_inputElementConfig_setValue" ''InputElementConfig

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

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

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

336+ ]

333

337

334-- | 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'.

338-- | 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'.

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

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

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

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

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

350 in lens getter setter

354 in lens getter setter

351

355

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+

352concat <$> mapM makeLenses

374concat <$> mapM makeLenses

353− [ ''ElementConfig

354− , ''PlaceholderConfig

375+ [ ''PlaceholderConfig

355 , ''TextAreaElementConfig

376 , ''TextAreaElementConfig

356 , ''SelectElementConfig

377 , ''SelectElementConfig

357− , ''RawElementConfig

358 ]

378 ]

359

379

360class CanDeleteSelf t a | a -> t where

380class CanDeleteSelf t a | a -> t where

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

390 initialAttributes = selectElementConfig_elementConfig . elementConfig_initialAttributes

410 initialAttributes = selectElementConfig_elementConfig . elementConfig_initialAttributes

391

411

392class ModifyAttributes t a | a -> t where

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

394

414

395instance ModifyAttributes t (ElementConfig er t m) where

415instance ModifyAttributes t (ElementConfig er t m) where

396 {-# INLINABLE modifyAttributes #-}

416 {-# INLINABLE modifyAttributes #-}

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

424 def = ElementConfig

444 def = ElementConfig

425 { _elementConfig_namespace = Nothing

445 { _elementConfig_namespace = Nothing

426 , _elementConfig_initialAttributes = mempty

446 , _elementConfig_initialAttributes = mempty

427− , _elementConfig_modifyAttributes = never

447+ , _elementConfig_modifyAttributes = Nothing

428 , _elementConfig_eventSpec = def

448 , _elementConfig_eventSpec = def

429 }

449 }

430

450

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

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

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

181wrap e cfg = do

182 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

184 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)

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

187 triggerRef <- newIORef Nothing

188 _ <- elementOnEventName en e $ do

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

288 {-# INLINABLE textNode #-}

289 textNode (TextNodeConfig initialContents mSetContents) = do

290 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

294 return $ TextNode n

292 return $ TextNode n

295 {-# INLINABLE element #-}

293 {-# INLINABLE element #-}

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

294 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

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

55disableElementConfig cfg = cfg

56 { _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

58 }

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

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

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

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

290 elementConfig :: ElementConfig CheckboxViewEventResult t m

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

292− { _elementConfig_modifyAttributes = fmap mapKeysToAttributeName modifyAttrs

292+ { _elementConfig_modifyAttributes = Just $ fmap mapKeysToAttributeName modifyAttrs

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

294 , _elementConfig_eventSpec = GhcjsEventSpec

295 { _ghcjsEventSpec_filters = filters