git.iko.soy/jsaddle
on master help sign in
Support jsaddle running on a different uri
8f32ae4Hamish Mackenzie
jsaddle-warp/src/Language/Javascript/JSaddle/WebSockets.hs+13−7
compare with master
unifiedsplit
@@ -19,6 +19,7 @@ module Language.Javascript.JSaddle.WebSockets (
19 jsaddleOr
19 jsaddleOr
20 , jsaddleApp
20 , jsaddleApp
21 , jsaddleWithAppOr
21 , jsaddleWithAppOr
22+ , jsaddleAppWithJs
22 , jsaddleAppPartial
23 , jsaddleAppPartial
23 , jsaddleJs
24 , jsaddleJs
24 , debug
25 , debug
@@ -56,6 +57,7 @@ import qualified Data.Map as M (empty, insert, lookup)
56import Data.IORef
57import Data.IORef
57 (readIORef, newIORef, atomicModifyIORef')
58 (readIORef, newIORef, atomicModifyIORef')
58import Data.ByteString.Lazy (ByteString)
59import Data.ByteString.Lazy (ByteString)
60+import qualified Data.ByteString.Lazy as LBS (stripPrefix)
59import Control.Concurrent.MVar
61import Control.Concurrent.MVar
60 (tryTakeMVar, MVar, tryPutMVar, modifyMVar_, putMVar, takeMVar,
62 (tryTakeMVar, MVar, tryPutMVar, modifyMVar_, putMVar, takeMVar,
61 readMVar, newMVar, newEmptyMVar, modifyMVar)
63 readMVar, newMVar, newEmptyMVar, modifyMVar)
@@ -122,7 +124,7 @@ jsaddleOr opts entryPoint otherApp = do
122
124
123
125
124jsaddleApp :: Application
126jsaddleApp :: Application
125−jsaddleApp = jsaddleAppWithJs $ jsaddleJs False
127+jsaddleApp = jsaddleAppWithJs $ jsaddleJs Nothing False
126
128
127jsaddleAppWithJs :: ByteString -> Application
129jsaddleAppWithJs :: ByteString -> Application
128jsaddleAppWithJs js req sendResponse =
130jsaddleAppWithJs js req sendResponse =
@@ -136,7 +138,7 @@ jsaddleWithAppOr opts entryPoint otherApp = jsaddleOr opts entryPoint $ \req sen
136 (jsaddleAppPartial req sendResponse))
138 (jsaddleAppPartial req sendResponse))
137
139
138jsaddleAppPartial :: Request -> (Response -> IO ResponseReceived) -> Maybe (IO ResponseReceived)
140jsaddleAppPartial :: Request -> (Response -> IO ResponseReceived) -> Maybe (IO ResponseReceived)
139−jsaddleAppPartial = jsaddleAppPartialWithJs $ jsaddleJs False
141+jsaddleAppPartial = jsaddleAppPartialWithJs $ jsaddleJs Nothing False
140
142
141indexResponse :: Response
143indexResponse :: Response
142indexResponse = W.responseLBS H.status200 [("Content-Type", "text/html")] indexHtml
144indexResponse = W.responseLBS H.status200 [("Content-Type", "text/html")] indexHtml
@@ -149,15 +151,19 @@ jsaddleAppPartialWithJs js req sendResponse = case (W.requestMethod req, W.pathI
149
151
150-- Use this to generate this string for embedding
152-- Use this to generate this string for embedding
151-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy
153-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy
152−jsaddleJs :: Bool -> ByteString
154+jsaddleJs :: Maybe ByteString -> Bool -> ByteString
153−jsaddleJs refreshOnLoad = "\
155+jsaddleJs jsaddleUri refreshOnLoad = "\
154 \if(typeof global !== \"undefined\") {\n\
156 \if(typeof global !== \"undefined\") {\n\
155 \ global.window = global;\n\
157 \ global.window = global;\n\
156 \ global.WebSocket = require('ws');\n\
158 \ global.WebSocket = require('ws');\n\
157 \}\n\
159 \}\n\
158 \\n\
160 \\n\
159 \var connect = function() {\n\
161 \var connect = function() {\n\
162+ \ var wsaddress = "
160− \ var wsaddress = window.location.protocol.replace('http', 'ws')+\"//\"+window.location.hostname+(window.location.port?(\":\"+window.location.port):\"\");\n\
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\
161 \\n\
167 \\n\
162 \ var ws = new WebSocket(wsaddress);\n\
168 \ var ws = new WebSocket(wsaddress);\n\
163 \ var syncKey = \"\";\n\
169 \ var syncKey = \"\";\n\
@@ -188,7 +194,7 @@ jsaddleJs refreshOnLoad = "\
188 \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));")
194 \ " <> runBatch (\a -> "ws.send(JSON.stringify(" <> a <> "));")
189 (Just (\a -> "(function(){\n\
195 (Just (\a -> "(function(){\n\
190 \ var xhr = new XMLHttpRequest();\n\
196 \ var xhr = new XMLHttpRequest();\n\
191− \ xhr.open('POST', '/sync/'+syncKey, false);\n\
197+ \ xhr.open('POST', '" <> fromMaybe "" jsaddleUri <> "/sync/'+syncKey, false);\n\
192 \ xhr.setRequestHeader(\"Content-type\", \"application/json\");\n\
198 \ xhr.setRequestHeader(\"Content-type\", \"application/json\");\n\
193 \ xhr.send(JSON.stringify(" <> a <> "));\n\
199 \ xhr.send(JSON.stringify(" <> a <> "));\n\
194 \ return JSON.parse(xhr.response);})()")) <> "\
200 \ return JSON.parse(xhr.response);})()")) <> "\
@@ -210,7 +216,7 @@ debug :: Int -> JSM () -> IO ()
210debug port f = do
216debug port f = do
211 debugWrapper $ \withRefresh registerContext ->
217 debugWrapper $ \withRefresh registerContext ->
212 runSettings (setPort port (setTimeout 3600 defaultSettings)) =<<
218 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)
214 putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"
220 putStrLn $ "<a href=\"http://localhost:" <> show port <> "\">run</a>"
215
221
216refreshMiddleware :: ((Response -> IO ResponseReceived) -> IO ResponseReceived) -> Middleware
222refreshMiddleware :: ((Response -> IO ResponseReceived) -> IO ResponseReceived) -> Middleware