git.iko.soy/obelisk
on master help sign in
Allow more backend customisation
6c7fb9eTom Smalley
default.nix+2
compare with master
unifiedsplit
@@ -120,6 +120,7 @@ in rec {
120 inherit reflex-platform;
120 inherit reflex-platform;
121 inherit (reflex-platform) nixpkgs pinBuildInputs;
121 inherit (reflex-platform) nixpkgs pinBuildInputs;
122 inherit (nixpkgs) lib;
122 inherit (nixpkgs) lib;
123+ inherit mkAssets;
123 pathGit = ./.; # Used in CI by the migration graph hash algorithm to correctly ignore files.
124 pathGit = ./.; # Used in CI by the migration graph hash algorithm to correctly ignore files.
124 path = reflex-platform.filterGit ./.;
125 path = reflex-platform.filterGit ./.;
125 obelisk = ghcObelisk;
126 obelisk = ghcObelisk;
@@ -379,6 +380,7 @@ in rec {
379 linuxExeConfigurable = linuxExe;
380 linuxExeConfigurable = linuxExe;
380 linuxExe = linuxExe dummyVersion;
381 linuxExe = linuxExe dummyVersion;
381 exe = serverOn mainProjectOut dummyVersion;
382 exe = serverOn mainProjectOut dummyVersion;
383+ mkAssets = mkAssets;
382 server = args@{ hostName, adminEmail, routeHost, enableHttps, version }:
384 server = args@{ hostName, adminEmail, routeHost, enableHttps, version }:
383 server (args // { exe = linuxExe version; });
385 server (args // { exe = linuxExe version; });
384 obelisk = import (base' + "/.obelisk/impl") {};
386 obelisk = import (base' + "/.obelisk/impl") {};
lib/backend/src/Obelisk/Backend.hs+17−7
@@ -9,6 +9,7 @@
9{-# OPTIONS_GHC -fno-warn-orphans #-}
9{-# OPTIONS_GHC -fno-warn-orphans #-}
10module Obelisk.Backend
10module Obelisk.Backend
11 ( Backend (..)
11 ( Backend (..)
12+ , StaticAssets (..)
12 -- * Re-exports
13 -- * Re-exports
13 , Default (def)
14 , Default (def)
14 , getPageName
15 , getPageName
@@ -17,6 +18,7 @@ module Obelisk.Backend
17 , serveDefaultObeliskApp
18 , serveDefaultObeliskApp
18 , prettifyOutput
19 , prettifyOutput
19 , runBackend
20 , runBackend
21+ , runBackend'
20 , staticRenderContentType
22 , staticRenderContentType
21 , mkRouteToUrl
23 , mkRouteToUrl
22 , getPublicConfigs
24 , getPublicConfigs
@@ -45,7 +47,7 @@ import Obelisk.Snap.Extras (doNotCache, serveFileIfExistsAs)
45import Reflex.Dom
47import Reflex.Dom
46import Snap (MonadSnap, Snap, commandLineConfig, defaultConfig, getsRequest, httpServe, modifyResponse
48import Snap (MonadSnap, Snap, commandLineConfig, defaultConfig, getsRequest, httpServe, modifyResponse
47 , rqPathInfo, rqQueryString, setContentType, writeBS, writeText
49 , rqPathInfo, rqQueryString, setContentType, writeBS, writeText
48− , rqCookies, Cookie(..) , setHeader)
50+ , rqCookies, Cookie(..) , setHeader, setPort)
49import Snap.Internal.Http.Server.Config (Config (accessLog, errorLog), ConfigLog (ConfigIoLog))
51import Snap.Internal.Http.Server.Config (Config (accessLog, errorLog), ConfigLog (ConfigIoLog))
50import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
52import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
51
53
@@ -97,10 +99,10 @@ defaultFrontendGhcjsAssets = StaticAssets
97 , _staticAssets_unprocessed = "frontend.jsexe"
99 , _staticAssets_unprocessed = "frontend.jsexe"
98 }
100 }
99
101
100−runSnapWithCommandLineArgs :: MonadIO m => Snap () -> m ()
102+runSnapWithCommandLineArgs :: MonadIO m => Maybe Int -> Snap () -> m ()
101−runSnapWithCommandLineArgs a = do
103+runSnapWithCommandLineArgs mPort a = do
102 -- Get the web server configuration from the command line
104 -- Get the web server configuration from the command line
103− cmdLineConf <- liftIO $ commandLineConfig defaultConfig
105+ cmdLineConf <- liftIO $ commandLineConfig $ maybe id setPort mPort defaultConfig
104 let httpConf = cmdLineConf
106 let httpConf = cmdLineConf
105 { accessLog = Just $ ConfigIoLog BSC8.putStrLn
107 { accessLog = Just $ ConfigIoLog BSC8.putStrLn
106 , errorLog = Just $ ConfigIoLog BSC8.putStrLn
108 , errorLog = Just $ ConfigIoLog BSC8.putStrLn
@@ -170,17 +172,25 @@ serveGhcjsApp urlEnc app config = \case
170 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments
172 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments
171
173
172runBackend :: Backend backendRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()
174runBackend :: Backend backendRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()
175+runBackend = runBackend' Nothing defaultStaticAssets
176+
177+runBackend'
178+ :: Maybe Int
179+ -> StaticAssets
180+ -> Backend fullRoute frontendRoute
181+ -> Frontend (R frontendRoute)
182+ -> IO ()
173−runBackend backend frontend = case checkEncoder $ _backend_routeEncoder backend of
183+runBackend' mPort staticAssets backend frontend = case checkEncoder $ _backend_routeEncoder backend of
174 Left e -> fail $ "backend error:\n" <> T.unpack e
184 Left e -> fail $ "backend error:\n" <> T.unpack e
175 Right validFullEncoder -> do
185 Right validFullEncoder -> do
176 publicConfigs <- getPublicConfigs
186 publicConfigs <- getPublicConfigs
177 _backend_run backend $ \serveRoute -> do
187 _backend_run backend $ \serveRoute -> do
178− runSnapWithCommandLineArgs $ do
188+ runSnapWithCommandLineArgs mPort $ do
179 getRouteWith validFullEncoder >>= \case
189 getRouteWith validFullEncoder >>= \case
180 Identity r -> case r of
190 Identity r -> case r of
181 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a
191 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a
182 FullRoute_Frontend obeliskRoute :/ a ->
192 FullRoute_Frontend obeliskRoute :/ a ->
183− serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets defaultStaticAssets) frontend publicConfigs $
193+ serveDefaultObeliskApp (mkRouteToUrl validFullEncoder) (serveStaticAssets staticAssets) frontend publicConfigs $
184 obeliskRoute :/ a
194 obeliskRoute :/ a
185
195
186mkRouteToUrl :: Encoder Identity parse (R (FullRoute br fr)) PageName -> R fr -> Text
196mkRouteToUrl :: 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
92 publicConfigs <- getPublicConfigs
92 publicConfigs <- getPublicConfigs
93 backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] $ do
93 backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] $ do
94 _backend_run backend $ \serveRoute -> do
94 _backend_run backend $ \serveRoute -> do
95− runSnapWithCommandLineArgs $ do
95+ runSnapWithCommandLineArgs Nothing $ do
96 getRouteWith validFullEncoder >>= \case
96 getRouteWith validFullEncoder >>= \case
97 Identity r -> case r of
97 Identity r -> case r of
98 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a
98 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a