@@ -20,6 +20,7 @@ module Obelisk.Backend
2020 , runBackendWith
2121 -- * Configuration of backend
2222 , GhcjsWidgets(..)
23+ , GhcjsWasmAssets(..)
2324 , defaultGhcjsWidgets
2425 -- * all.js script loading functions
2526 , deferredGhcjsScript
@@ -39,6 +40,7 @@ module Obelisk.Backend
3940 , getPublicConfigs
4041 ) where
4142
43+import Control.Exception (try)
4244import Control.Monad
4345import Control.Monad.Except
4446import Control.Monad.Fail (MonadFail)
@@ -46,6 +48,7 @@ import Data.ByteString (ByteString)
4648import qualified Data.ByteString.Char8 as BSC8
4749import Data.Default (Default (..))
4850import Data.Dependent.Sum
51+import Data.Either (isRight)
4952import Data.Functor.Identity
5053import Data.Map (Map)
5154import qualified Data.Map as Map
@@ -63,6 +66,7 @@ import Snap (MonadSnap, Snap, commandLineConfig, defaultConfig, getsRequest, htt
6366 , rqPathInfo, rqQueryString, setContentType, writeBS, writeText
6467 , rqCookies, Cookie(..) , setHeader)
6568import Snap.Internal.Http.Server.Config (Config (accessLog, errorLog), ConfigLog (ConfigIoLog))
69+import System.FilePath ((</>))
6670import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
6771
6872data Backend backendRoute frontendRoute = Backend
@@ -73,8 +77,9 @@ data Backend backendRoute frontendRoute = Backend
7377data BackendConfig frontendRoute = BackendConfig
7478 { _backendConfig_runSnap :: !(Snap () -> IO ()) -- ^ Function to run the snap server
7579 , _backendConfig_staticAssets :: !StaticAssets -- ^ Static assets
76− , _backendConfig_ghcjsWidgets :: !(GhcjsWidgets (Text -> FrontendWidgetT (R frontendRoute) ()))
77− -- ^ Given the URL of all.js, return the widgets which are responsible for
80+ , _backendConfig_ghcjsAssets :: !StaticAssets -- ^ Frontend ghcjs (and wasm) assets
81+ , _backendConfig_ghcjsWidgets :: !(GhcjsWidgets (GhcjsWasmAssets -> FrontendWidgetT (R frontendRoute) ()))
82+ -- ^ Given the URL of all.js and wasm files, return the widgets which are responsible for
7883 -- loading the script.
7984 } deriving (Generic)
8085
@@ -92,10 +97,14 @@ data GhcjsWidgets a = GhcjsWidgets
9297 -- ^ A script widget, placed in the document body
9398 } deriving (Functor, Generic)
9499
100+data GhcjsWasmAssets = GhcjsWasmAssets
101+ { _ghcjsWasmAssets_allJs :: Text
102+ , _ghcjsWasmAssets_wasmPathRoot :: Maybe Text
103+ }
95104
96105-- | Given the URL of all.js, return the widgets which are responsible for
97106-- loading the script. Defaults to 'preloadGhcjs' and 'deferredGhcjsScript'.
98−defaultGhcjsWidgets :: GhcjsWidgets (Text -> FrontendWidgetT r ())
107+defaultGhcjsWidgets :: GhcjsWidgets (GhcjsWasmAssets -> FrontendWidgetT r ())
99108defaultGhcjsWidgets = GhcjsWidgets
100109 { _ghcjsWidgets_preload = preloadGhcjs
101110 , _ghcjsWidgets_script = deferredGhcjsScript
@@ -132,6 +141,9 @@ defaultStaticAssets = StaticAssets
132141 , _staticAssets_unprocessed = "static"
133142 }
134143
144+-- This has both ghcjs and wasm assets.
145+-- The 'unprocessed' is a fallback path, and in case of wasm is invalid (does not contain wasm files)
146+-- For the standard obelisk deployment the unprocessed path would not be used.
135147defaultFrontendGhcjsAssets :: StaticAssets
136148defaultFrontendGhcjsAssets = StaticAssets
137149 { _staticAssets_processed = "frontend.jsexe.assets"
@@ -167,6 +179,10 @@ renderAllJsPath :: Encoder Identity Identity (R (FullRoute a b)) PageName -> Tex
167179renderAllJsPath validFullEncoder =
168180 renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_Resource ResourceRoute_Ghcjs) :/ ["all.js"]
169181
182+renderWasmPathRoot :: Encoder Identity Identity (R (FullRoute a b)) PageName -> Text
183+renderWasmPathRoot validFullEncoder =
184+ renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_Resource ResourceRoute_Ghcjs) :/ []
185+
170186serveObeliskApp
171187 :: (MonadSnap m, HasCookies m, MonadFail m)
172188 => (R appRoute -> Text)
@@ -221,7 +237,7 @@ serveGhcjsApp urlEnc ghcjsWidgets app config = \case
221237
222238-- | Default obelisk backend configuration.
223239defaultBackendConfig :: BackendConfig frontendRoute
224−defaultBackendConfig = BackendConfig runSnapWithCommandLineArgs defaultStaticAssets defaultGhcjsWidgets
240+defaultBackendConfig = BackendConfig runSnapWithCommandLineArgs defaultStaticAssets defaultFrontendGhcjsAssets defaultGhcjsWidgets
225241
226242-- | Run an obelisk backend with the default configuration.
227243runBackend :: Backend backendRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()
@@ -233,21 +249,34 @@ runBackendWith
233249 -> Backend backendRoute frontendRoute
234250 -> Frontend (R frontendRoute)
235251 -> IO ()
236−runBackendWith (BackendConfig runSnap staticAssets ghcjsWidgets) backend frontend = case checkEncoder $ _backend_routeEncoder backend of
252+runBackendWith (BackendConfig runSnap staticAssets ghcjsAssets ghcjsWidgets) backend frontend = case checkEncoder $ _backend_routeEncoder backend of
237253 Left e -> fail $ "backend error:\n" <> T.unpack e
238254 Right validFullEncoder -> do
239255 publicConfigs <- getPublicConfigs
256+ enableWasm <- checkWasmFile
240257 _backend_run backend $ \serveRoute ->
241258 runSnap $
242259 getRouteWith validFullEncoder >>= \case
243260 Identity r -> case r of
244261 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a
245262 FullRoute_Frontend obeliskRoute :/ a ->
246− serveDefaultObeliskApp routeToUrl (($ allJsUrl) <$> ghcjsWidgets) (serveStaticAssets staticAssets) frontend publicConfigs $
263+ serveObeliskApp routeToUrl widgets (serveStaticAssets staticAssets) frontendApp publicConfigs $
247264 obeliskRoute :/ a
248265 where
249266 routeToUrl (k :/ v) = renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_App k) :/ v
250267 allJsUrl = renderAllJsPath validFullEncoder
268+ mWasmUrls = if enableWasm then Just (renderWasmPathRoot validFullEncoder) else Nothing
269+ widgets = ($ GhcjsWasmAssets allJsUrl mWasmUrls) <$> ghcjsWidgets
270+ frontendApp = GhcjsApp
271+ { _ghcjsApp_compiled = ghcjsAssets
272+ , _ghcjsApp_value = frontend
273+ }
274+ where
275+ checkWasmFile = do
276+ let base = _staticAssets_processed ghcjsAssets
277+ p = "frontend.wasm"
278+ assetType :: (Either IOError ByteString) <- liftIO $ try $ BSC8.readFile $ base </> p </> "type"
279+ pure $ isRight assetType
251280
252281renderGhcjsFrontend
253282 :: (MonadSnap m, HasCookies m)
@@ -263,13 +292,60 @@ renderGhcjsFrontend urlEnc ghcjsWidgets route configs f = do
263292
264293-- | Preload all.js in a link tag.
265294-- This is the default preload method.
266−preloadGhcjs :: Text -> FrontendWidgetT r ()
267−preloadGhcjs allJsUrl = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: allJsUrl) blank
295+preloadGhcjs :: GhcjsWasmAssets -> FrontendWidgetT r ()
296+preloadGhcjs (GhcjsWasmAssets allJsUrl mWasm) = case mWasm of
297+ Nothing -> elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: allJsUrl) blank
298+ Just wasmAssets -> fst (wasmScripts allJsUrl wasmAssets)
268299
269300-- | Load the script from the given URL in a deferred script tag.
270301-- This is the default method.
271−deferredGhcjsScript :: Text -> FrontendWidgetT r ()
272−deferredGhcjsScript allJsUrl = elAttr "script" ("type" =: "text/javascript" <> "src" =: allJsUrl <> "defer" =: "defer") blank
302+deferredGhcjsScript :: GhcjsWasmAssets -> FrontendWidgetT r ()
303+deferredGhcjsScript (GhcjsWasmAssets allJsUrl mWasm) = case mWasm of
304+ Nothing -> elAttr "script" ("type" =: "text/javascript" <> "src" =: allJsUrl <> "defer" =: "defer") blank
305+ Just wasmAssets -> snd (wasmScripts allJsUrl wasmAssets)
306+
307+wasmScripts :: Text -> Text -> (FrontendWidgetT r (), FrontendWidgetT r ())
308+wasmScripts allJsUrl wasmRoot = (script preloadScript, script runJsScript)
309+ where
310+ script t = elAttr "script" ("type" =: "text/javascript") $ text t
311+ jsaddleJs = wasmRoot <> "/jsaddle_core.js"
312+ interfaceJs = wasmRoot <> "/jsaddle_mainthread_interface.js"
313+ runnerJs = wasmRoot <> "/mainthread_runner.js"
314+ wasmUrl = wasmRoot <> "/frontend.wasm"
315+
316+ preloadScript =
317+ "add_preload_tag = function (docSrc, docType) { \
318+ \ var link_tag = document.createElement('link'); \
319+ \ link_tag.rel = 'preload'; \
320+ \ link_tag.as = docType; \
321+ \ link_tag.href = docSrc; \
322+ \ document.head.appendChild(link_tag); \
323+ \}; \
324+ \if (typeof(WebAssembly) === 'undefined') { \
325+ \ add_preload_tag('" <> allJsUrl <> "', 'script'); \
326+ \} else { \
327+ \ add_preload_tag('" <> wasmUrl <> "', 'script'); \
328+ \ add_preload_tag('" <> jsaddleJs <> "', 'script'); \
329+ \ add_preload_tag('" <> interfaceJs <> "', 'script'); \
330+ \ add_preload_tag('" <> runnerJs <> "', 'script'); \
331+ \}"
332+
333+ runJsScript =
334+ "add_deferload_tag = function (docSrc) { \
335+ \ var tag = document.createElement('script'); \
336+ \ tag.type = 'text/javascript'; \
337+ \ tag.src = docSrc; \
338+ \ tag.setAttribute = ('defer', 'defer'); \
339+ \ document.body.appendChild(tag); \
340+ \}; \
341+ \if (typeof(WebAssembly) === 'undefined') { \
342+ \ add_deferload_tag('" <> allJsUrl <> "'); \
343+ \} else { \
344+ \ var wasmFile = '" <> wasmUrl <> "'; \
345+ \ add_deferload_tag('" <> jsaddleJs <> "'); \
346+ \ add_deferload_tag('" <> interfaceJs <> "'); \
347+ \ add_deferload_tag('" <> runnerJs <> "'); \
348+ \}"
273349
274350-- | An all.js script which is loaded after waiting for some time to pass. This
275351-- is useful to ensure any CSS animations on the page can play smoothly before