8290c80 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Improve efficiency of textNode for ImmediateDomBuilderT

8290c80Daniel Haraj10 years ago

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

compare with develop

unifiedsplit

@@ -149,14 +149,14 @@ type Namespace = Text

149

150data TextNodeConfig t

151 = TextNodeConfig { _textNodeConfig_initialContents :: Text

152− , _textNodeConfig_setContents :: Event t Text

152+ , _textNodeConfig_setContents :: Maybe (Event t Text)

153 }

154

155instance (Reflex t) => Default (TextNodeConfig t) where

156 {-# INLINABLE def #-}

157 def = TextNodeConfig

158 { _textNodeConfig_initialContents = mempty

159− , _textNodeConfig_setContents = never

159+ , _textNodeConfig_setContents = Nothing

160 }

161

162data TextNode d t = TextNode

@@ -327,9 +327,21 @@ data SelectElement er d t = SelectElement

327 , _selectElement_raw :: RawSelectElement d

328 }

329

330+makeLensesFor

331+ [("_textNodeConfig_initialContents", "textNodeConfig_initialContents")]

332+ ''TextNodeConfig

333+

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

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

336+textNodeConfig_setContents =

337+ let getter t = case _textNodeConfig_setContents t of

338+ Nothing -> never

339+ Just e -> e

340+ setter t e = t { _textNodeConfig_setContents = Just e }

341+ in lens getter setter

342+

330concat <$> mapM makeLenses

343concat <$> mapM makeLenses

331− [ ''TextNodeConfig

332− , ''ElementConfig

344+ [ ''ElementConfig

333 , ''PlaceholderConfig

345 , ''PlaceholderConfig

334 , ''InputElementConfig

346 , ''InputElementConfig

335 , ''TextAreaElementConfig

347 , ''TextAreaElementConfig

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

@@ -286,9 +286,11 @@ instance er ~ EventResult => Default (GhcjsEventSpec er) where

286instance SupportsImmediateDomBuilder t m => DomBuilder t (ImmediateDomBuilderT t m) where

287 type DomBuilderSpace (ImmediateDomBuilderT t m) = GhcjsDomSpace

288 {-# INLINABLE textNode #-}

289− textNode (TextNodeConfig initialContents eSetContents) = do

289+ textNode (TextNodeConfig initialContents mSetContents) = do

290 n <- textNodeInternal initialContents

291+ case mSetContents of

292+ Nothing -> return ()

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

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

292 return $ TextNode n

294 return $ TextNode n

293 {-# INLINABLE element #-}

295 {-# INLINABLE element #-}

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

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

src/Reflex/Dom/Builder/Static.hs+4−2

@@ -174,11 +174,13 @@ instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (StaticDomB

174instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) where

175 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace

176 {-# INLINABLE textNode #-}

177− textNode (TextNodeConfig initialContents setContents) = StaticDomBuilderT $ do

177+ textNode (TextNodeConfig initialContents mSetContents) = StaticDomBuilderT $ do

178 --TODO: Do not escape quotation marks; see https://stackoverflow.com/questions/25612166/what-characters-must-be-escaped-in-html-5

179 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape

180 let escape = if shouldEscape then fromHtmlEscapedText else byteString . encodeUtf8

181+ modify . (:) =<< case mSetContents of

182+ Nothing -> return (pure (escape initialContents))

181− modify . (:) <=< hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on

183+ Just setContents -> hold (escape initialContents) $ fmapCheap escape setContents --Only because it doesn't get optimized when profiling is on

182 return $ TextNode ()

184 return $ TextNode ()

183 {-# INLINABLE element #-}

185 {-# INLINABLE element #-}

184 element elementTag cfg child = do

186 element elementTag cfg child = do