@@ -9,6 +9,12 @@
99{-# OPTIONS_GHC -fno-warn-orphans #-}
1010module Obelisk.Backend
1111 ( Backend (..)
12+ -- * Running a backend
13+ , runBackend
14+ , runBackendWith
15+ -- * all.js script loading functions
16+ , deferredGhcjsScript
17+ , delayedGhcjsScript
1218 -- * Re-exports
1319 , Default (def)
1420 , getPageName
@@ -17,7 +23,6 @@ module Obelisk.Backend
1723 , serveDefaultObeliskApp
1824 , prettifyOutput
1925 , renderAllJsPath
20− , runBackend
2126 , staticRenderContentType
2227 , getPublicConfigs
2328 ) where
@@ -64,13 +69,14 @@ serveDefaultObeliskApp
6469 :: (MonadSnap m, HasCookies m, MonadFail m)
6570 => (R appRoute -> Text)
6671 -> Text -- ^ URL to GHCJS app JavaScript
72+ -> (Text -> FrontendWidgetT (R appRoute) ()) -- ^ GHCJS all.js script widget
6773 -> ([Text] -> m ())
6874 -> Frontend (R appRoute)
6975 -> Map Text ByteString
7076 -> R (ObeliskRoute appRoute)
7177 -> m ()
72−serveDefaultObeliskApp urlEnc allJsUrl serveStaticAsset frontend =
73− serveObeliskApp urlEnc allJsUrl serveStaticAsset frontendApp
78+serveDefaultObeliskApp urlEnc allJsUrl ghcjsScript serveStaticAsset frontend =
79+ serveObeliskApp urlEnc allJsUrl ghcjsScript serveStaticAsset frontendApp
7480 where frontendApp = GhcjsApp
7581 { _ghcjsApp_compiled = defaultFrontendGhcjsAssets
7682 , _ghcjsApp_value = frontend
@@ -125,16 +131,17 @@ serveObeliskApp
125131 :: (MonadSnap m, HasCookies m, MonadFail m)
126132 => (R appRoute -> Text)
127133 -> Text -- ^ URL to GHCJS app JavaScript
134+ -> (Text -> FrontendWidgetT (R appRoute) ()) -- ^ GHCJS all.js script widget
128135 -> ([Text] -> m ())
129136 -> GhcjsApp (R appRoute)
130137 -> Map Text ByteString
131138 -> R (ObeliskRoute appRoute)
132139 -> m ()
133−serveObeliskApp urlEnc allJsUrl serveStaticAsset frontendApp config = \case
134− ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc allJsUrl frontendApp config $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest
140+serveObeliskApp urlEnc allJsUrl ghcjsScript serveStaticAsset frontendApp config = \case
141+ ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc allJsUrl ghcjsScript frontendApp config $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest
135142 ObeliskRoute_Resource resComponent :=> Identity resRest -> case resComponent :=> Identity resRest of
136143 ResourceRoute_Static :=> Identity pathSegments -> serveStaticAsset pathSegments
137− ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc allJsUrl frontendApp config $ GhcjsAppRoute_Resource :/ pathSegments
144+ ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc allJsUrl ghcjsScript frontendApp config $ GhcjsAppRoute_Resource :/ pathSegments
138145 ResourceRoute_JSaddleWarp :=> Identity _ -> do
139146 let msg = "Error: Obelisk.Backend received jsaddle request"
140147 liftIO $ putStrLn $ T.unpack msg
@@ -162,19 +169,27 @@ serveGhcjsApp
162169 :: (MonadSnap m, HasCookies m, MonadFail m)
163170 => (R appRouteComponent -> Text)
164171 -> Text -- ^ URL to GHCJS app JavaScript
172+ -> (Text -> FrontendWidgetT (R appRouteComponent) ()) -- ^ GHCJS all.js script widget
165173 -> GhcjsApp (R appRouteComponent)
166174 -> Map Text ByteString
167175 -> R (GhcjsAppRoute appRouteComponent)
168176 -> m ()
169−serveGhcjsApp urlEnc allJsUrl app config = \case
177+serveGhcjsApp urlEnc allJsUrl ghcjsScript app config = \case
170178 GhcjsAppRoute_App appRouteComponent :=> Identity appRouteRest -> do
171179 modifyResponse $ setContentType staticRenderContentType
172180 modifyResponse $ setHeader "Cache-Control" "no-store private"
173− writeBS <=< renderGhcjsFrontend urlEnc allJsUrl (appRouteComponent :/ appRouteRest) config $ _ghcjsApp_value app
181+ writeBS <=< renderGhcjsFrontend urlEnc allJsUrl ghcjsScript (appRouteComponent :/ appRouteRest) config $ _ghcjsApp_value app
174182 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments
175183
176184runBackend :: Backend backendRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()
177−runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend of
185+runBackend = runBackendWith deferredGhcjsScript
186+
187+runBackendWith
188+ :: (Text -> FrontendWidgetT (R frontendRoute) ()) -- ^ GHCJS all.js script widget
189+ -> Backend backendRoute frontendRoute
190+ -> Frontend (R frontendRoute)
191+ -> IO ()
192+runBackendWith ghcjsScript backend frontend = case checkEncoder $ _backend_routeEncoder backend of
178193 Left e -> fail $ "backend error:\n" <> T.unpack e
179194 Right validFullEncoder -> do
180195 publicConfigs <- getPublicConfigs
@@ -184,7 +199,7 @@ runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend
184199 Identity r -> case r of
185200 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a
186201 FullRoute_Frontend obeliskRoute :/ a ->
187− serveDefaultObeliskApp routeToUrl allJsUrl (serveStaticAssets defaultStaticAssets) frontend publicConfigs $
202+ serveDefaultObeliskApp routeToUrl allJsUrl ghcjsScript (serveStaticAssets defaultStaticAssets) frontend publicConfigs $
188203 obeliskRoute :/ a
189204 where
190205 routeToUrl (k :/ v) = renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_App k) :/ v
@@ -193,16 +208,37 @@ runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend
193208renderGhcjsFrontend
194209 :: (MonadSnap m, HasCookies m)
195210 => (route -> Text)
196− -> Text -- ^ URL to GHCJS app JavaScript
211+ -> Text
212+ -> (Text -> FrontendWidgetT route ()) -- ^ GHCJS all.js script widget
197213 -> route
198214 -> Map Text ByteString
199215 -> Frontend route
200216 -> m ByteString
201−renderGhcjsFrontend urlEnc allJsUrl route configs f = do
217+renderGhcjsFrontend urlEnc allJsUrl ghcjsScript route configs f = do
202218 let ghcjsPreload = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: allJsUrl) blank
203− ghcjsScript = elAttr "script" ("language" =: "javascript" <> "src" =: allJsUrl <> "defer" =: "defer") blank
204219 cookies <- askCookies
205− renderFrontendHtml configs cookies urlEnc route f ghcjsPreload ghcjsScript
220+ renderFrontendHtml configs cookies urlEnc route f ghcjsPreload (ghcjsScript allJsUrl)
221+
222+-- | Load the script from the given URL in a deferred script tag.
223+-- This is the default method.
224+deferredGhcjsScript :: Text -> FrontendWidgetT r ()
225+deferredGhcjsScript allJsUrl = elAttr "script" ("type" =: "text/javascript" <> "src" =: allJsUrl <> "defer" =: "defer") blank
226+
227+-- | An all.js script which is loaded after waiting for some time to pass. This
228+-- is useful to ensure any CSS animations on the page can play smoothly before
229+-- blocking the UI thread by running all.js.
230+delayedGhcjsScript
231+ :: Int -- ^ The number of milliseconds to delay loading by
232+ -> Text -- ^ URL to GHCJS app JavaScript
233+ -> FrontendWidgetT r ()
234+delayedGhcjsScript n allJsUrl = elAttr "script" ("type" =: "text/javascript") $ text $ T.unlines
235+ [ "setTimeout(function() {"
236+ , " var all_js_script = document.createElement('script');"
237+ , " all_js_script.type = 'text/javascript';"
238+ , " all_js_script.src = '" <> allJsUrl <> "';"
239+ , " document.body.appendChild(all_js_script);"
240+ , "}, " <> T.pack (show n) <> ");"
241+ ]
206242
207243instance HasCookies Snap where
208244 askCookies = map (\c -> (cookieName c, cookieValue c)) <$> getsRequest rqCookies