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

git.iko.soy/reflex-dom

Improve efficiency of textNode for ImmediateDomBuilderT

commit8290c80be5a4c2b36b36bbc32e207758fc093f67 authorDaniel Haraj <dan@obsidian.systems> dateSat 28 Jan 2017, 19:03 (10 years ago) parent9a2e575

3 files changed+24−8

compare with develop

unifiedsplit

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

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

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

149149

150150data TextNodeConfig t

151151 = TextNodeConfig { _textNodeConfig_initialContents :: Text

152− , _textNodeConfig_setContents :: Event t Text

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

153153 }

154154

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

156156 {-# INLINABLE def #-}

157157 def = TextNodeConfig

158158 { _textNodeConfig_initialContents = mempty

159− , _textNodeConfig_setContents = never

159+ , _textNodeConfig_setContents = Nothing

160160 }

161161

162162data TextNode d t = TextNode

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

327327 , _selectElement_raw :: RawSelectElement d

328328 }

329329

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+

330343concat <$> mapM makeLenses

331− [ ''TextNodeConfig

332− , ''ElementConfig

344+ [ ''ElementConfig

333345 , ''PlaceholderConfig

334346 , ''InputElementConfig

335347 , ''TextAreaElementConfig

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

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

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

287287 type DomBuilderSpace (ImmediateDomBuilderT t m) = GhcjsDomSpace

288288 {-# INLINABLE textNode #-}

289− textNode (TextNodeConfig initialContents eSetContents) = do

289+ textNode (TextNodeConfig initialContents mSetContents) = do

290290 n <- textNodeInternal initialContents

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

291+ case mSetContents of

292+ Nothing -> return ()

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

292294 return $ TextNode n

293295 {-# INLINABLE element #-}

294296 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

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

175175 type DomBuilderSpace (StaticDomBuilderT t m) = StaticDomSpace

176176 {-# INLINABLE textNode #-}

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

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

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

179179 shouldEscape <- asks _staticDomBuilderEnv_shouldEscape

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

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

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

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

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

182184 return $ TextNode ()

183185 {-# INLINABLE element #-}

184186 element elementTag cfg child = do