@@ -121,8 +121,8 @@ type DomCoreWidget x = PostBuildT DomTimeline (WithJSContextSingleton x (Perform
121121{-# INLINABLE runHydrationWidgetWithHeadAndBody #-}
122122runHydrationWidgetWithHeadAndBody
123123 :: JSM ()
124− -> ( (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to head"
125− -> (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to body"
124+ -> ( (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to head" --TODO: test invoking this more than once
125+ -> (forall c. HydrationWidget () c -> FloatingWidget () c) -- "Append to body" --TODO: test invoking this more than once
126126 -> FloatingWidget () ()
127127 )
128128 -> JSM ()
@@ -212,39 +212,48 @@ type Widget x = ImmediateDomBuilderT DomTimeline (DomCoreWidget x)
212212attachWidget :: DOM.IsElement e => e -> JSContextSingleton x -> Widget x a -> JSM a
213213attachWidget rootElement wv w = fst <$> attachWidget' rootElement wv w
214214
215−-- | Warning: `mainWidgetWithHead'` is provided only as performance tweak. It is expected to disappear in future releases.
216−mainWidgetWithHead' :: (a -> Widget () b, b -> Widget () a) -> JSM ()
217−mainWidgetWithHead' widgets = withJSContextSingletonMono $ \jsSing -> do
218− doc <- currentDocumentUnchecked
219− headElement <- getHeadUnchecked doc
220− headFragment <- createDocumentFragment doc
221− bodyElement <- getBodyUnchecked doc
222− bodyFragment <- createDocumentFragment doc
223− hydrationMode <- liftIO $ newIORef HydrationMode_Immediate
224− (events, fc) <- liftIO . attachWidget'' $ \events -> do
225− let (headWidget, bodyWidget) = widgets
215+{-# INLINABLE runImmediateWidgetWithHeadAndBody #-}
216+runImmediateWidgetWithHeadAndBody
217+ :: ( (forall c. Widget () c -> FloatingWidget () c) -- "Append to head"
218+ -> (forall c. Widget () c -> FloatingWidget () c) -- "Append to body"
219+ -> FloatingWidget () ()
220+ )
221+ -> JSM ()
222+runImmediateWidgetWithHeadAndBody app = withJSContextSingletonMono $ \jsSing -> do
223+ globalDoc <- currentDocumentUnchecked
224+ headElement <- getHeadUnchecked globalDoc
225+ bodyElement <- getBodyUnchecked globalDoc
226+ headFragment <- createDocumentFragment globalDoc
227+ bodyFragment <- createDocumentFragment globalDoc
228+ (events, fc) <- liftIO . attachImmediateWidget $ \hydrationMode events -> do
226229 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
227− let go :: forall c. Widget () c -> DOM.DocumentFragment -> PerformEventT DomTimeline DomHost c
228− go w df = do
230+ let go :: forall c. DOM.DocumentFragment -> Widget () c -> FloatingWidget () c
231+ go df w = do
229232 unreadyChildren <- liftIO $ newIORef 0
230233 delayed <- liftIO $ newIORef $ pure ()
231234 let builderEnv = HydrationDomBuilderEnv
232− { _hydrationDomBuilderEnv_document = toDocument doc
235+ { _hydrationDomBuilderEnv_document = globalDoc
233236 , _hydrationDomBuilderEnv_parent = Left $ toNode df
234237 , _hydrationDomBuilderEnv_unreadyChildren = unreadyChildren
235− , _hydrationDomBuilderEnv_commitAction = return () --TODO
238+ , _hydrationDomBuilderEnv_commitAction = pure () --TODO: possibly `replaceElementContents n f`
239+ , _hydrationDomBuilderEnv_hydrationMode = hydrationMode
236240 , _hydrationDomBuilderEnv_switchover = never
237241 , _hydrationDomBuilderEnv_delayed = delayed
238− , _hydrationDomBuilderEnv_hydrationMode = hydrationMode
239242 }
240− runWithJSContextSingleton (runPostBuildT (runHydrationDomBuilderT w builderEnv events) postBuild) jsSing
241− rec b <- go (headWidget a) headFragment
242− a <- go (bodyWidget b) bodyFragment
243+ lift $ runHydrationDomBuilderT w builderEnv events
244+ runWithJSContextSingleton (runPostBuildT (runTriggerEventT (app (go headFragment) (go bodyFragment)) events) postBuild) jsSing
243245 return (events, postBuildTriggerRef)
244246 replaceElementContents headElement headFragment
245247 replaceElementContents bodyElement bodyFragment
246248 liftIO $ processAsyncEvents events fc
247249
250+-- | Warning: `mainWidgetWithHead'` is provided only as performance tweak. It is expected to disappear in future releases.
251+mainWidgetWithHead' :: (a -> Widget () b, b -> Widget () a) -> JSM ()
252+mainWidgetWithHead' (h, b) = runImmediateWidgetWithHeadAndBody $ \appendHead appendBody -> do
253+ rec hOut <- appendHead $ h bOut
254+ bOut <- appendBody $ b hOut
255+ pure ()
256+
248257replaceElementContents :: DOM.IsElement e => e -> DOM.DocumentFragment -> JSM ()
249258replaceElementContents e df = do
250259 setInnerHTML e ("" :: String)
@@ -256,8 +265,7 @@ attachWidget' :: DOM.IsElement e => e -> JSContextSingleton x -> Widget x a -> J
256265attachWidget' rootElement jsSing w = do
257266 doc <- getOwnerDocumentUnchecked rootElement
258267 df <- createDocumentFragment doc
259− hydrationMode <- liftIO $ newIORef HydrationMode_Immediate
260− ((a, events), fc) <- liftIO . attachWidget'' $ \events -> do
268+ ((a, events), fc) <- liftIO . attachImmediateWidget $ \hydrationMode events -> do
261269 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
262270 unreadyChildren <- liftIO $ newIORef 0
263271 delayed <- liftIO $ newIORef $ pure ()
@@ -278,12 +286,18 @@ attachWidget' rootElement jsSing w = do
278286
279287type EventChannel = Chan [DSum (EventTriggerRef DomTimeline) TriggerInvocation]
280288
281−{-# INLINABLE attachWidget'' #-}
282−attachWidget'' :: (EventChannel -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))) -> IO (a, FireCommand DomTimeline DomHost)
283−attachWidget'' w = do
289+{-# INLINABLE attachImmediateWidget #-}
290+attachImmediateWidget
291+ :: ( IORef HydrationMode
292+ -> EventChannel
293+ -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))
294+ )
295+ -> IO (a, FireCommand DomTimeline DomHost)
296+attachImmediateWidget w = do
297+ hydrationMode <- liftIO $ newIORef HydrationMode_Immediate
284298 events <- newChan
285299 runDomHost $ do
286− ((result, postBuildTriggerRef), fc@(FireCommand fire)) <- hostPerformEventT $ w events
300+ ((result, postBuildTriggerRef), fc@(FireCommand fire)) <- hostPerformEventT $ w hydrationMode events
287301 mPostBuildTrigger <- readRef postBuildTriggerRef
288302 forM_ mPostBuildTrigger $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()
289303 return (result, fc)
@@ -325,3 +339,8 @@ runApp' app = withJSContextSingleton $ \jsSing -> do
325339 { _appInput_window = w
326340 }
327341 return ()
342+
343+{-# DEPRECATED attachWidget'' "Use 'attachImmediateWidget . const' instead" #-}
344+{-# INLINABLE attachWidget'' #-}
345+attachWidget'' :: (EventChannel -> PerformEventT DomTimeline DomHost (a, IORef (Maybe (EventTrigger DomTimeline ())))) -> IO (a, FireCommand DomTimeline DomHost)
346+attachWidget'' = attachImmediateWidget . const