git.iko.soy/obelisk
on master help sign in
Add a backend check step prior to running the backend
5dfd178Ryan Trinkle
lib/backend/src/Obelisk/Backend.hs+28−26
compare with master
unifiedsplit
@@ -66,38 +66,40 @@ backend
66 :: ( Universe (R route) --TODO: This seems wrong - should be Universe (Some route)
66 :: ( Universe (R route) --TODO: This seems wrong - should be Universe (Some route)
67 , OrdTag route Identity
67 , OrdTag route Identity
68 , ShowTag route Identity
68 , ShowTag route Identity
69+ , check ~ Either Text --TODO: Replace with MonadError Text check
69 )
70 )
70 => BackendConfig route
71 => BackendConfig route
71− -> IO ()
72+ -> check (IO ())
72backend cfg = do
73backend cfg = do
74+ getRequestRoute <- checkGetRequestRoute $ _backendConfig_routeEncoder cfg --TODO: Report error better
75+ return $ do
73− -- Make output more legible by decreasing the likelihood of output from
76+ -- Make output more legible by decreasing the likelihood of output from
74− -- multiple threads being interleaved
77+ -- multiple threads being interleaved
75− hSetBuffering stdout LineBuffering
78+ hSetBuffering stdout LineBuffering
76− hSetBuffering stderr LineBuffering
79+ hSetBuffering stderr LineBuffering
77
80
78− -- Get the web server configuration from the command line
81+ -- Get the web server configuration from the command line
79− cmdLineConf <- commandLineConfig defaultConfig
82+ cmdLineConf <- commandLineConfig defaultConfig
80− let httpConf = cmdLineConf
83+ let httpConf = cmdLineConf
81− { accessLog = Just $ ConfigIoLog BSC8.putStrLn
84+ { accessLog = Just $ ConfigIoLog BSC8.putStrLn
82− , errorLog = Just $ ConfigIoLog BSC8.putStrLn
85+ , errorLog = Just $ ConfigIoLog BSC8.putStrLn
83− }
84− let Right getRequestRoute = checkGetRequestRoute $ _backendConfig_routeEncoder cfg --TODO: Report error better
85− -- Start the web server
86− httpServe httpConf $ do
87− let staticAssets = StaticAssets
88− { _staticAssets_processed = "static.jsexe.assets"
89− , _staticAssets_unprocessed = "static.jsexe"
90 }
86 }
91− frontendApp = GhcjsApp
87+ -- Start the web server
88+ httpServe httpConf $ do
92− { _ghcjsApp_compiled = StaticAssets
89+ let staticAssets = StaticAssets
93− { _staticAssets_processed = "frontend.jsexe.assets"
90+ { _staticAssets_processed = "static.jsexe.assets"
94− , _staticAssets_unprocessed = "frontend.jsexe"
91+ , _staticAssets_unprocessed = "static.jsexe"
95 }
92 }
93+ frontendApp = GhcjsApp
94+ { _ghcjsApp_compiled = StaticAssets
95+ { _staticAssets_processed = "frontend.jsexe.assets"
96+ , _staticAssets_unprocessed = "frontend.jsexe"
97+ }
96− , _ghcjsApp_value = _backendConfig_frontend cfg
98+ , _ghcjsApp_value = _backendConfig_frontend cfg
97− }
99+ }
98− getRequestRoute >>= \case
100+ getRequestRoute >>= \case
99− Left e -> writeText e
101+ Left e -> writeText e
100− Right r -> serveObeliskRoute staticAssets frontendApp r
102+ Right r -> serveObeliskRoute staticAssets frontendApp r
101
103
102checkGetRequestRoute :: (MonadSnap m, Monad check, MonadError Text parse) => Encoder check parse route PageName -> check (m (parse route))
104checkGetRequestRoute :: (MonadSnap m, Monad check, MonadError Text parse) => Encoder check parse route PageName -> check (m (parse route))
103checkGetRequestRoute routeEncoder = do
105checkGetRequestRoute routeEncoder = do
lib/run/src/Obelisk/Run.hs+16−9
@@ -68,16 +68,23 @@ import Text.URI (URI)
68import qualified Text.URI as URI
68import qualified Text.URI as URI
69import Text.URI.Lens
69import Text.URI.Lens
70
70
71+run
71−run :: (Universe route, Ord route, Show route)
72+ :: ( Universe route
73+ , Ord route
74+ , Show route
75+ )
72− => Int -- ^ Port to run the backend
76+ => Int -- ^ Port to run the backend
73− -> IO () -- ^ Backend
77+ -> Either Text (IO ()) -- ^ Backend
74− -> Frontend route -- ^ Frontend
78+ -> Frontend route -- ^ Frontend
75− -> IO ()
79+ -> IO ()
76−run port backend frontend = do
80+run port checkBackend frontend = do
77 let handleBackendErr (e :: IOException) = hPutStrLn stderr $ "backend stopped; make a change to your code to reload - error " <> show e
81 let handleBackendErr (e :: IOException) = hPutStrLn stderr $ "backend stopped; make a change to your code to reload - error " <> show e
82+ case checkBackend of
83+ Left e -> hPutStrLn stderr $ "backend error:\n" <> T.unpack e
84+ Right backend -> do
78− backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] backend
85+ backendTid <- forkIO $ handle handleBackendErr $ withArgs ["--quiet", "--port", show port] backend
79− let conf = defRunConfig { _runConfig_redirectPort = port }
86+ let conf = defRunConfig { _runConfig_redirectPort = port }
80− runWidget conf frontend `finally` killThread backendTid
87+ runWidget conf frontend `finally` killThread backendTid
81
88
82getConfigRoute :: IO (Maybe URI)
89getConfigRoute :: IO (Maybe URI)
83getConfigRoute = get "common/route" >>= \case
90getConfigRoute = get "common/route" >>= \case