@@ -44,6 +44,7 @@ import Control.Exception (try)
4444import Control.Monad
4545import Control.Monad.Except
4646import Control.Monad.Fail (MonadFail)
47+import Control.Lens (view, _1, _2, _3)
4748import Data.ByteString (ByteString)
4849import qualified Data.ByteString.Char8 as BSC8
4950import Data.Default (Default (..))
@@ -295,19 +296,21 @@ renderGhcjsFrontend urlEnc ghcjsWidgets route configs f = do
295296preloadGhcjs :: GhcjsWasmAssets -> FrontendWidgetT r ()
296297preloadGhcjs (GhcjsWasmAssets allJsUrl mWasm) = case mWasm of
297298 Nothing -> elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: allJsUrl) blank
298− Just wasmAssets -> fst (wasmScripts allJsUrl wasmAssets)
299+ Just wasmAssets -> scriptTag $ view _1 (wasmScripts allJsUrl wasmAssets)
299300
300301-- | Load the script from the given URL in a deferred script tag.
301302-- This is the default method.
302303deferredGhcjsScript :: GhcjsWasmAssets -> FrontendWidgetT r ()
303304deferredGhcjsScript (GhcjsWasmAssets allJsUrl mWasm) = case mWasm of
304305 Nothing -> elAttr "script" ("type" =: "text/javascript" <> "src" =: allJsUrl <> "defer" =: "defer") blank
305− Just wasmAssets -> snd (wasmScripts allJsUrl wasmAssets)
306+ Just wasmAssets -> scriptTag $ view _2 (wasmScripts allJsUrl wasmAssets)
306307
307−wasmScripts :: Text -> Text -> (FrontendWidgetT r (), FrontendWidgetT r ())
308−wasmScripts allJsUrl wasmRoot = (script preloadScript, script runJsScript)
308+scriptTag :: DomBuilder t m => Text -> m ()
309+scriptTag t = elAttr "script" ("type" =: "text/javascript") $ text t
310+
311+wasmScripts :: Text -> Text -> (Text, Text, (Int -> Text))
312+wasmScripts allJsUrl wasmRoot = (preloadScript, runJsScript, delayedJsScript)
309313 where
310− script t = elAttr "script" ("type" =: "text/javascript") $ text t
311314 jsaddleJs = wasmRoot <> "/jsaddle_core.js"
312315 interfaceJs = wasmRoot <> "/jsaddle_mainthread_interface.js"
313316 runnerJs = wasmRoot <> "/mainthread_runner.js"
@@ -347,21 +350,43 @@ wasmScripts allJsUrl wasmRoot = (script preloadScript, script runJsScript)
347350 \ add_deferload_tag('" <> runnerJs <> "'); \
348351 \}"
349352
353+ delayedJsScript n =
354+ "var wasmFile = '" <> wasmUrl <> "'; \
355+ \setTimeout(function() { \
356+ \ add_load_tag = function (docSrc) { \
357+ \ var tag = document.createElement('script');\
358+ \ tag.type = 'text/javascript'; \
359+ \ tag.src = docSrc; \
360+ \ document.body.appendChild(tag); \
361+ \ }; \
362+ \ if (typeof(WebAssembly) === 'undefined') { \
363+ \ add_load_tag('" <> allJsUrl <> "'); \
364+ \ } else { \
365+ \ add_load_tag('" <> jsaddleJs <> "'); \
366+ \ add_load_tag('" <> interfaceJs <> "'); \
367+ \ add_load_tag('" <> runnerJs <> "'); \
368+ \ } \
369+ \}, " <> T.pack (show n) <> ");"
370+
350371-- | An all.js script which is loaded after waiting for some time to pass. This
351372-- is useful to ensure any CSS animations on the page can play smoothly before
352373-- blocking the UI thread by running all.js.
353374delayedGhcjsScript
354375 :: Int -- ^ The number of milliseconds to delay loading by
355− -> Text -- ^ URL to GHCJS app JavaScript
376+ -> GhcjsWasmAssets
356377 -> FrontendWidgetT r ()
357−delayedGhcjsScript n allJsUrl = elAttr "script" ("type" =: "text/javascript") $ text $ T.unlines
358− [ "setTimeout(function() {"
359− , " var all_js_script = document.createElement('script');"
360− , " all_js_script.type = 'text/javascript';"
361− , " all_js_script.src = '" <> allJsUrl <> "';"
362− , " document.body.appendChild(all_js_script);"
363− , "}, " <> T.pack (show n) <> ");"
364− ]
378+delayedGhcjsScript n (GhcjsWasmAssets allJsUrl mWasm) = scriptTag scriptToRun
379+ where
380+ scriptToRun = case mWasm of
381+ Nothing -> T.unlines
382+ [ "setTimeout(function() {"
383+ , " var all_js_script = document.createElement('script');"
384+ , " all_js_script.type = 'text/javascript';"
385+ , " all_js_script.src = '" <> allJsUrl <> "';"
386+ , " document.body.appendChild(all_js_script);"
387+ , "}, " <> T.pack (show n) <> ");"
388+ ]
389+ Just wasmAssets -> (view _3 (wasmScripts allJsUrl wasmAssets)) n
365390
366391instance HasCookies Snap where
367392 askCookies = map (\c -> (cookieName c, cookieValue c)) <$> getsRequest rqCookies