git.iko.soy/obelisk
on master help sign in
Prerender body as well as head
commit79c50931fadf3f694f56a7b7fde02f08565dd54d authorRyan Trinkle <ryan.trinkle@gmail.com> dateWed 18 Jul 2018, 15:35 (8 years ago) parentca44403
5 files changed+30−24
compare with master
unifiedsplit
dep/reflex-platform/github.json+2−2 lib/backend/src/Obelisk/Backend.hs+4−3 lib/frontend/src/Obelisk/Frontend.hs+9−11 lib/route/src/Obelisk/Route/Frontend.hs+4 lib/run/src/Obelisk/Run.hs+11−8
dep/reflex-platform/github.json+2−2
@@ -2,6 +2,6 @@
22 "owner": "reflex-frp",
33 "repo": "reflex-platform",
44 "branch": "reunification",
5− "rev": "abe3c5c7f71014056a82911393ea4fe01b1f2d0b",
6− "sha256": "19zkd928njy3g6q9ixifls1vklw31s8zw9n6x6pl2jj7r71dp0gv"
5+ "rev": "c5619386b6d9419a7cea2a4d32aa44ee6e4f407b",
6+ "sha256": "1wmrsv1ksqi9qgapjd7xzbsv86rw2fd5c1x6yayzyc5pkr4rxjr6"
77}
lib/backend/src/Obelisk/Backend.hs+4−3
@@ -151,17 +151,18 @@ data GhcjsAppRoute :: (* -> *) -> * -> * where
151151serveGhcjsApp :: MonadSnap m => GhcjsApp (R appRouteComponent) -> R (GhcjsAppRoute appRouteComponent) -> m ()
152152serveGhcjsApp app = \case
153153 GhcjsAppRoute_App appRouteComponent :=> Identity appRouteRest -> do
154− indexHtml <- liftIO $ fmap snd $ renderStatic $ fmap fst $ runEventWriterT $ flip runRoutedT (pure $ appRouteComponent :/ appRouteRest) $ blankLoader $ _frontend_head $ _ghcjsApp_value app
154+ indexHtml <- liftIO $ fmap snd $ renderStatic $ fmap fst $ runEventWriterT $ flip runRoutedT (pure $ appRouteComponent :/ appRouteRest) $ blankLoader (_frontend_head $ _ghcjsApp_value app) (_frontend_body $ _ghcjsApp_value app)
155155 --TODO: We should probably have a "NullEventWriterT" or a frozen reflex timeline
156156 writeBS $ "<!DOCTYPE html>\n" <> indexHtml
157157 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments
158158
159−blankLoader :: DomBuilder t m => m () -> m ()
160−blankLoader headHtml = el "html" $ do
159+blankLoader :: DomBuilder t m => m () -> m () -> m ()
160+blankLoader headHtml bodyHtml = el "html" $ do
161161 el "head" $ do
162162 elAttr "base" ("href" =: "/") blank --TODO: Figure out the base URL from the routes
163163 headHtml
164164 el "body" $ do
165+ bodyHtml
165166 --TODO: Hash the all.js path
166167 elAttr "script" ("language" =: "javascript" <> "src" =: "ghcjs/all.js" <> "defer" =: "defer") blank
167168
lib/frontend/src/Obelisk/Frontend.hs+9−11
@@ -42,7 +42,7 @@ import qualified Reflex.TriggerEvent.Base as TriggerEvent
4242
4343makePrisms ''Sum
4444
45−type ObeliskWidget t route m =
45+type ObeliskWidget t x route m =
4646 ( DomBuilder t m
4747 , MonadFix m
4848 , MonadHold t m
@@ -53,18 +53,20 @@ type ObeliskWidget t route m =
5353 , MonadIO m
5454 , MonadIO (Performable m)
5555 , TriggerEvent t m
56−-- , HasDocument m --TODO: Would need StaticDomBuilderT to have this
56+ , HasDocument m
5757 , MonadRef m
5858 , Ref m ~ Ref IO
5959 , MonadRef (Performable m)
6060 , Ref (Performable m) ~ Ref IO
6161 , MonadFix (Performable m)
62+ , PrimMonad m
63+ , Prerender x m
6264 , EventWriter t (Endo route) m
6365 )
6466
6567data Frontend route = Frontend
66− { _frontend_head :: !(forall t m. ObeliskWidget t route m => RoutedT t route m ())
67− , _frontend_body :: !(forall t m x. (MonadWidget t m, PrimMonad m, ObeliskWidget t route m, HasJS x m) => RoutedT t route m ())
68+ { _frontend_head :: !(forall t m x. ObeliskWidget t x route m => RoutedT t route m ())
69+ , _frontend_body :: !(forall t m x. ObeliskWidget t x route m => RoutedT t route m ())
6870 , _frontend_title :: !(route -> Text)
6971 , _frontend_notFoundRoute :: !(Text -> route) --TODO: Instead, maybe we should just require that the `parse` Monad for routeEncoder be `Identity`
7072 }
@@ -76,11 +78,6 @@ type FloatingWidget x = TriggerEventT DomTimeline (DomCoreWidget x)
7678
7779type DomCoreWidget x = PostBuildT DomTimeline (WithJSContextSingleton x (PerformEventT DomTimeline DomHost))
7880
79−--TODO: Upstream
80−instance HasJS x m => HasJS x (EventWriterT t w m) where
81− type JSX (EventWriterT t w m) = JSX m
82− liftJS = lift . liftJS
83−
8481--TODO: Rename
8582{-# INLINABLE attachWidget''' #-}
8683attachWidget'''
@@ -107,9 +104,10 @@ runWithHeadAndBody app = withJSContextSingletonMono $ \jsSing -> do
107104 unreadyChildren <- liftIO $ newIORef 0
108105 let commit = do
109106 headElement <- getHeadUnchecked globalDoc
110− replaceElementContents headElement headFragment
111107 bodyElement <- getBodyUnchecked globalDoc
112− replaceElementContents bodyElement bodyFragment
108+ void $ inAnimationFrame' $ \_ -> do
109+ replaceElementContents headElement headFragment
110+ replaceElementContents bodyElement bodyFragment
113111 liftIO $ attachWidget''' $ \events -> flip runWithJSContextSingleton jsSing $ do
114112 (postBuild, postBuildTriggerRef) <- newEventWithTriggerRef
115113 let appendImmediateDom :: DOM.DocumentFragment -> Widget' () c -> FloatingWidget () c
lib/route/src/Obelisk/Route/Frontend.hs+4
@@ -47,6 +47,7 @@ import Control.Monad.Trans
4747import Control.Monad.Trans.Control
4848import Control.Monad.Trans.Reader
4949import Data.Coerce
50+import Data.Constraint (Dict (..))
5051import Data.Dependent.Sum (DSum (..))
5152import Data.GADT.Compare
5253import Data.Monoid
@@ -82,6 +83,9 @@ instance Monad m => Routed t r (RoutedT t r m) where
8283newtype RoutedT t r m a = RoutedT { unRoutedT :: ReaderT (Dynamic t r) m a }
8384 deriving (Functor, Applicative, Monad, MonadFix, MonadTrans, NotReady t, MonadHold t, MonadSample t, PostBuild t, TriggerEvent t, HasJSContext, MonadIO, MonadReflexCreateTrigger t, HasDocument)
8485
86+instance Prerender js m => Prerender js (RoutedT t r m) where
87+ prerenderClientDict = fmap (\Dict -> Dict) (prerenderClientDict :: Maybe (Dict (PrerenderClientConstraint js m)))
88+
8589instance (Requester t m, PrimMonad m) => Requester t (RoutedT t r m) where
8690 type Request (RoutedT t r m) = Request m
8791 type Response (RoutedT t r m) = Response m
lib/run/src/Obelisk/Run.hs+11−8
@@ -131,18 +131,21 @@ obeliskApp opts frontend validFullEncoder backend = do
131131 { W.pathInfo = fst $ _validEncoder_encode jsaddleWarpRouteValidEncoder jsaddleRoute
132132 }
133133 InR (ObeliskRoute_App appRouteComponent) :=> Identity appRouteRest -> do
134− html <- fmap BSLC.fromStrict $ indexHtml $ fmap fst $ runEventWriterT $ flip runRoutedT (pure $ appRouteComponent :/ appRouteRest) $ _frontend_head frontend
135− sendResponse $ W.responseLBS H.status200 [("Content-Type", "text/html")] html
134+ html <- renderStaticHtml $ fmap fst $ runEventWriterT $ flip runRoutedT (pure $ appRouteComponent :/ appRouteRest) $ indexHtml (_frontend_head frontend) (_frontend_body frontend)
135+ sendResponse $ W.responseLBS H.status200 [("Content-Type", "text/html")] $ BSLC.fromStrict html
136136 _ -> backend req sendResponse
137137
138−indexHtml :: StaticWidget () () -> IO ByteString
139−indexHtml h = do
140− ((), bs) <- renderStatic $ el "html" $ do
141− el "head" $ h
142− el "body" $ return ()
143− elAttr "script" ("src" =: "/jsaddle/jsaddle.js") $ return ()
138+renderStaticHtml :: StaticWidget () () -> IO ByteString
139+renderStaticHtml w = do
140+ (_, bs) <- renderStatic w
144141 return $ "<!DOCTYPE html>" <> bs
145142
143+indexHtml :: DomBuilder t m => m () -> m () -> m ()
144+indexHtml h b = el "html" $ do
145+ el "head" $ h
146+ el "body" $ b
147+ elAttr "script" ("src" =: "/jsaddle/jsaddle.js") $ return ()
148+
146149-- | like 'bindPortTCP' but reconnects on exception
147150bindPortTCPRetry :: Settings
148151 -> (IOError -> IO ()) -- ^ Action to run the first time an exception is caught