e60daa0 · obelisk · git.iko.soy

git.iko.soy/obelisk

Prerender result of frontend

commite60daa0cd1f4cd0d7706e65589fb8957433c0a7d authorElliot Cameron <eacameron@gmail.com> dateWed 13 Nov 2019, 23:26 (7 years ago) parenta0c3abf

6 files changed+59−39

compare with master

unifiedsplit

lib/backend/obelisk-backend.cabal+1 lib/backend/src/Obelisk/Backend.hs+14−13 lib/frontend/obelisk-frontend.cabal+1 lib/frontend/src/Obelisk/Frontend.hs+26−15 lib/run/obelisk-run.cabal+2−1 lib/run/src/Obelisk/Run.hs+15−10

lib/backend/obelisk-backend.cabal+1

@@ -6,6 +6,7 @@ build-type: Simple

66library

77 hs-source-dirs: src

88 build-depends: base,

9+ aeson,

910 bytestring,

1011 categories,

1112 containers,

lib/backend/src/Obelisk/Backend.hs+14−13

@@ -27,7 +27,7 @@ import Control.Category

2727import Control.Monad

2828import Control.Monad.Except

2929import Control.Monad.Fail (MonadFail)

30−import Control.Categorical.Bifunctor

30+import qualified Data.Aeson as Aeson

3131import Data.ByteString (ByteString)

3232import qualified Data.ByteString.Char8 as BSC8

3333import Data.Default (Default (..))

@@ -38,7 +38,6 @@ import qualified Data.Map as Map

3838import Data.Monoid ((<>))

3939import Data.Text (Text)

4040import qualified Data.Text as T

41−import Data.Text.Encoding

4241import Obelisk.Asset.Serve.Snap (serveAsset)

4342import qualified Obelisk.ExecutableConfig.Lookup as Lookup

4443import Obelisk.Frontend

@@ -57,20 +56,20 @@ data Backend backendRoute frontendRoute = Backend

5756 }

5857

5958-- | The static assets provided must contain a compiled GHCJS app that corresponds exactly to the Frontend provided

60−data GhcjsApp route = GhcjsApp

59+data GhcjsApp route result = GhcjsApp

6160 { _ghcjsApp_compiled :: !StaticAssets

62− , _ghcjsApp_value :: !(Frontend route)

61+ , _ghcjsApp_value :: !(Frontend route result)

6362 }

6463

6564-- | Serve a frontend, which must be the same frontend that Obelisk has built and placed in the default location

6665--TODO: The frontend should be provided together with the asset paths so that this isn't so easily breakable; that will probably make this function obsolete

6766serveDefaultObeliskApp

68− :: (MonadSnap m, HasCookies m, MonadFail m)

67+ :: (MonadSnap m, HasCookies m, MonadFail m, Semigroup result, Aeson.ToJSON result)

6968 => (R appRoute

7069 -> Text)

7170 -> ([Text]

7271 -> m ())

73− -> Frontend (R appRoute)

72+ -> Frontend (R appRoute) result

7473 -> Map Text ByteString

7574 -> R (ObeliskRoute appRoute)

7675 -> m ()

@@ -122,10 +121,10 @@ getRouteWith e = do

122121 return $ tryDecode e pageName

123122

124123serveObeliskApp

125− :: (MonadSnap m, HasCookies m, MonadFail m)

124+ :: (MonadSnap m, HasCookies m, MonadFail m, Semigroup result, Aeson.ToJSON result)

126125 => (R appRoute -> Text)

127126 -> ([Text] -> m ())

128− -> GhcjsApp (R appRoute)

127+ -> GhcjsApp (R appRoute) result

129128 -> Map Text ByteString

130129 -> R (ObeliskRoute appRoute)

131130 -> m ()

@@ -158,9 +157,9 @@ staticRenderContentType = "text/html; charset=utf-8"

158157

159158--TODO: Don't assume we're being served at "/"

160159serveGhcjsApp

161− :: (MonadSnap m, HasCookies m, MonadFail m)

160+ :: (MonadSnap m, HasCookies m, MonadFail m, Semigroup result, Aeson.ToJSON result)

162161 => (R appRouteComponent -> Text)

163− -> GhcjsApp (R appRouteComponent)

162+ -> GhcjsApp (R appRouteComponent) result

164163 -> Map Text ByteString

165164 -> R (GhcjsAppRoute appRouteComponent)

166165 -> m ()

@@ -171,7 +170,9 @@ serveGhcjsApp urlEnc app config = \case

171170 writeBS <=< renderGhcjsFrontend urlEnc (appRouteComponent :/ appRouteRest) config $ _ghcjsApp_value app

172171 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments

173172

174−runBackend :: Backend backendRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()

173+runBackend

174+ :: (Semigroup result, Aeson.ToJSON result)

175+ => Backend backendRoute frontendRoute -> Frontend (R frontendRoute) result -> IO ()

175176runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend of

176177 Left e -> fail $ "backend error:\n" <> T.unpack e

177178 Right validFullEncoder -> do

@@ -191,11 +192,11 @@ mkRouteToUrl validFullEncoder =

191192 in \(k :/ v) -> T.pack . uncurry (<>) . encode pageNameEncoder' . encode validFullEncoder $ (FullRoute_Frontend $ ObeliskRoute_App k) :/ v

192193

193194renderGhcjsFrontend

194− :: (MonadSnap m, HasCookies m)

195+ :: (MonadSnap m, HasCookies m, Semigroup result, Aeson.ToJSON result)

195196 => (route -> Text)

196197 -> route

197198 -> Map Text ByteString

198− -> Frontend route

199+ -> Frontend route result

199200 -> m ByteString

200201renderGhcjsFrontend urlEnc route configs f = do

201202 let ghcjsPreload = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: "ghcjs/all.js") blank

lib/frontend/obelisk-frontend.cabal+1

@@ -6,6 +6,7 @@ build-type: Simple

66library

77 hs-source-dirs: src

88 build-depends: base,

9+ aeson,

910 bytestring,

1011 containers,

1112 cookie,

lib/frontend/src/Obelisk/Frontend.hs+26−15

@@ -32,13 +32,16 @@ import Control.Monad.Primitive

3232import Control.Monad.Reader

3333import Control.Monad.Ref

3434import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

35+import qualified Data.Aeson as Aeson

3536import Data.ByteString (ByteString)

37+import qualified Data.ByteString.Lazy as LBS

3638import Data.Foldable (for_)

3739import Data.Functor.Sum

3840import Data.Map (Map)

3941import Data.Maybe (catMaybes)

4042import Data.Monoid ((<>))

4143import Data.Text (Text)

44+import qualified Data.Text.Encoding as T

4245import qualified GHCJS.DOM as DOM

4346import qualified GHCJS.DOM.Types as DOM

4447import qualified GHCJS.DOM.History as DOM

@@ -94,9 +97,9 @@ type PrebuildAgnostic t route m =

9497 , HasConfigs (Performable m)

9598 )

9699

97−data Frontend route = Frontend

98− { _frontend_head :: !(forall js t m. ObeliskWidget js t route m => RoutedT t route m ())

99− , _frontend_body :: !(forall js t m. ObeliskWidget js t route m => RoutedT t route m ())

100+data Frontend route result = Frontend

101+ { _frontend_head :: !(forall js t m. ObeliskWidget js t route m => RoutedT t route m result)

102+ , _frontend_body :: !(forall js t m. ObeliskWidget js t route m => RoutedT t route m result)

100103 }

101104

102105baseTag :: forall route js t m. ObeliskWidget js t route m => RoutedT t route m ()

@@ -144,9 +147,10 @@ data FrontendMode = FrontendMode

144147-- route exists ambiently in the context (e.g. anything but web).

145148-- Selects FrontendMode based on platform; this doesn't work for jsaddle-warp

146149runFrontend

147− :: forall backendRoute route

148− . Encoder Identity Identity (R (FullRoute backendRoute route)) PageName

149− -> Frontend (R route)

150+ :: forall backendRoute route result

151+ . (Semigroup result, Aeson.ToJSON result)

152+ => Encoder Identity Identity (R (FullRoute backendRoute route)) PageName

153+ -> Frontend (R route) result

150154 -> JSM ()

151155runFrontend validFullEncoder frontend = do

152156 let mode = FrontendMode

@@ -173,11 +177,12 @@ runFrontend validFullEncoder frontend = do

173177 runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend

174178

175179runFrontendWithConfigsAndCurrentRoute

176− :: forall backendRoute frontendRoute

177− . FrontendMode

180+ :: forall backendRoute frontendRoute result

181+ . (Semigroup result, Aeson.ToJSON result)

182+ => FrontendMode

178183 -> Map Text ByteString

179184 -> Encoder Identity Identity (R (FullRoute backendRoute frontendRoute)) PageName

180− -> Frontend (R frontendRoute)

185+ -> Frontend (R frontendRoute) result

181186 -> JSM ()

182187runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend = do

183188 let ve = validFullEncoder . hoistParse errorLeft (prismEncoder (rPrism $ _FullRoute_Frontend . _ObeliskRoute_App))

@@ -210,12 +215,14 @@ runFrontendWithConfigsAndCurrentRoute mode configs validFullEncoder frontend = d

210215 w appendHead appendBody = do

211216 rec switchover <- runRouteViewT ve switchover (_frontendMode_adjustRoute mode) $ do

212217 (switchover'', fire) <- newTriggerEvent

213− mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendHead . runConfigsT configs))) $ do

218+ headResult <- mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendHead . runConfigsT configs))) $ do

214219 -- The order here is important - baseTag has to be before headWidget!

215220 baseTag

216221 _frontend_head frontend

217222 mapRoutedT (mapSetRouteT (mapRouteToUrlT (appendBody . runConfigsT configs))) $ do

218− _frontend_body frontend

223+ bodyResult <- _frontend_body frontend

224+ elAttr "script" ("type"=:"text/plain" <> "data-initial-data"=:"") $

225+ text $ T.decodeUtf8 $ LBS.toStrict $ Aeson.encode $ headResult <> bodyResult

219226 switchover' <- case _frontendMode_hydrate mode of

220227 True -> lift $ lift $ lift $ lift $ HydrationDomBuilderT $ asks _hydrationDomBuilderEnv_switchover

221228 False -> getPostBuild

@@ -230,12 +237,13 @@ renderFrontendHtml

230237 :: ( t ~ DomTimeline

231238 , MonadIO m

232239 , widget ~ RoutedT t r (SetRouteT t r (RouteToUrlT r (ConfigsT (CookiesT (HydratableT (PostBuildT t (StaticDomBuilderT t (PerformEventT t DomHost))))))))

240+ , Semigroup result, Aeson.ToJSON result

233241 )

234242 => Map Text ByteString

235243 -> Cookies

236244 -> (r -> Text)

237245 -> r

238− -> Frontend r

246+ -> Frontend r result

239247 -> widget ()

240248 -> widget ()

241249 -> m ByteString

@@ -243,12 +251,15 @@ renderFrontendHtml configs cookies urlEnc route frontend headExtra bodyExtra = d

243251 --TODO: We should probably have a "NullEventWriterT" or a frozen reflex timeline

244252 html <- fmap snd $ liftIO $ renderStatic $ runHydratableT $ fmap fst $ runCookiesT cookies $ runConfigsT configs $ flip runRouteToUrlT urlEnc $ runSetRouteT $ flip runRoutedT (pure route) $

245253 el "html" $ do

246− el "head" $ do

254+ headResult <- el "head" $ do

247255 baseTag

248256 injectExecutableConfigs configs

249− _frontend_head frontend

257+ headResult <- _frontend_head frontend

250258 headExtra

259+ pure headResult

251260 el "body" $ do

252− _frontend_body frontend

261+ bodyResult <- _frontend_body frontend

253262 bodyExtra

263+ elAttr "script" ("type"=:"text/plain" <> "data-initial-data"=:"") $

264+ text $ T.decodeUtf8 $ LBS.toStrict $ Aeson.encode $ headResult <> bodyResult

254265 return $ "<!DOCTYPE html>" <> html

lib/run/obelisk-run.cabal+2−1

@@ -7,7 +7,8 @@ cabal-version: >=1.2

77library

88 hs-source-dirs: src

99 build-depends:

10− attoparsec

10+ aeson

11+ , attoparsec

1112 , base

1213 , bytestring

1314 , containers

lib/run/src/Obelisk/Run.hs+15−10

@@ -18,6 +18,7 @@ import Control.Category

1818import Control.Concurrent

1919import Control.Exception

2020import Control.Lens ((%~), (^?), _Just, _Right)

21+import qualified Data.Aeson as Aeson

2122import qualified Data.Attoparsec.ByteString.Char8 as A

2223import Data.ByteString (ByteString)

2324import qualified Data.ByteString as BS

@@ -62,10 +63,11 @@ import Text.URI.Lens

6263import Web.Cookie

6364

6465run

65− :: Int -- ^ Port to run the backend

66+ :: (Semigroup result, Aeson.ToJSON result)

67+ => Int -- ^ Port to run the backend

6668 -> ([Text] -> Snap ()) -- ^ Static asset handler

6769 -> Backend fullRoute frontendRoute -- ^ Backend

68− -> Frontend (R frontendRoute) -- ^ Frontend

70+ -> Frontend (R frontendRoute) result -- ^ Frontend

6971 -> IO ()

7072run port serveStaticAsset backend frontend = do

7173 prettifyOutput

@@ -92,7 +94,7 @@ runServeAsset rootPath = Snap.serveAsset "" rootPath . T.unpack . T.intercalate

9294

9395getConfigRoute :: Map Text ByteString -> Either Text URI

9496getConfigRoute configs = case Map.lookup "common/route" configs of

95− Just r ->

97+ Just r ->

9698 let stripped = T.strip (T.decodeUtf8 r)

9799 in case URI.mkURI stripped of

98100 Just route -> Right route

@@ -100,9 +102,10 @@ getConfigRoute configs = case Map.lookup "common/route" configs of

100102 Nothing -> Left $ "Couldn't find config file common/route; it should contain the site's canonical root URI" <> T.pack (show $ Map.keys configs)

101103

102104runWidget

103− :: RunConfig

105+ :: (Semigroup result, Aeson.ToJSON result)

106+ => RunConfig

104107 -> Map Text ByteString

105− -> Frontend (R frontendRoute)

108+ -> Frontend (R frontendRoute) result

106109 -> Encoder Identity Identity (R (FullRoute backendRoute frontendRoute)) PageName

107110 -> IO ()

108111runWidget conf configs frontend validFullEncoder = do

@@ -122,10 +125,11 @@ runWidget conf configs frontend validFullEncoder = do

122125 runSettingsSocket settings skt app)

123126

124127obeliskApp

125− :: forall frontendRoute backendRoute

126− . Map Text ByteString

128+ :: forall frontendRoute backendRoute result

129+ . (Semigroup result, Aeson.ToJSON result)

130+ => Map Text ByteString

127131 -> ConnectionOptions

128− -> Frontend (R frontendRoute)

132+ -> Frontend (R frontendRoute) result

129133 -> Encoder Identity Identity (R (FullRoute backendRoute frontendRoute)) PageName

130134 -> URI

131135 -> Application

@@ -156,11 +160,12 @@ obeliskApp configs opts frontend validFullEncoder uri backend = do

156160 _ -> backend req sendResponse

157161

158162renderJsaddleFrontend

159− :: Map Text ByteString

163+ :: (Semigroup result, Aeson.ToJSON result)

164+ => Map Text ByteString

160165 -> Cookies

161166 -> (route -> Text)

162167 -> route

163− -> Frontend route

168+ -> Frontend route result

164169 -> IO ByteString

165170renderJsaddleFrontend configs cookies urlEnc r f =

166171 let jsaddleScript = elAttr "script" ("src" =: "/jsaddle/jsaddle.js") blank