a675795 · reflex-dom · git.iko.soy

git.iko.soy/reflex-dom

on develop help sign in

Ensure that async events are processed after DOM contents are updated; Fix resize detector

a675795Ali Abrar10 years ago

src/Reflex/Dom/Internal.hs+20−15

compare with develop

unifiedsplit

@@ -83,7 +83,7 @@ mainWidgetWithHead' widgets = runWebGUI $ \webView -> withWebViewSingletonMono w

83 Just headFragment <- createDocumentFragment doc

84 Just bodyElement <- getBody doc

85 Just bodyFragment <- createDocumentFragment doc

86− _ <- attachWidget'' $ \events -> do

86+ (events, fc) <- attachWidget'' $ \events -> do

87 let (headWidget, bodyWidget) = widgets

88 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

89 let go :: forall c. Widget () c -> DOM.DocumentFragment -> PerformEventT Spider (SpiderHost Global) c

@@ -96,9 +96,10 @@ mainWidgetWithHead' widgets = runWebGUI $ \webView -> withWebViewSingletonMono w

96 runWithWebView (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) wv

97 rec b <- go (headWidget a) headFragment

98 a <- go (bodyWidget b) bodyFragment

99− return ((), postBuildTriggerRef)

99+ return (events, postBuildTriggerRef)

100 liftIO $ replaceElementContents headElement headFragment

101 liftIO $ replaceElementContents bodyElement bodyFragment

102+ processAsyncEvents events fc

102

103

103replaceElementContents :: DOM.IsElement e => e -> DOM.DocumentFragment -> IO ()

104replaceElementContents :: DOM.IsElement e => e -> DOM.DocumentFragment -> IO ()

104replaceElementContents e df = do

105replaceElementContents e df = do

@@ -111,7 +112,7 @@ attachWidget' :: DOM.IsElement e => e -> WebViewSingleton x -> Widget x a -> IO

111attachWidget' rootElement wv w = do

112attachWidget' rootElement wv w = do

112 Just doc <- getOwnerDocument rootElement

113 Just doc <- getOwnerDocument rootElement

113 Just df <- createDocumentFragment doc

114 Just df <- createDocumentFragment doc

114− result <- attachWidget'' $ \events -> do

115+ ((a, events), fc) <- attachWidget'' $ \events -> do

115 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

116 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef

116 let builderEnv = ImmediateDomBuilderEnv

117 let builderEnv = ImmediateDomBuilderEnv

117 { _immediateDomBuilderEnv_document = toDocument doc

118 { _immediateDomBuilderEnv_document = toDocument doc

@@ -119,9 +120,10 @@ attachWidget' rootElement wv w = do

119 , _immediateDomBuilderEnv_events = events

120 , _immediateDomBuilderEnv_events = events

120 }

121 }

121 a <- runWithWebView (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) wv

122 a <- runWithWebView (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) wv

122− return (a, postBuildTriggerRef)

123+ return ((a, events), postBuildTriggerRef)

123 replaceElementContents rootElement df

124 replaceElementContents rootElement df

125+ processAsyncEvents events fc

124− return result

126+ return (a, fc)

125

127

126type EventChannel = Chan [DSum (TriggerRef Spider) TriggerInvocation]

128type EventChannel = Chan [DSum (TriggerRef Spider) TriggerInvocation]

127

129

@@ -129,22 +131,25 @@ type EventChannel = Chan [DSum (TriggerRef Spider) TriggerInvocation]

129attachWidget'' :: (EventChannel -> PerformEventT Spider (SpiderHost Global) (a, IORef (Maybe (EventTrigger Spider ())))) -> IO (a, FireCommand Spider (SpiderHost Global))

131attachWidget'' :: (EventChannel -> PerformEventT Spider (SpiderHost Global) (a, IORef (Maybe (EventTrigger Spider ())))) -> IO (a, FireCommand Spider (SpiderHost Global))

130attachWidget'' w = do

132attachWidget'' w = do

131 events <- newChan

133 events <- newChan

132− (result, fc@(FireCommand fire)) <- runSpiderHost $ do

134+ (result, fc) <- runSpiderHost $ do

133 ((result, postBuildTriggerRef), fc@(FireCommand fire)) <- hostPerformEventT $ w events

135 ((result, postBuildTriggerRef), fc@(FireCommand fire)) <- hostPerformEventT $ w events

134 mPostBuildTrigger <- readRef postBuildTriggerRef

136 mPostBuildTrigger <- readRef postBuildTriggerRef

135 forM_ mPostBuildTrigger $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()

137 forM_ mPostBuildTrigger $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()

136 return (result, fc)

138 return (result, fc)

137− void $ forkIO $ forever $ do

138− ers <- readChan events

139− _ <- postGUISync $ runSpiderHost $ do

140− mes <- liftIO $ forM ers $ \(TriggerRef er :=> TriggerInvocation a _) -> do

141− me <- readIORef er

142− return $ fmap (\e -> e :=> Identity a) me

143− _ <- fire (catMaybes mes) $ return ()

144− liftIO $ forM_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb

145− return ()

146 return (result, fc)

139 return (result, fc)

147

140

141+processAsyncEvents :: EventChannel -> FireCommand Spider (SpiderHost Global) -> IO ()

142+processAsyncEvents events (FireCommand fire) = void $ forkIO $ forever $ do

143+ ers <- readChan events

144+ _ <- postGUISync $ runSpiderHost $ do

145+ mes <- liftIO $ forM ers $ \(TriggerRef er :=> TriggerInvocation a _) -> do

146+ me <- readIORef er

147+ return $ fmap (\e -> e :=> Identity a) me

148+ _ <- fire (catMaybes mes) $ return ()

149+ liftIO $ forM_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb

150+ return ()

151+

152+

148-- | Run a reflex-dom application inside of an existing DOM element with the given ID

153-- | Run a reflex-dom application inside of an existing DOM element with the given ID

149mainWidgetInElementById :: Text -> (forall x. Widget x ()) -> IO ()

154mainWidgetInElementById :: Text -> (forall x. Widget x ()) -> IO ()

150mainWidgetInElementById eid w = runWebGUI $ \webView -> withWebViewSingleton webView $ \webViewSing -> do

155mainWidgetInElementById eid w = runWebGUI $ \webView -> withWebViewSingleton webView $ \webViewSing -> do

src/Reflex/Dom/Widget/Resize.hs+2−1

@@ -9,6 +9,7 @@ import Reflex.Class

9import Reflex.Dom.Builder.Class

10import Reflex.Dom.Builder.Immediate

11import Reflex.Dom.Class

12+import Reflex.Dom.Time

12import Reflex.Dom.Widget.Basic

13import Reflex.Dom.Widget.Basic

13import Reflex.PerformEvent.Class

14import Reflex.PerformEvent.Class

14import Reflex.PostBuild.Class

15import Reflex.PostBuild.Class

@@ -74,7 +75,7 @@ resizeDetectorWithAttrs attrs w = do

74 if ds == (Just pow, Just poh)

75 if ds == (Just pow, Just poh)

75 then return Nothing

76 then return Nothing

76 else fmap Just reset

77 else fmap Just reset

77− pb <- getPostBuild

78+ pb <- delay 0 =<< getPostBuild

78 expandScroll <- wrapDomEvent (_element_raw expand) (`on` scroll) $ return ()

79 expandScroll <- wrapDomEvent (_element_raw expand) (`on` scroll) $ return ()

79 shrinkScroll <- wrapDomEvent (_element_raw shrink) (`on` scroll) $ return ()

80 shrinkScroll <- wrapDomEvent (_element_raw shrink) (`on` scroll) $ return ()

80 size0 <- performEvent $ fmap (const $ liftIO reset) pb

81 size0 <- performEvent $ fmap (const $ liftIO reset) pb