@@ -15,10 +15,11 @@ module Obelisk.Backend
1515 , getPageName
1616 , getRouteWith
1717 , runSnapWithCommandLineArgs
18+ , runSnapWithConfig
1819 , serveDefaultObeliskApp
1920 , prettifyOutput
2021 , runBackend
21− , runBackend'
22+ , runBackendWith
2223 , staticRenderContentType
2324 , mkRouteToUrl
2425 , getPublicConfigs
@@ -47,7 +48,7 @@ import Obelisk.Snap.Extras (doNotCache, serveFileIfExistsAs)
4748import Reflex.Dom
4849import Snap (MonadSnap, Snap, commandLineConfig, defaultConfig, getsRequest, httpServe, modifyResponse
4950 , rqPathInfo, rqQueryString, setContentType, writeBS, writeText
50− , rqCookies, Cookie(..) , setHeader, setPort)
51+ , rqCookies, Cookie(..) , setHeader)
5152import Snap.Internal.Http.Server.Config (Config (accessLog, errorLog), ConfigLog (ConfigIoLog))
5253import System.IO (BufferMode (..), hSetBuffering, stderr, stdout)
5354
@@ -99,17 +100,20 @@ defaultFrontendGhcjsAssets = StaticAssets
99100 , _staticAssets_unprocessed = "frontend.jsexe"
100101 }
101102
102−runSnapWithCommandLineArgs :: MonadIO m => Maybe Int -> Snap () -> m ()
103−runSnapWithCommandLineArgs mPort a = do
104− -- Get the web server configuration from the command line
105− cmdLineConf <- liftIO $ commandLineConfig $ maybe id setPort mPort defaultConfig
106− let httpConf = cmdLineConf
103+runSnapWithConfig :: MonadIO m => Config Snap a -> Snap () -> m ()
104+runSnapWithConfig conf a = do
105+ let httpConf = conf
107106 { accessLog = Just $ ConfigIoLog BSC8.putStrLn
108107 , errorLog = Just $ ConfigIoLog BSC8.putStrLn
109108 }
110109 -- Start the web server
111110 liftIO $ httpServe httpConf a
112111
112+-- Get the web server configuration from the command line
113+runSnapWithCommandLineArgs :: MonadIO m => Snap () -> m ()
114+runSnapWithCommandLineArgs s = liftIO (commandLineConfig defaultConfig) >>= \c ->
115+ runSnapWithConfig c s
116+
113117getPageName :: (MonadSnap m) => m PageName
114118getPageName = do
115119 p <- getsRequest rqPathInfo
@@ -171,21 +175,28 @@ serveGhcjsApp urlEnc app config = \case
171175 writeBS <=< renderGhcjsFrontend urlEnc (appRouteComponent :/ appRouteRest) config $ _ghcjsApp_value app
172176 GhcjsAppRoute_Resource :=> Identity pathSegments -> serveStaticAssets (_ghcjsApp_compiled app) pathSegments
173177
178+-- | Run an obelisk backend
174179runBackend :: Backend backendRoute frontendRoute -> Frontend (R frontendRoute) -> IO ()
175−runBackend = runBackend' Nothing defaultStaticAssets
180+runBackend = runBackendWith runSnapWithCommandLineArgs defaultStaticAssets
176181
177−runBackend'
178− :: Maybe Int
182+-- | Run an obelisk backend using the given function to run the snap monad and
183+-- custom static assets
184+runBackendWith
185+ :: (Snap () -> IO ())
186+ -- ^ Run the snap server
179187 -> StaticAssets
188+ -- ^ Use these assets
180189 -> Backend fullRoute frontendRoute
190+ -- ^ Backend to run
181191 -> Frontend (R frontendRoute)
192+ -- ^ Corresponding frontend (for static rendering)
182193 -> IO ()
183−runBackend' mPort staticAssets backend frontend = case checkEncoder $ _backend_routeEncoder backend of
194+runBackendWith runSnap staticAssets backend frontend = case checkEncoder $ _backend_routeEncoder backend of
184195 Left e -> fail $ "backend error:\n" <> T.unpack e
185196 Right validFullEncoder -> do
186197 publicConfigs <- getPublicConfigs
187198 _backend_run backend $ \serveRoute -> do
188− runSnapWithCommandLineArgs mPort $ do
199+ runSnap $ do
189200 getRouteWith validFullEncoder >>= \case
190201 Identity r -> case r of
191202 FullRoute_Backend backendRoute :/ a -> serveRoute $ backendRoute :/ a