git.iko.soy/obelisk
on master help sign in
Allow more backend customisation
commit6c7fb9ee7e8ade9a5aa84a480e43f809355d00a5 authorTom Smalley <tfsmalley@gmail.com> dateThu 20 Jun 2019, 14:10 (7 years ago) parent5d8b781
3 files changed+20−8
compare with master
unifiedsplit
default.nix+2 lib/backend/src/Obelisk/Backend.hs+17−7 lib/run/src/Obelisk/Run.hs+1−1
default.nix+2
@@ -120,6 +120,7 @@ in rec {
120120 inherit reflex-platform;
121121 inherit (reflex-platform) nixpkgs pinBuildInputs;
122122 inherit (nixpkgs) lib;
123+ inherit mkAssets;
123124 pathGit = ./.; # Used in CI by the migration graph hash algorithm to correctly ignore files.
124125 path = reflex-platform.filterGit ./.;
125126 obelisk = ghcObelisk;
@@ -379,6 +380,7 @@ in rec {
379380 linuxExeConfigurable = linuxExe;
380381 linuxExe = linuxExe dummyVersion;
381382 exe = serverOn mainProjectOut dummyVersion;
383+ mkAssets = mkAssets;
382384 server = args@{ hostName, adminEmail, routeHost, enableHttps, version }:
383385 server (args // { exe = linuxExe version; });
384386 obelisk = import (base' + "/.obelisk/impl") {};
lib/backend/src/Obelisk/Backend.hs+17−7
@@ -9,6 +9,7 @@
99{-# OPTIONS_GHC -fno-warn-orphans #-}
1010module Obelisk.Backend
1111 ( Backend (..)
12+ , StaticAssets (..)
1213 -- * Re-exports
1314 , Default (def)
1415 , getPageName
@@ -17,6 +18,7 @@ module Obelisk.Backend
1718 , serveDefaultObeliskApp
1819 , prettifyOutput
1920 , runBackend
21+ , runBackend'
2022 , staticRenderContentType
2123 , mkRouteToUrl
2224 , getPublicConfigs
@@ -45,7 +47,7 @@ import Obelisk.Snap.Extras (doNotCache, serveFileIfExistsAs)
4547import Reflex.Dom
4648import Snap (MonadSnap, Snap, commandLineConfig, defaultConfig, getsRequest, httpServe, modifyResponse
4749 , rqPathInfo, rqQueryString, setContentType, writeBS, writeText
48− , rqCookies, Cookie(..) , setHeader)
50+ , rqCookies, Cookie(..) , setHeader, setPort)
4951import Snap.Internal.Http.Server.Config (Config (accessLog, errorLog), ConfigLog (ConfigIoLog))
5052import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
5153
@@ -97,10 +99,10 @@ defaultFrontendGhcjsAssets = StaticAssets
9799 , _staticAssets_unprocessed = "frontend.jsexe"
98100 }
99101
100−runSnapWithCommandLineArgs :: MonadIO m => Snap () -> m ()
101−runSnapWithCommandLineArgs a = do
102+runSnapWithCommandLineArgs :: MonadIO m => Maybe Int -> Snap () -> m ()
103+runSnapWithCommandLineArgs mPort a = do
102104 -- Get the web server configuration from the command line
103− cmdLineConf <- liftIO $ commandLineConfig defaultConfig
105+ cmdLineConf <- liftIO $ commandLineConfig $ maybe id setPort mPort defaultConfig
104106 let httpConf = cmdLineConf
105107 { accessLog = Just $ ConfigIoLog BSC8.putStrLn
106108 , errorLog = Just $ ConfigIoLog BSC8.putStrLn
@@ -170,17 +172,25 @@ serveGhcjsApp urlEnc app config = \case
170172 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments
171173
172174runBackend :: Backend backendRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()
173−runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend of
175+runBackend = runBackend' Nothing defaultStaticAssets
176+
177+runBackend'
178+ :: Maybe Int
179+ -> StaticAssets
180+ -> Backend fullRoute frontendRoute
181+ -> Frontend (R frontendRoute)
182+ -> IO ()
183+runBackend' mPort staticAssets backend frontend = case checkEncoder $ _backend_routeEncoder backend of
174184 Left e -> fail $ "backend error:\n" <> T.unpack e
175185 Right validFullEncoder -> do
176186 publicConfigs <- getPublicConfigs
177187 _backend_run backend $ \serveRoute -> do
178− runSnapWithCommandLineArgs $ do
188+ runSnapWithCommandLineArgs mPort $ do
179189 getRouteWith validFullEncoder >>= \case
180190 Identity r -> case r of
181191 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a
182192 FullRoute_Frontend obeliskRoute :/ a ->
183− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets defaultStaticAssets) frontend publicConfigs $
193+ serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets staticAssets) frontend publicConfigs $
184194 obeliskRoute :/ a
185195
186196mkRouteToUrl :: Encoder Identity parse (R (FullRoute br fr)) PageName -> R fr -> Text
lib/run/src/Obelisk/Run.hs+1−1
@@ -92,7 +92,7 @@ run port serveStaticAsset backend frontend = do
9292 publicConfigs <- getPublicConfigs
9393 backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] $ do
9494 _backend_run backend $ \serveRoute -> do
95− runSnapWithCommandLineArgs $ do
95+ runSnapWithCommandLineArgs Nothing $ do
9696 getRouteWith validFullEncoder >>= \case
9797 Identity r -> case r of
9898 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a