@@ -68,13 +68,6 @@ mainWidgetWithCss css w = runWebGUI $ \webView -> withWebViewSingleton webView $
6868 Just body <- getBody doc
6969 attachWidget body webViewSing w
7070
71−{-# INLINABLE mainWidgetFragment #-}
72−mainWidgetFragment :: (forall x. Widget x ()) -> IO ()
73−mainWidgetFragment w = runWebGUI $ \webView -> withWebViewSingleton webView $ \webViewSing -> do
74− Just doc <- fmap DOM.castToHTMLDocument <$> webViewGetDomDocument webView
75− Just body <- getBody doc
76− attachWidgetFragment body webViewSing w
77−
7871type Widget x = PostBuildT Spider (ImmediateDomBuilderT Spider (WithWebView x (PerformEventT Spider (SpiderHost Global)))) --TODO: Make this more abstract --TODO: Put the WithWebView underneath PerformEventT - I think this would perform better
7972
8073{-# INLINABLE attachWidget #-}
@@ -84,38 +77,6 @@ attachWidget rootElement wv w = fst <$> attachWidget' rootElement wv w
8477{-# INLINABLE attachWidget' #-}
8578attachWidget' :: DOM.IsElement e => e -> WebViewSingleton x -> Widget x a -> IO (a, FireCommand Spider (SpiderHost Global))
8679attachWidget' rootElement wv w = do
87− Just doc <- getOwnerDocument rootElement
88− events <- newChan
89− setInnerHTML rootElement $ Just (""::String)
90− (result, fc@(FireCommand fire)) <- runSpiderHost $ do
91− (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
92− let builderEnv = ImmediateDomBuilderEnv
93− { _immediateDomBuilderEnv_document = doc
94− , _immediateDomBuilderEnv_parent = toNode rootElement
95− , _immediateDomBuilderEnv_events = events
96− }
97− results@(_, FireCommand fire) <- hostPerformEventT $ runWithWebView (runImmediateDomBuilderT (runPostBuildT w postBuild) builderEnv) wv
98− mPostBuildTrigger <- readRef postBuildTriggerRef
99− forM_ mPostBuildTrigger $ \postBuildTrigger -> fire [postBuildTrigger :=> Identity ()] $ return ()
100− return results
101− void $ forkIO $ forever $ do
102− ers <- readChan events
103− _ <- postGUISync $ runSpiderHost $ do
104− mes <- liftIO $ forM ers $ \(TriggerRef er :=> TriggerInvocation a _) -> do
105− me <- readIORef er
106− return $ fmap (\e -> e :=> Identity a) me
107− _ <- fire (catMaybes mes) $ return ()
108− liftIO $ forM_ ers $ \(_ :=> TriggerInvocation _ cb) -> cb
109− return ()
110− return (result, fc)
111−
112−{-# INLINABLE attachWidgetFragment #-}
113−attachWidgetFragment :: DOM.IsElement e => e -> WebViewSingleton x -> Widget x a -> IO a
114−attachWidgetFragment rootElement wv w = fst <$> attachWidgetFragment' rootElement wv w
115−
116−{-# INLINABLE attachWidgetFragment' #-}
117−attachWidgetFragment' :: DOM.IsElement e => e -> WebViewSingleton x -> Widget x a -> IO (a, FireCommand Spider (SpiderHost Global))
118−attachWidgetFragment' rootElement wv w = do
11980 Just doc <- getOwnerDocument rootElement
12081 Just df <- createDocumentFragment doc
12182 events <- newChan