git.iko.soy/jsaddle
on master help sign in
Adds `debugOr`, to run the debug server with another WAI application.
1d84010Dave Laing
jsaddle-warp/src/Language/Javascript/JSaddle/WebSockets.hs+17−3
compare with master
unifiedsplit
@@ -20,10 +20,12 @@ module Language.Javascript.JSaddle.WebSockets (
20 , jsaddleApp
20 , jsaddleApp
21 , jsaddleWithAppOr
21 , jsaddleWithAppOr
22 , jsaddleAppWithJs
22 , jsaddleAppWithJs
23+ , jsaddleAppWithJsOr
23 , jsaddleAppPartial
24 , jsaddleAppPartial
24 , jsaddleJs
25 , jsaddleJs
25 , jsaddleJs'
26 , jsaddleJs'
26 , debug
27 , debug
28+ , debugOr
27 , debugWrapper
29 , debugWrapper
28) where
30) where
29
31
@@ -129,9 +131,14 @@ jsaddleApp = jsaddleAppWithJs $ jsaddleJs False
129
131
130jsaddleAppWithJs :: ByteString -> Application
132jsaddleAppWithJs :: ByteString -> Application
131jsaddleAppWithJs js req sendResponse =
133jsaddleAppWithJs js req sendResponse =
132− fromMaybe
134+ jsaddleAppWithJsOr js
133− (sendResponse $ W.responseLBS H.status403 [("Content-Type", "text/plain")] "Forbidden")
135+ (\_ _ -> sendResponse $ W.responseLBS H.status403 [("Content-Type", "text/plain")] "Forbidden")
136+ req sendResponse
137+
138+jsaddleAppWithJsOr :: ByteString -> Application -> Application
139+jsaddleAppWithJsOr js otherApp req sendResponse =
140+ fromMaybe (otherApp req sendResponse)
134− (jsaddleAppPartialWithJs js req sendResponse)
141+ (jsaddleAppPartialWithJs js req sendResponse)
135
142
136jsaddleWithAppOr :: ConnectionOptions -> JSM () -> Application -> IO Application
143jsaddleWithAppOr :: ConnectionOptions -> JSM () -> Application -> IO Application
137jsaddleWithAppOr opts entryPoint otherApp = jsaddleOr opts entryPoint $ \req sendResponse ->
144jsaddleWithAppOr opts entryPoint otherApp = jsaddleOr opts entryPoint $ \req sendResponse ->
@@ -223,6 +230,13 @@ debug port f = do
223 jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJs $ jsaddleJs True)
230 jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJs $ jsaddleJs True)
224 putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"
231 putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"
225
232
233+debugOr :: Int -> JSM () -> Application -> IO ()
234+debugOr port f b = do
235+ debugWrapper $ \withRefresh registerContext ->
236+ runSettings (setPort port (setTimeout 3600 defaultSettings)) =<<
237+ jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJsOr (jsaddleJs True) b)
238+ putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"
239+
226refreshMiddleware :: ((Response -> IO ResponseReceived) -> IO ResponseReceived) -> Middleware
240refreshMiddleware :: ((Response -> IO ResponseReceived) -> IO ResponseReceived) -> Middleware
227refreshMiddleware refresh otherApp req sendResponse = case (W.requestMethod req, W.pathInfo req) of
241refreshMiddleware refresh otherApp req sendResponse = case (W.requestMethod req, W.pathInfo req) of
228 ("POST", ["reload", _syncKey]) -> refresh sendResponse
242 ("POST", ["reload", _syncKey]) -> refresh sendResponse