@@ -115,10 +115,13 @@ jsaddleOr opts entryPoint otherApp = do
115115
116116
117117jsaddleApp :: Application
118−jsaddleApp req sendResponse =
118+jsaddleApp = jsaddleAppWithJs $ jsaddleJs False
119+
120+jsaddleAppWithJs :: ByteString -> Application
121+jsaddleAppWithJs js req sendResponse =
119122 fromMaybe
120123 (sendResponse $ W.responseLBS H.status403 [("Content-Type", "text/plain")] "Forbidden")
121− (jsaddleAppPartial req sendResponse)
124+ (jsaddleAppPartialWithJs js req sendResponse)
122125
123126jsaddleWithAppOr :: ConnectionOptions -> JSM () -> Application -> IO Application
124127jsaddleWithAppOr opts entryPoint otherApp = jsaddleOr opts entryPoint $ \req sendResponse ->
@@ -126,15 +129,18 @@ jsaddleWithAppOr opts entryPoint otherApp = jsaddleOr opts entryPoint $ \req sen
126129 (jsaddleAppPartial req sendResponse))
127130
128131jsaddleAppPartial :: Request -> (Response -> IO ResponseReceived) -> Maybe (IO ResponseReceived)
129−jsaddleAppPartial req sendResponse = case (W.requestMethod req, W.pathInfo req) of
132+jsaddleAppPartial = jsaddleAppPartialWithJs $ jsaddleJs False
133+
134+jsaddleAppPartialWithJs :: ByteString -> Request -> (Response -> IO ResponseReceived) -> Maybe (IO ResponseReceived)
135+jsaddleAppPartialWithJs js req sendResponse = case (W.requestMethod req, W.pathInfo req) of
130136 ("GET", []) -> Just $ sendResponse $ W.responseLBS H.status200 [("Content-Type", "text/html")] indexHtml
131− ("GET", ["jsaddle.js"]) -> Just $ sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] jsaddleJs
137+ ("GET", ["jsaddle.js"]) -> Just $ sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/javascript")] js
132138 _ -> Nothing
133139
134140-- Use this to generate this string for embedding
135141-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy
136−jsaddleJs :: ByteString
137−jsaddleJs = "\
142+jsaddleJs :: Bool -> ByteString
143+jsaddleJs refreshOnLoad = "\
138144 \if(typeof global !== \"undefined\") {\n\
139145 \ global.window = global;\n\
140146 \ global.WebSocket = require('ws');\n\
@@ -156,15 +162,17 @@ jsaddleJs = "\
156162 \ return;\n\
157163 \ }\n\
158164 \ if(typeof batch === \"string\") {\n\
159− \ syncKey = batch;\n\
160− \ var xhr = new XMLHttpRequest();\n\
161− \ xhr.open('POST', '/reload/'+syncKey, true);\n\
162− \ xhr.onreadystatechange = function() {\n\
163− \ if(xhr.readyState === XMLHttpRequest.DONE && xhr.status === 200)\n\
164− \ setTimeout(function(){window.location.reload();}, 500);\n\
165− \ };\n\
166− \ xhr.send();\n\
167− \ return;\n\
165+ \ syncKey = batch;\n" <>
166+ (if refreshOnLoad
167+ then " var xhr = new XMLHttpRequest();\n\
168+ \ xhr.open('POST', '/reload/'+syncKey, true);\n\
169+ \ xhr.onreadystatechange = function() {\n\
170+ \ if(xhr.readyState === XMLHttpRequest.DONE && xhr.status === 200)\n\
171+ \ setTimeout(function(){window.location.reload();}, 500);\n\
172+ \ };\n\
173+ \ xhr.send();\n"
174+ else "") <>
175+ " return;\n\
168176 \ }\n\
169177 \\n\
170178 \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));")
@@ -190,26 +198,28 @@ jsaddleJs = "\
190198-- > :def! reload (const $ return "::reload\nLanguage.Javascript.JSaddle.Warp.debug 3708 SomeMainModule.someMainFunction")
191199debug :: Int -> JSM () -> IO ()
192200debug port f = do
193− debugWrapper $ \refreshMiddleware registerContext ->
201+ debugWrapper $ \withRefresh registerContext ->
194202 runSettings (setPort port (setTimeout 3600 defaultSettings)) =<<
195− jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (refreshMiddleware jsaddleApp)
203+ jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJs $ jsaddleJs True)
196204 putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"
197205
206+refreshMiddleware :: ((Response -> IO ResponseReceived) -> IO ResponseReceived) -> Middleware
207+refreshMiddleware refresh otherApp req sendResponse = case (W.requestMethod req, W.pathInfo req) of
208+ ("POST", ["reload", _syncKey]) -> refresh sendResponse
209+ _ -> otherApp req sendResponse
210+
198211debugWrapper :: (Middleware -> JSM () -> IO ()) -> IO ()
199212debugWrapper run = do
200213 reloadMVar <- newEmptyMVar
201214 reloadDoneMVars <- newMVar []
202215 contexts <- newMVar []
203− let refreshMiddleware :: Middleware
204− refreshMiddleware otherApp req sendResponse = case (W.requestMethod req, W.pathInfo req) of
205− ("POST", ["reload", _syncKey]) -> do
206− reloadDone <- newEmptyMVar
207− modifyMVar_ reloadDoneMVars (return . (reloadDone:))
208− readMVar reloadMVar
209− r <- sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/json")] ("reload" :: ByteString)
210− putMVar reloadDone ()
211− return r
212− _ -> otherApp req sendResponse
216+ let refresh sendResponse = do
217+ reloadDone <- newEmptyMVar
218+ modifyMVar_ reloadDoneMVars (return . (reloadDone:))
219+ readMVar reloadMVar
220+ r <- sendResponse $ W.responseLBS H.status200 [("Content-Type", "application/json")] ("reload" :: ByteString)
221+ putMVar reloadDone ()
222+ return r
213223 start :: Int -> IO (IO Int)
214224 start expectedConnections = do
215225 serverDone <- newEmptyMVar
@@ -221,7 +231,7 @@ debugWrapper run = do
221231 addContext
222232 when (browsersConnected == expectedConnections) . void . liftIO $ tryPutMVar ready ()
223233 thread <- forkIO $
224− finally (run refreshMiddleware registerContext)
234+ finally (run (refreshMiddleware refresh) registerContext)
225235 (putMVar serverDone ())
226236 _ <- forkIO $ threadDelay 10000000 >> void (tryPutMVar ready ())
227237 when (expectedConnections /= 0) $ takeMVar ready