@@ -66,38 +66,40 @@ backend
6666 :: ( Universe (R route) --TODO: This seems wrong - should be Universe (Some route)
6767 , OrdTag route Identity
6868 , ShowTag route Identity
69+ , check ~ Either Text --TODO: Replace with MonadError Text check
6970 )
7071 => BackendConfig route
71− -> IO ()
72+ -> check (IO ())
7273backend cfg = do
73− -- Make output more legible by decreasing the likelihood of output from
74− -- multiple threads being interleaved
75− hSetBuffering stdout LineBuffering
76− hSetBuffering stderr LineBuffering
74+ getRequestRoute <- checkGetRequestRoute $ _backendConfig_routeEncoder cfg --TODO: Report error better
75+ return $ do
76+ -- Make output more legible by decreasing the likelihood of output from
77+ -- multiple threads being interleaved
78+ hSetBuffering stdout LineBuffering
79+ hSetBuffering stderr LineBuffering
7780
78− -- Get the web server configuration from the command line
79− cmdLineConf <- commandLineConfig defaultConfig
80− let httpConf = cmdLineConf
81− { accessLog = Just $ ConfigIoLog BSC8.putStrLn
82− , 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"
81+ -- Get the web server configuration from the command line
82+ cmdLineConf <- commandLineConfig defaultConfig
83+ let httpConf = cmdLineConf
84+ { accessLog = Just $ ConfigIoLog BSC8.putStrLn
85+ , errorLog = Just $ ConfigIoLog BSC8.putStrLn
9086 }
91− frontendApp = GhcjsApp
92− { _ghcjsApp_compiled = StaticAssets
93− { _staticAssets_processed = "frontend.jsexe.assets"
94− , _staticAssets_unprocessed = "frontend.jsexe"
87+ -- Start the web server
88+ httpServe httpConf $ do
89+ let staticAssets = StaticAssets
90+ { _staticAssets_processed = "static.jsexe.assets"
91+ , _staticAssets_unprocessed = "static.jsexe"
9592 }
96− , _ghcjsApp_value = _backendConfig_frontend cfg
97− }
98− getRequestRoute >>= \case
99− Left e -> writeText e
100− Right r -> serveObeliskRoute staticAssets frontendApp r
93+ frontendApp = GhcjsApp
94+ { _ghcjsApp_compiled = StaticAssets
95+ { _staticAssets_processed = "frontend.jsexe.assets"
96+ , _staticAssets_unprocessed = "frontend.jsexe"
97+ }
98+ , _ghcjsApp_value = _backendConfig_frontend cfg
99+ }
100+ getRequestRoute >>= \case
101+ Left e -> writeText e
102+ Right r -> serveObeliskRoute staticAssets frontendApp r
101103
102104checkGetRequestRoute :: (MonadSnap m, Monad check, MonadError Text parse) => Encoder check parse route PageName -> check (m (parse route))
103105checkGetRequestRoute routeEncoder = do