@@ -19,6 +19,7 @@ module Language.Javascript.JSaddle.WebSockets (
1919 jsaddleOr
2020 , jsaddleApp
2121 , jsaddleWithAppOr
22+ , jsaddleAppWithJs
2223 , jsaddleAppPartial
2324 , jsaddleJs
2425 , debug
@@ -56,6 +57,7 @@ import qualified Data.Map as M (empty, insert, lookup)
5657import Data.IORef
5758 (readIORef, newIORef, atomicModifyIORef')
5859import Data.ByteString.Lazy (ByteString)
60+import qualified Data.ByteString.Lazy as LBS (stripPrefix)
5961import Control.Concurrent.MVar
6062 (tryTakeMVar, MVar, tryPutMVar, modifyMVar_, putMVar, takeMVar,
6163 readMVar, newMVar, newEmptyMVar, modifyMVar)
@@ -122,7 +124,7 @@ jsaddleOr opts entryPoint otherApp = do
122124
123125
124126jsaddleApp :: Application
125−jsaddleApp = jsaddleAppWithJs $ jsaddleJs False
127+jsaddleApp = jsaddleAppWithJs $ jsaddleJs Nothing False
126128
127129jsaddleAppWithJs :: ByteString -> Application
128130jsaddleAppWithJs js req sendResponse =
@@ -136,7 +138,7 @@ jsaddleWithAppOr opts entryPoint otherApp = jsaddleOr opts entryPoint $ \req sen
136138 (jsaddleAppPartial req sendResponse))
137139
138140jsaddleAppPartial :: Request -> (Response -> IO ResponseReceived) -> Maybe (IO ResponseReceived)
139−jsaddleAppPartial = jsaddleAppPartialWithJs $ jsaddleJs False
141+jsaddleAppPartial = jsaddleAppPartialWithJs $ jsaddleJs Nothing False
140142
141143indexResponse :: Response
142144indexResponse = W.responseLBS H.status200 [("Content-Type", "text/html")] indexHtml
@@ -149,15 +151,19 @@ jsaddleAppPartialWithJs js req sendResponse = case (W.requestMethod req, W.pathI
149151
150152-- Use this to generate this string for embedding
151153-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy
152−jsaddleJs :: Bool -> ByteString
153−jsaddleJs refreshOnLoad = "\
154+jsaddleJs :: Maybe ByteString -> Bool -> ByteString
155+jsaddleJs jsaddleUri refreshOnLoad = "\
154156 \if(typeof global !== \"undefined\") {\n\
155157 \ global.window = global;\n\
156158 \ global.WebSocket = require('ws');\n\
157159 \}\n\
158160 \\n\
159161 \var connect = function() {\n\
160− \ var wsaddress = window.location.protocol.replace('http', 'ws')+\"//\"+window.location.hostname+(window.location.port?(\":\"+window.location.port):\"\");\n\
162+ \ var wsaddress = "
163+ <> maybe "window.location.protocol.replace('http', 'ws')+\"//\"+window.location.hostname+(window.location.port?(\":\"+window.location.port):\"\")"
164+ (\ s -> "\"ws" <> s <> "\"")
165+ (jsaddleUri >>= LBS.stripPrefix "http")
166+ <> ";\n\
161167 \\n\
162168 \ var ws = new WebSocket(wsaddress);\n\
163169 \ var syncKey = \"\";\n\
@@ -188,7 +194,7 @@ jsaddleJs refreshOnLoad = "\
188194 \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));")
189195 (Just (\a -> "(function(){\n\
190196 \ var xhr = new XMLHttpRequest();\n\
191− \ xhr.open('POST', '/sync/'+syncKey, false);\n\
197+ \ xhr.open('POST', '" <> fromMaybe "" jsaddleUri <> "/sync/'+syncKey, false);\n\
192198 \ xhr.setRequestHeader(\"Content-type\", \"application/json\");\n\
193199 \ xhr.send(JSON.stringify(" <> a <> "));\n\
194200 \ return JSON.parse(xhr.response);})()")) <> "\
@@ -210,7 +216,7 @@ debug :: Int -> JSM () -> IO ()
210216debug port f = do
211217 debugWrapper $ \withRefresh registerContext ->
212218 runSettings (setPort port (setTimeout 3600 defaultSettings)) =<<
213− jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJs $ jsaddleJs True)
219+ jsaddleOr defaultConnectionOptions (registerContext >> f >> syncPoint) (withRefresh $ jsaddleAppWithJs $ jsaddleJs Nothing True)
214220 putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"
215221
216222refreshMiddleware :: ((Response -> IO ResponseReceived) -> IO ResponseReceived) -> Middleware