on master help sign in
run: Take an asset handler in favor of passing a filepath
commit09ba3673808b60a1f82d0e42ebac513744483cac authorLuigy Leon <luichi.19@gmail.com> dateThu 11 Oct 2018, 19:06 (8 years ago) parenta464d2d
4 files changed+17−20
lib/backend/src/Obelisk/Backend.hs+6−11 lib/command/src/Obelisk/Command/Run.hs+1−1 lib/run/obelisk-run.cabal+1 lib/run/src/Obelisk/Run.hs+9−8
lib/backend/src/Obelisk/Backend.hs+6−11
@@ -8,8 +8,6 @@
88{-# LANGUAGE TemplateHaskell #-}
99module Obelisk.Backend
1010 ( Backend (..)
11− , StaticAssets (..)
12− , serveDefaultObeliskApp'
1311 -- * Re-exports
1412 , Default (def)
1513 , getPageName
@@ -57,11 +55,8 @@ data GhcjsApp route = GhcjsApp
5755
5856-- | Serve a frontend, which must be the same frontend that Obelisk has built and placed in the default location
5957--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
60−serveDefaultObeliskApp :: MonadSnap m => Frontend (R appRoute) -> R (ObeliskRoute appRoute) -> m ()
61−serveDefaultObeliskApp = serveDefaultObeliskApp' defaultStaticAssets
62−
63−serveDefaultObeliskApp' :: MonadSnap m => StaticAssets -> Frontend (R appRoute) -> R (ObeliskRoute appRoute) -> m ()
64−serveDefaultObeliskApp' staticAssets frontend = serveObeliskApp staticAssets frontendApp
58+serveDefaultObeliskApp :: MonadSnap m => ([Text] -> m ()) -> Frontend (R appRoute) -> R (ObeliskRoute appRoute) -> m ()
59+serveDefaultObeliskApp serveStaticAsset frontend = serveObeliskApp serveStaticAsset frontendApp
6560 where frontendApp = GhcjsApp
6661 { _ghcjsApp_compiled = defaultFrontendGhcjsAssets
6762 , _ghcjsApp_value = frontend
@@ -112,11 +107,11 @@ getRouteWith e = do
112107 pageName <- getPageName
113108 return $ tryDecode e pageName
114109
115−serveObeliskApp :: MonadSnap m => StaticAssets -> GhcjsApp (R appRoute) -> R (ObeliskRoute appRoute) -> m ()
116−serveObeliskApp staticAssets frontendApp = \case
110+serveObeliskApp :: MonadSnap m => ([Text] -> m ()) -> GhcjsApp (R appRoute) -> R (ObeliskRoute appRoute) -> m ()
111+serveObeliskApp serveStaticAsset frontendApp = \case
117112 ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp frontendApp $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest
118113 ObeliskRoute_Resource resComponent :=> Identity resRest -> case resComponent :=> Identity resRest of
119− ResourceRoute_Static :=> Identity pathSegments -> serveStaticAssets staticAssets pathSegments
114+ ResourceRoute_Static :=> Identity pathSegments -> serveStaticAsset pathSegments
120115 ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp frontendApp $ GhcjsAppRoute_Resource :/ pathSegments
121116 ResourceRoute_JSaddleWarp :=> Identity _ -> do
122117 let msg = "Error: Obelisk.Backend received jsaddle request"
@@ -151,7 +146,7 @@ runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend
151146 getRouteWith validFullEncoder >>= \case
152147 Identity r -> case r of
153148 InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a
154− InR obeliskRoute :=> Identity a -> serveDefaultObeliskApp frontend $ obeliskRoute :/ a
149+ InR obeliskRoute :=> Identity a -> serveDefaultObeliskApp (serveStaticAssets defaultStaticAssets) frontend $ obeliskRoute :/ a
155150
156151renderGhcjsFrontend :: route -> Frontend route -> IO ByteString
157152renderGhcjsFrontend route f = do
lib/command/src/Obelisk/Command/Run.hs+1−1
@@ -51,7 +51,7 @@ run = do
5151 pkgs <- getLocalPkgs
5252 withGhciScript pkgs $ \dotGhciPath -> do
5353 freePort <- getFreePort
54− runGhcid dotGhciPath $ Just $ unwords ["run", show freePort, "Static.staticRootPath", "Backend.backend", "Frontend.frontend"]
54+ runGhcid dotGhciPath $ Just $ unwords ["run", show freePort, "(runServeAsset Static.staticRootPath)", "Backend.backend", "Frontend.frontend"]
5555
5656runRepl :: MonadObelisk m => m ()
5757runRepl = do
lib/run/obelisk-run.cabal+1
@@ -22,6 +22,7 @@ library
2222 , modern-uri
2323 , mtl
2424 , network
25+ , obelisk-asset-serve-snap
2526 , obelisk-backend
2627 , obelisk-executable-config
2728 , obelisk-executable-config-inject
lib/run/src/Obelisk/Run.hs+9−8
@@ -48,11 +48,13 @@ import Network.Wai.Handler.Warp
4848import Network.Wai.Handler.Warp.Internal (settingsHost, settingsPort)
4949import Network.WebSockets (ConnectionOptions)
5050import Network.WebSockets.Connection (defaultConnectionOptions)
51+import qualified Obelisk.Asset.Serve.Snap as Snap
5152import Obelisk.ExecutableConfig (get)
5253import Obelisk.ExecutableConfig.Inject (injectExecutableConfigs)
5354import Obelisk.Frontend
5455import Obelisk.Route.Frontend
5556import Reflex.Dom.Core
57+import Snap.Core (Snap)
5658import System.Environment
5759import System.IO
5860import System.Process
@@ -63,11 +65,11 @@ import Obelisk.Backend
6365
6466run
6567 :: Int -- ^ Port to run the backend
66− -> FilePath -- ^ Path where the static assets live
68+ -> ([Text] -> Snap ()) -- ^ Static asset handler
6769 -> Backend fullRoute frontendRoute -- ^ Backend
6870 -> Frontend (R frontendRoute) -- ^ Frontend
6971 -> IO ()
70−run port assetsPath backend frontend = do
72+run port serveStaticAsset backend frontend = do
7173 prettifyOutput
7274 let handleBackendErr (e :: IOException) = hPutStrLn stderr $ "backend stopped; make a change to your code to reload - error " <> show e
7375 --TODO: Use Obelisk.Backend.runBackend; this will require separating the checking and running phases
@@ -80,14 +82,13 @@ run port assetsPath backend frontend = do
8082 getRouteWith validFullEncoder >>= \case
8183 Identity r -> case r of
8284 InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a
83− InR obeliskRoute :=> Identity a -> serveDefaultObeliskApp' staticAssets frontend $ obeliskRoute :/ a
85+ InR obeliskRoute :=> Identity a -> serveDefaultObeliskApp serveStaticAsset frontend $ obeliskRoute :/ a
8486 let conf = defRunConfig { _runConfig_redirectPort = port }
8587 runWidget conf frontend validFullEncoder `finally` killThread backendTid
86− where
87− staticAssets = StaticAssets
88− { _staticAssets_processed = assetsPath <> ".assets"
89− , _staticAssets_unprocessed = assetsPath
90− }
88+
89+-- Convenience wrapper to handle path segments for 'Snap.serveAsset'
90+runServeAsset :: FilePath -> [Text] -> Snap ()
91+runServeAsset rootPath = Snap.serveAsset "" rootPath . T.unpack . T.intercalate "/"
9192
9293getConfigRoute :: IO (Maybe URI)
9394getConfigRoute = get "config/common/route" >>= \case