09ba367 · obelisk · git.iko.soy

git.iko.soy/obelisk

on master help sign in

run: Take an asset handler in favor of passing a filepath

09ba367Luigy Leon8 years ago

lib/backend/src/Obelisk/Backend.hs+6−11

compare with master

unifiedsplit

@@ -8,8 +8,6 @@

8{-# LANGUAGE TemplateHaskell #-}

9module Obelisk.Backend

10 ( Backend (..)

11− , StaticAssets (..)

12− , serveDefaultObeliskApp'

13 -- * Re-exports

11 -- * Re-exports

14 , Default (def)

12 , Default (def)

15 , getPageName

13 , getPageName

@@ -57,11 +55,8 @@ data GhcjsApp route = GhcjsApp

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

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

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

57--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 ()

58+serveDefaultObeliskApp :: MonadSnap m => ([Text] -> m ()) -> Frontend (R appRoute) -> R (ObeliskRoute appRoute) -> m ()

64−serveDefaultObeliskApp' staticAssets frontend = serveObeliskApp staticAssets frontendApp

59+serveDefaultObeliskApp serveStaticAsset frontend = serveObeliskApp serveStaticAsset frontendApp

65 where frontendApp = GhcjsApp

60 where frontendApp = GhcjsApp

66 { _ghcjsApp_compiled = defaultFrontendGhcjsAssets

61 { _ghcjsApp_compiled = defaultFrontendGhcjsAssets

67 , _ghcjsApp_value = frontend

62 , _ghcjsApp_value = frontend

@@ -112,11 +107,11 @@ getRouteWith e = do

112 pageName <- getPageName

107 pageName <- getPageName

113 return $ tryDecode e pageName

108 return $ tryDecode e pageName

114

109

115−serveObeliskApp :: MonadSnap m => StaticAssets -> GhcjsApp (R appRoute) -> R (ObeliskRoute appRoute) -> m ()

110+serveObeliskApp :: MonadSnap m => ([Text] -> m ()) -> GhcjsApp (R appRoute) -> R (ObeliskRoute appRoute) -> m ()

116−serveObeliskApp staticAssets frontendApp = \case

111+serveObeliskApp serveStaticAsset frontendApp = \case

117 ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp frontendApp $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest

112 ObeliskRoute_App appRouteComponent :=> Identity appRouteRest -> serveGhcjsApp frontendApp $ GhcjsAppRoute_App appRouteComponent :/ appRouteRest

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

113 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

120 ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp frontendApp $ GhcjsAppRoute_Resource :/ pathSegments

115 ResourceRoute_Ghcjs :=> Identity pathSegments -> serveGhcjsApp frontendApp $ GhcjsAppRoute_Resource :/ pathSegments

121 ResourceRoute_JSaddleWarp :=> Identity _ -> do

116 ResourceRoute_JSaddleWarp :=> Identity _ -> do

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

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

@@ -151,7 +146,7 @@ runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend

151 getRouteWith validFullEncoder >>= \case

146 getRouteWith validFullEncoder >>= \case

152 Identity r -> case r of

147 Identity r -> case r of

153 InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a

148 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

155

150

156renderGhcjsFrontend :: route -> Frontend route -> IO ByteString

151renderGhcjsFrontend :: route -> Frontend route -> IO ByteString

157renderGhcjsFrontend route f = do

152renderGhcjsFrontend route f = do

lib/command/src/Obelisk/Command/Run.hs+1−1

@@ -51,7 +51,7 @@ run = do

51 pkgs <- getLocalPkgs

52 withGhciScript pkgs $ \dotGhciPath -> do

53 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"]

56runRepl :: MonadObelisk m => m ()

57runRepl = do

lib/run/obelisk-run.cabal+1

@@ -22,6 +22,7 @@ library

22 , modern-uri

23 , mtl

24 , network

25+ , obelisk-asset-serve-snap

25 , obelisk-backend

26 , obelisk-backend

26 , obelisk-executable-config

27 , obelisk-executable-config

27 , obelisk-executable-config-inject

28 , obelisk-executable-config-inject

lib/run/src/Obelisk/Run.hs+9−8

@@ -48,11 +48,13 @@ import Network.Wai.Handler.Warp

48import Network.Wai.Handler.Warp.Internal (settingsHost, settingsPort)

49import Network.WebSockets (ConnectionOptions)

50import Network.WebSockets.Connection (defaultConnectionOptions)

51+import qualified Obelisk.Asset.Serve.Snap as Snap

51import Obelisk.ExecutableConfig (get)

52import Obelisk.ExecutableConfig (get)

52import Obelisk.ExecutableConfig.Inject (injectExecutableConfigs)

53import Obelisk.ExecutableConfig.Inject (injectExecutableConfigs)

53import Obelisk.Frontend

54import Obelisk.Frontend

54import Obelisk.Route.Frontend

55import Obelisk.Route.Frontend

55import Reflex.Dom.Core

56import Reflex.Dom.Core

57+import Snap.Core (Snap)

56import System.Environment

58import System.Environment

57import System.IO

59import System.IO

58import System.Process

60import System.Process

@@ -63,11 +65,11 @@ import Obelisk.Backend

64run

66run

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

67 :: Int -- ^ Port to run the backend

66− -> FilePath -- ^ Path where the static assets live

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

67 -> Backend fullRoute frontendRoute -- ^ Backend

69 -> Backend fullRoute frontendRoute -- ^ Backend

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

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

69 -> IO ()

71 -> IO ()

70−run port assetsPath backend frontend = do

72+run port serveStaticAsset backend frontend = do

71 prettifyOutput

73 prettifyOutput

72 let handleBackendErr (e :: IOException) = hPutStrLn stderr $ "backend stopped; make a change to your code to reload - error " <> show e

74 let handleBackendErr (e :: IOException) = hPutStrLn stderr $ "backend stopped; make a change to your code to reload - error " <> show e

73 --TODO: Use Obelisk.Backend.runBackend; this will require separating the checking and running phases

75 --TODO: Use Obelisk.Backend.runBackend; this will require separating the checking and running phases

@@ -80,14 +82,13 @@ run port assetsPath backend frontend = do

80 getRouteWith validFullEncoder >>= \case

82 getRouteWith validFullEncoder >>= \case

81 Identity r -> case r of

83 Identity r -> case r of

82 InL backendRoute :=> Identity a -> serveRoute $ backendRoute :/ a

84 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

84 let conf = defRunConfig { _runConfig_redirectPort = port }

86 let conf = defRunConfig { _runConfig_redirectPort = port }

85 runWidget conf frontend validFullEncoder `finally` killThread backendTid

87 runWidget conf frontend validFullEncoder `finally` killThread backendTid

86− where

88+

87− staticAssets = StaticAssets

89+-- Convenience wrapper to handle path segments for 'Snap.serveAsset'

88− { _staticAssets_processed = assetsPath <> ".assets"

90+runServeAsset :: FilePath -> [Text] -> Snap ()

89− , _staticAssets_unprocessed = assetsPath

91+runServeAsset rootPath = Snap.serveAsset "" rootPath . T.unpack . T.intercalate "/"

90− }

92getConfigRoute :: IO (Maybe URI)

93getConfigRoute :: IO (Maybe URI)

93getConfigRoute = get "config/common/route" >>= \case

94getConfigRoute = get "config/common/route" >>= \case