ef8a2f4 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

Merge pull request #128 from reflex-frp/dan-perf

Reduce the number of cache events in the Static Builder and workflows; add instances

commitef8a2f4f714e49528c299af739993ced3cead931 authorRyan Trinkle <ryan.trinkle@gmail.com> dateThu 26 Jan 2017, 16:44 (10 years ago) parente5de808 e7aef60

4 files changed+21−4

compare with develop

unifiedsplit

reflex-dom.cabal+8 src/Foreign/JavaScript/TH.hs+5 src/Reflex/Dom/Builder/Static.hs+3−3 src/Reflex/Dom/Widget/Basic.hs+5−1

reflex-dom.cabal+8

@@ -25,6 +25,11 @@ flag use-reflex-optimizer

2525 default: False

2626 manual: True

2727

28+flag expose-all-unfoldings

29+ description: Build the library with -fexpose-all-unfoldings which can help client code specialize better

30+ default: False

31+ manual: True

32+

2833library

2934 hs-source-dirs: src

3035 build-depends:

@@ -109,6 +114,9 @@ library

109114 other-extensions: TemplateHaskell

110115 ghc-options: -Wall -fwarn-tabs -funbox-strict-fields -O2 -ferror-spans

111116

117+ if flag(expose-all-unfoldings)

118+ ghc-options: -fexpose-all-unfoldings

119+

112120 if flag(use-reflex-optimizer)

113121 ghc-options: -fplugin=Reflex.Optimizer

114122

src/Foreign/JavaScript/TH.hs+5

@@ -22,6 +22,7 @@ module Foreign.JavaScript.TH ( module Foreign.JavaScript.TH

2222

2323import Reflex.Class

2424import Reflex.DynamicWriter

25+import Reflex.EventWriter

2526import Reflex.Host.Class

2627import Reflex.PerformEvent.Base

2728import Reflex.PerformEvent.Class

@@ -110,6 +111,10 @@ instance HasWebView m => HasWebView (DynamicWriterT t w m) where

110111 type WebViewPhantom (DynamicWriterT t w m) = WebViewPhantom m

111112 askWebView = lift askWebView

112113

114+instance HasWebView m => HasWebView (EventWriterT t w m) where

115+ type WebViewPhantom (EventWriterT t w m) = WebViewPhantom m

116+ askWebView = lift askWebView

117+

113118instance HasWebView m => HasWebView (RequesterT t request response m) where

114119 type WebViewPhantom (RequesterT t request response m) = WebViewPhantom m

115120 askWebView = lift askWebView

src/Reflex/Dom/Builder/Static.hs+3−3

@@ -147,9 +147,9 @@ instance (Reflex t, MonadAdjust t m, MonadHold t m) => MonadAdjust t (StaticDomB

147147 runWithReplace a0 a' = do

148148 e <- StaticDomBuilderT ask

149149 (result0, result') <- lift $ runWithReplace (runStaticDomBuilderT a0 e) (flip runStaticDomBuilderT e <$> a')

150− o <- hold (snd result0) $ snd <$> result'

150+ o <- hold (snd result0) $ fmapCheap snd result'

151151 StaticDomBuilderT $ modify $ (:) $ join o

152− return (fst result0, fst <$> result')

152+ return (fst result0, fmapCheap fst result')

153153 sequenceDMapWithAdjust (dm0 :: DMap k (StaticDomBuilderT t m)) dm' = do

154154 e <- StaticDomBuilderT ask

155155 let loweredDm0 = mapKeyValuePairsMonotonic (\(k :=> v) -> WrapArg k :=> fmap swap (runStaticDomBuilderT v e)) dm0

@@ -178,7 +178,7 @@ instance SupportsStaticDomBuilder t m => DomBuilder t (StaticDomBuilderT t m) wh

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) $ fmap escape setContents

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

182182 return $ TextNode ()

183183 {-# INLINABLE element #-}

184184 element elementTag cfg child = do

src/Reflex/Dom/Widget/Basic.hs+5−1

@@ -71,6 +71,7 @@ module Reflex.Dom.Widget.Basic

7171 , workflow

7272 , workflowView

7373 , mapWorkflow

74+ , mapWorkflowCheap

7475

7576 -- * Tables and Lists

7677 , tableDynAttr

@@ -160,7 +161,7 @@ button t = do

160161dyn :: (DomBuilder t m, PostBuild t m) => Dynamic t (m a) -> m (Event t a)

161162dyn child = do

162163 postBuild <- getPostBuild

163− let newChild = leftmost [updated child, tag (current child) postBuild]

164+ let newChild = leftmost [updated child, tagCheap (current child) postBuild]

164165 snd <$> widgetHoldInternal (return ()) newChild

165166

166167-- | Given an initial widget and an Event of widget-creating actions, create a widget that is recreated whenever the Event fires.

@@ -423,6 +424,9 @@ workflowView w0 = do

423424mapWorkflow :: (DomBuilder t m) => (a -> b) -> Workflow t m a -> Workflow t m b

424425mapWorkflow f (Workflow x) = Workflow (fmap (f *** fmap (mapWorkflow f)) x)

425426

427+mapWorkflowCheap :: (DomBuilder t m) => (a -> b) -> Workflow t m a -> Workflow t m b

428+mapWorkflowCheap f (Workflow x) = Workflow (fmap (f *** fmapCheap (mapWorkflowCheap f)) x)

429+

426430-- | A widget to display a table with static columns and dynamic rows.

427431tableDynAttr :: forall t m r k v. (Ord k, DomBuilder t m, MonadHold t m, PostBuild t m, MonadFix m)

428432 => Text -- ^ Class applied to <table> element