8937d0d · obelisk · git.iko.soy

git.iko.soy/obelisk

Expose and use route to all.js

commit8937d0d078fff4ce9bb86e5170c02b409136374e authorElliot Cameron <eacameron@gmail.com> dateFri 1 Nov 2019, 16:30 (7 years ago) parent66a7862

2 files changed+38−32

compare with master

unifiedsplit

lib/backend/src/Obelisk/Backend.hs+27−26 lib/run/src/Obelisk/Run.hs+11−6

lib/backend/src/Obelisk/Backend.hs+27−26

@@ -16,18 +16,15 @@ module Obelisk.Backend

1616 , runSnapWithCommandLineArgs

1717 , serveDefaultObeliskApp

1818 , prettifyOutput

19+ , renderAllJsPath

1920 , runBackend

2021 , staticRenderContentType

21− , mkRouteToUrl

2222 , getPublicConfigs

2323 ) where

2424

25−import Prelude hiding (id, (.))

26−import Control.Category

2725import Control.Monad

2826import Control.Monad.Except

2927import Control.Monad.Fail (MonadFail)

30−import Control.Categorical.Bifunctor

3128import Data.ByteString (ByteString)

3229import qualified Data.ByteString.Char8 as BSC8

3330import Data.Default (Default (..))

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

3835import Data.Monoid ((<>))

3936import Data.Text (Text)

4037import qualified Data.Text as T

41−import Data.Text.Encoding

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

4339import qualified Obelisk.ExecutableConfig.Lookup as Lookup

4440import Obelisk.Frontend

@@ -66,15 +62,15 @@ data GhcjsApp route = GhcjsApp

6662--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

6763serveDefaultObeliskApp

6864 :: (MonadSnap m, HasCookies m, MonadFail m)

69− => (R appRoute

70− -> Text)

71− -> ([Text]

72− -> m ())

65+ => (R appRoute -> Text)

66+ -> Text -- ^ URL to GHCJS app JavaScript

67+ -> ([Text] -> m ())

7368 -> Frontend (R appRoute)

7469 -> Map Text ByteString

7570 -> R (ObeliskRoute appRoute)

7671 -> m ()

77−serveDefaultObeliskApp urlEnc serveStaticAsset frontend configs = serveObeliskApp urlEnc serveStaticAsset frontendApp configs

72+serveDefaultObeliskApp urlEnc allJsUrl serveStaticAsset frontend =

73+ serveObeliskApp urlEnc allJsUrl serveStaticAsset frontendApp

7874 where frontendApp = GhcjsApp

7975 { _ghcjsApp_compiled = defaultFrontendGhcjsAssets

8076 , _ghcjsApp_value = frontend

@@ -121,19 +117,24 @@ getRouteWith e = do

121117 pageName <- getPageName

122118 return $ tryDecode e pageName

123119

120+renderAllJsPath :: Encoder Identity Identity (R (FullRoute a b)) PageName -> Text

121+renderAllJsPath validFullEncoder =

122+ renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_Resource ResourceRoute_Ghcjs) :/ ["all.js"]

123+

124124serveObeliskApp

125125 :: (MonadSnap m, HasCookies m, MonadFail m)

126126 => (R appRoute -> Text)

127+ -> Text -- ^ URL to GHCJS app JavaScript

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

128129 -> GhcjsApp (R appRoute)

129130 -> Map Text ByteString

130131 -> R (ObeliskRoute appRoute)

131132 -> m ()

132−serveObeliskApp urlEnc serveStaticAsset frontendApp config = \case

133− ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc frontendApp config $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest

133+serveObeliskApp urlEnc allJsUrl serveStaticAsset frontendApp config = \case

134+ ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp urlEnc allJsUrl frontendApp config $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest

134135 ObeliskRoute_Resource resComponent :=> Identity resRest -> case resComponent :=> Identity resRest of

135136 ResourceRoute_Static :=> Identity pathSegments -> serveStaticAsset pathSegments

136− ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc frontendApp config $ GhcjsAppRoute_Resource :/ pathSegments

137+ ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp urlEnc allJsUrl frontendApp config $ GhcjsAppRoute_Resource :/ pathSegments

137138 ResourceRoute_JSaddleWarp :=> Identity _ -> do

138139 let msg = "Error: Obelisk.Backend received jsaddle request"

139140 liftIO $ putStrLn $ T.unpack msg

@@ -160,15 +161,16 @@ staticRenderContentType = "text/html; charset=utf-8"

160161serveGhcjsApp

161162 :: (MonadSnap m, HasCookies m, MonadFail m)

162163 => (R appRouteComponent -> Text)

164+ -> Text -- ^ URL to GHCJS app JavaScript

163165 -> GhcjsApp (R appRouteComponent)

164166 -> Map Text ByteString

165167 -> R (GhcjsAppRoute appRouteComponent)

166168 -> m ()

167−serveGhcjsApp urlEnc app config = \case

169+serveGhcjsApp urlEnc allJsUrl app config = \case

168170 GhcjsAppRoute_App appRouteComponent :=> Identity appRouteRest -> do

169171 modifyResponse $ setContentType staticRenderContentType

170172 modifyResponse $ setHeader "Cache-Control" "no-store private"

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

173+ writeBS <=< renderGhcjsFrontend urlEnc allJsUrl (appRouteComponent :/ appRouteRest) config $ _ghcjsApp_value app

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

173175

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

@@ -176,30 +178,29 @@ runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend

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

177179 Right validFullEncoder -> do

178180 publicConfigs <- getPublicConfigs

179− _backend_run backend $ \serveRoute -> do

180− runSnapWithCommandLineArgs $ do

181+ _backend_run backend $ \serveRoute ->

182+ runSnapWithCommandLineArgs $

181183 getRouteWith validFullEncoder >>= \case

182184 Identity r -> case r of

183185 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a

184186 FullRoute_Frontend obeliskRoute :/ a ->

185− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets defaultStaticAssets) frontend publicConfigs $

187+ serveDefaultObeliskApp routeToUrl allJsUrl (serveStaticAssets defaultStaticAssets) frontend publicConfigs $

186188 obeliskRoute :/ a

187−

188−mkRouteToUrl :: Encoder Identity parse (R (FullRoute br fr)) PageName -> R fr -> Text

189−mkRouteToUrl validFullEncoder =

190− let pageNameEncoder' :: Encoder Identity (Either Text) PageName PathQuery = pageNameEncoder

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

189+ where

190+ routeToUrl (k :/ v) = renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_App k) :/ v

191+ allJsUrl = renderAllJsPath validFullEncoder

192192

193193renderGhcjsFrontend

194194 :: (MonadSnap m, HasCookies m)

195195 => (route -> Text)

196+ -> Text -- ^ URL to GHCJS app JavaScript

196197 -> route

197198 -> Map Text ByteString

198199 -> Frontend route

199200 -> m ByteString

200−renderGhcjsFrontend urlEnc route configs f = do

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

202− ghcjsScript = elAttr "script" ("language" =: "javascript" <> "src" =: "ghcjs/all.js" <> "defer" =: "defer") blank

201+renderGhcjsFrontend urlEnc allJsUrl route configs f = do

202+ let ghcjsPreload = elAttr "link" ("rel" =: "preload" <> "as" =: "script" <> "href" =: allJsUrl) blank

203+ ghcjsScript = elAttr "script" ("language" =: "javascript" <> "src" =: allJsUrl <> "defer" =: "defer") blank

203204 cookies <- askCookies

204205 renderFrontendHtml configs cookies urlEnc route f ghcjsPreload ghcjsScript

205206

lib/run/src/Obelisk/Run.hs+11−6

@@ -75,14 +75,18 @@ run port serveStaticAsset backend frontend = do

7575 Left e -> hPutStrLn stderr $ "backend error:\n" <> T.unpack e

7676 Right validFullEncoder -> do

7777 publicConfigs <- getPublicConfigs

78− backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] $ do

79− _backend_run backend $ \serveRoute -> do

80− runSnapWithCommandLineArgs $ do

78+ backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] $

79+ _backend_run backend $ \serveRoute ->

80+ runSnapWithCommandLineArgs $

8181 getRouteWith validFullEncoder >>= \case

8282 Identity r -> case r of

8383 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a

8484 FullRoute_Frontend obeliskRoute :/ a ->

85− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) serveStaticAsset frontend publicConfigs $ obeliskRoute :/ a

85+ serveDefaultObeliskApp appRouteToUrl allJsUrl serveStaticAsset frontend publicConfigs $ obeliskRoute :/ a

86+ where

87+ appRouteToUrl (k :/ v) = renderObeliskRoute validFullEncoder (FullRoute_Frontend (ObeliskRoute_App k) :/ v)

88+ allJsUrl = renderAllJsPath validFullEncoder

89+

8690 let conf = defRunConfig { _runConfig_redirectPort = port }

8791 runWidget conf publicConfigs frontend validFullEncoder `finally` killThread backendTid

8892

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

9296

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

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

95− Just r ->

99+ Just r ->

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

97101 in case URI.mkURI stripped of

98102 Just route -> Right route

@@ -151,7 +155,8 @@ obeliskApp configs opts frontend validFullEncoder uri backend = do

151155 }

152156 FullRoute_Frontend (ObeliskRoute_App appRouteComponent) :/ appRouteRest -> do

153157 let cookies = maybe [] parseCookies $ lookup (fromString "Cookie") (W.requestHeaders req)

154− html <- renderJsaddleFrontend configs cookies (mkRouteToUrl validFullEncoder) (appRouteComponent :/ appRouteRest) frontend

158+ routeToUrl (k :/ v) = renderObeliskRoute validFullEncoder $ FullRoute_Frontend (ObeliskRoute_App k) :/ v

159+ html <- renderJsaddleFrontend configs cookies routeToUrl (appRouteComponent :/ appRouteRest) frontend

155160 sendResponse $ W.responseLBS H.status200 [("Content-Type", staticRenderContentType)] $ BSLC.fromStrict html

156161 _ -> backend req sendResponse

157162