@@ -15,7 +15,6 @@ module Reflex.Dom.Internal where
1515
1616import Prelude hiding (concat, mapM, mapM_, sequence, sequence_)
1717
18−import qualified Reflex as R
1918import Reflex.Dom.Builder.Immediate
2019import Reflex.Dom.Class
2120import Reflex.Dom.Internal.Foreign
@@ -78,37 +77,52 @@ attachWidget rootElement wv w = fst <$> attachWidget' rootElement wv w
7877
7978-- | Warning: `mainWidgetWithHead'` is provided only as performance tweak. It is expected to disappear in future releases.
8079mainWidgetWithHead' :: (a -> Widget () b, b -> Widget () a) -> IO ()
81−mainWidgetWithHead' widgets = runWebGUI $ \webView -> withWebViewSingletonMono webView $ \wv -> fmap fst $ attachWidget'' $ \events -> do
82− let (headWidget, bodyWidget) = widgets
80+mainWidgetWithHead' widgets = runWebGUI $ \webView -> withWebViewSingletonMono webView $ \wv -> do
8381 Just doc <- liftIO $ fmap DOM.castToHTMLDocument <$> webViewGetDomDocument webView
8482 Just headElement <- getHead doc
83+ Just headFragment <- createDocumentFragment doc
8584 Just bodyElement <- getBody doc
86− (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
87− rec b <- unsafeReplaceElementContentsWithWidget events postBuild headElement wv $ headWidget a
88− a <- unsafeReplaceElementContentsWithWidget events postBuild bodyElement wv $ bodyWidget b
89− return ((), postBuildTriggerRef)
85+ Just bodyFragment <- createDocumentFragment doc
86+ _ <- 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
90+ go w df = do
91+ let builderEnv = ImmediateDomBuilderEnv
92+ { _immediateDomBuilderEnv_document = toDocument doc
93+ , _immediateDomBuilderEnv_parent = toNode df
94+ , _immediateDomBuilderEnv_events = events
95+ }
96+ runWithWebView (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) wv
97+ rec b <- go (headWidget a) headFragment
98+ a <- go (bodyWidget b) bodyFragment
99+ return ((), postBuildTriggerRef)
100+ liftIO $ replaceElementContents headElement headFragment
101+ liftIO $ replaceElementContents bodyElement bodyFragment
102+
103+replaceElementContents :: DOM.IsElement e => e -> DOM.DocumentFragment -> IO ()
104+replaceElementContents e df = do
105+ setInnerHTML e $ Just ("" :: String)
106+ _ <- appendChild e $ Just df
107+ return ()
90108
91−unsafeReplaceElementContentsWithWidget :: DOM.IsElement e => EventChannel -> R.Event Spider () -> e -> WebViewSingleton x -> Widget x a -> PerformEventT Spider (SpiderHost Global) a
92−unsafeReplaceElementContentsWithWidget events postBuild rootElement wv w = do
109+{-# INLINABLE attachWidget' #-}
110+attachWidget' :: DOM.IsElement e => e -> WebViewSingleton x -> Widget x a -> IO (a, FireCommand Spider (SpiderHost Global))
111+attachWidget' rootElement wv w = do
93112 Just doc <- getOwnerDocument rootElement
94113 Just df <- createDocumentFragment doc
95− let builderEnv = ImmediateDomBuilderEnv
96− { _immediateDomBuilderEnv_document = doc
97− , _immediateDomBuilderEnv_parent = toNode df
98− , _immediateDomBuilderEnv_events = events
99− }
100− result <- runWithWebView (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) wv
101− setInnerHTML rootElement $ Just ("" :: String)
102− _ <- appendChild rootElement $ Just df
114+ result <- attachWidget'' $ \events -> do
115+ (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
116+ let builderEnv = ImmediateDomBuilderEnv
117+ { _immediateDomBuilderEnv_document = toDocument doc
118+ , _immediateDomBuilderEnv_parent = toNode df
119+ , _immediateDomBuilderEnv_events = events
120+ }
121+ a <- runWithWebView (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) wv
122+ return (a, postBuildTriggerRef)
123+ replaceElementContents rootElement df
103124 return result
104125
105−{-# INLINABLE attachWidget' #-}
106−attachWidget' :: DOM.IsElement e => e -> WebViewSingleton x -> Widget x a -> IO (a, FireCommand Spider (SpiderHost Global))
107−attachWidget' rootElement wv w = attachWidget'' $ \events -> do
108− (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
109− result <- unsafeReplaceElementContentsWithWidget events postBuild rootElement wv w
110− return (result, postBuildTriggerRef)
111−
112126type EventChannel = Chan [DSum (TriggerRef Spider) TriggerInvocation]
113127
114128{-# INLINABLE attachWidget'' #-}