@@ -20,10 +20,12 @@ module Language.Javascript.JSaddle.WebSockets (
2020 , jsaddleApp
2121 , jsaddleWithAppOr
2222 , jsaddleAppWithJs
23+ , jsaddleAppWithJsOr
2324 , jsaddleAppPartial
2425 , jsaddleJs
2526 , jsaddleJs'
2627 , debug
28+ , debugOr
2729 , debugWrapper
2830) where
2931
@@ -129,9 +131,14 @@ jsaddleApp = jsaddleAppWithJs $ jsaddleJs False
129131
130132jsaddleAppWithJs :: ByteString -> Application
131133jsaddleAppWithJs js req sendResponse =
132− fromMaybe
133− (sendResponse $ W.responseLBS H.status403 [("Content-Type", "text/plain")] "Forbidden")
134− (jsaddleAppPartialWithJs js req sendResponse)
134+ jsaddleAppWithJsOr js
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)
141+ (jsaddleAppPartialWithJs js req sendResponse)
135142
136143jsaddleWithAppOr :: ConnectionOptions -> JSM () -> Application -> IO Application
137144jsaddleWithAppOr opts entryPoint otherApp = jsaddleOr opts entryPoint $ \req sendResponse ->
@@ -223,6 +230,13 @@ debug port f = do
223230 jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJs $ jsaddleJs True)
224231 putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"
225232
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+
226240refreshMiddleware :: ((Response -> IO ResponseReceived) -> IO ResponseReceived) -> Middleware
227241refreshMiddleware refresh otherApp req sendResponse = case (W.requestMethod req, W.pathInfo req) of
228242 ("POST", ["reload", _syncKey]) -> refresh sendResponse