git.iko.soy/jsaddle
on master help sign in
Avoid using template haskell
672e5afHamish Mackenzie
jsaddle.cabal+2−4
compare with master
unifiedsplit
@@ -30,7 +30,7 @@ library
30 else
30 else
31 exposed-modules:
31 exposed-modules:
32 Language.Javascript.JSaddle.WebSockets
32 Language.Javascript.JSaddle.WebSockets
33− Language.Javascript.JSaddle.WebSockets.Files
33+- Language.Javascript.JSaddle.WebSockets.Files
34 Language.Javascript.JSaddle.Test
34 Language.Javascript.JSaddle.Test
35 build-depends:
35 build-depends:
36 aeson >=0.8.0.2 && <1.1,
36 aeson >=0.8.0.2 && <1.1,
@@ -43,7 +43,6 @@ library
43 stm >=2.4.4 && <2.5,
43 stm >=2.4.4 && <2.5,
44 time >=1.5.0.1 && <1.7,
44 time >=1.5.0.1 && <1.7,
45 wai >=3.0.3.0 && <3.3,
45 wai >=3.0.3.0 && <3.3,
46− wai-app-static >=3.1.1 && <3.2,
47 wai-websockets >=3.0.0.6 && <3.1,
46 wai-websockets >=3.0.0.6 && <3.1,
48 warp >=3.1.2 && <3.3,
47 warp >=3.1.2 && <3.3,
49 websockets >=0.9.5.0 && <0.10
48 websockets >=0.9.5.0 && <0.10
@@ -63,7 +62,7 @@ library
63 Paths_jsaddle
62 Paths_jsaddle
64 build-depends:
63 build-depends:
65 base <5,
64 base <5,
66− lens >=3.8.5 && <4.15,
65+ lens >=3.8.5 && <4.16,
67 primitive >=0.6.1.0 && <0.7,
66 primitive >=0.6.1.0 && <0.7,
68 template-haskell -any,
67 template-haskell -any,
69 text >=1.2.1.3 && <1.3,
68 text >=1.2.1.3 && <1.3,
@@ -86,7 +85,6 @@ test-suite test-tool
86 text >=1.2.1.3 && <1.3,
85 text >=1.2.1.3 && <1.3,
87 vector >=0.10.12.3 && <0.12,
86 vector >=0.10.12.3 && <0.12,
88 wai >=3.0.3.0 && <3.3,
87 wai >=3.0.3.0 && <3.3,
89− wai-app-static >=3.1.1 && <3.2,
90 wai-websockets >=3.0.0.6 && <3.1,
88 wai-websockets >=3.0.0.6 && <3.1,
91 warp >=3.1.2 && <3.3,
89 warp >=3.1.2 && <3.3,
92 websockets >=0.9.5.0 && <0.10
90 websockets >=0.9.5.0 && <0.10
src/Language/Javascript/JSaddle/WebSockets.hs+19−9
@@ -1,5 +1,4 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2−{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE LambdaCase #-}
2{-# LANGUAGE LambdaCase #-}
4{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE OverloadedStrings #-}
5-----------------------------------------------------------------------------
4-----------------------------------------------------------------------------
@@ -60,23 +59,23 @@ import Data.Time.Clock (getCurrentTime,diffUTCTime)
60import Network.Wai (Application)
59import Network.Wai (Application)
61import Network.Wai.Handler.Warp
60import Network.Wai.Handler.Warp
62 (defaultSettings, setTimeout, setPort, runSettings)
61 (defaultSettings, setTimeout, setPort, runSettings)
63−import Network.Wai.Application.Static
64− (ssIndices, staticApp)
65import Network.WebSockets
62import Network.WebSockets
66 (ConnectionOptions(..), sendTextData, receiveDataMessage,
63 (ConnectionOptions(..), sendTextData, receiveDataMessage,
67 acceptRequest, defaultConnectionOptions, ServerApp)
64 acceptRequest, defaultConnectionOptions, ServerApp)
68import qualified Network.WebSockets as WS (DataMessage(..))
65import qualified Network.WebSockets as WS (DataMessage(..))
69import Network.Wai.Handler.WebSockets (websocketsOr)
66import Network.Wai.Handler.WebSockets (websocketsOr)
70
67
71−import WaiAppStatic.Storage.Embedded (mkSettings)
72−import WaiAppStatic.Types (unsafeToPiece)
73−
74import Language.Javascript.JSaddle.Types
68import Language.Javascript.JSaddle.Types
75 (Command(..), AsyncCommand(..), Result(..), JSContextRef(..), JSVal(..),
69 (Command(..), AsyncCommand(..), Result(..), JSContextRef(..), JSVal(..),
76 Object(..), JSValueReceived(..), JSM(..), Batch(..), JSValueForSend(..))
70 Object(..), JSValueReceived(..), JSM(..), Batch(..), JSValueForSend(..))
77import Language.Javascript.JSaddle.Exception (JSException(..))
71import Language.Javascript.JSaddle.Exception (JSException(..))
78import Language.Javascript.JSaddle.Native (wrapJSVal)
72import Language.Javascript.JSaddle.Native (wrapJSVal)
79−import Language.Javascript.JSaddle.WebSockets.Files (mkEmbedded)
73+import Language.Javascript.JSaddle.WebSockets.Files (indexHtml, jsaddleJs)
74+import qualified Network.Wai as W
75+ (responseLBS, requestMethod, Application, pathInfo)
76+import Data.Text (Text)
77+import qualified Network.HTTP.Types as H
78+ (status403, status200, status405)
80#endif
79#endif
81
80
82-- | Run the given 'JSM' action as the main entry point. Either directly
81-- | Run the given 'JSM' action as the main entry point. Either directly
@@ -233,6 +232,17 @@ jsaddleOr opts entryPoint = websocketsOr opts wsApp
233 _ -> discardToSyncPoint chan
232 _ -> discardToSyncPoint chan
234
233
235jsaddleApp :: Application
234jsaddleApp :: Application
236−jsaddleApp = staticApp ($(mkSettings mkEmbedded)) {ssIndices = [unsafeToPiece "index.html"]}
235+jsaddleApp req = jsaddleAppPieces (W.pathInfo req) req
237−
236+
237+jsaddleAppPieces :: [Text] -> W.Application
238+jsaddleAppPieces _ req sendResponse
239+ | notElem (W.requestMethod req) ["GET", "HEAD"] = sendResponse $ W.responseLBS
240+ H.status405
241+ [("Content-Type", "text/plain")]
242+ "Only GET or HEAD is supported"
243+jsaddleAppPieces [] req sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] indexHtml
244+jsaddleAppPieces ["jsaddle.js"] req sendResponse = sendResponse $ W.responseLBS H.status200 [("Content-Type", "image/png")] jsaddleJs
245+jsaddleAppPieces rawPieces req sendResponse = sendResponse $ W.responseLBS H.status403
246+ [ ("Content-Type", "text/plain")
247+ ] "Forbidden"
238#endif
248#endif
src/Language/Javascript/JSaddle/WebSockets/Files.hs+221−19
@@ -1,4 +1,4 @@
1−{-# LANGUAGE TemplateHaskell, QuasiQuotes, OverloadedStrings #-}
1+{-# LANGUAGE OverloadedStrings #-}
2-----------------------------------------------------------------------------
2-----------------------------------------------------------------------------
3--
3--
4-- Module : Language.Javascript.JSaddle.WebSockets.Files
4-- Module : Language.Javascript.JSaddle.WebSockets.Files
@@ -12,25 +12,227 @@
12-----------------------------------------------------------------------------
12-----------------------------------------------------------------------------
13
13
14module Language.Javascript.JSaddle.WebSockets.Files (
14module Language.Javascript.JSaddle.WebSockets.Files (
15− mkEmbedded
15+ indexHtml
16+ , jsaddleJs
16) where
17) where
17
18
18−import WaiAppStatic.Storage.Embedded
19−import qualified Data.ByteString.Lazy as BL
19+import Data.ByteString.Lazy (ByteString)
20
20
21−mkEmbedded :: IO [EmbeddableEntry]
21+indexHtml :: ByteString
22−mkEmbedded = do
22+indexHtml =
23− indexFile <- BL.readFile "data/index.html"
23+ "<!DOCTYPE html>\n\
24− jsFile <- BL.readFile "data/jsaddle.js"
24+ \<html>\n\
25− let index = EmbeddableEntry {
25+ \<head>\n\
26− eLocation = "index.html"
26+ \<title>JSaddle</title>\n\
27− , eMimeType = "text/html"
27+ \</head>\n\
28− , eContent = Left ("", indexFile)
28+ \<body>\n\
29− }
29+ \</body>\n\
30− js = EmbeddableEntry {
31− eLocation = "jsaddle.js"
30+ \<script src=\"jsaddle.js\"></script>\n\
32− , eMimeType = "text/plain"
31+ \</html>"
33− , eContent = Left ("", jsFile)
34− }
35− return [index, js]
36
32
33+-- Use this to generate this string for embedding
34+-- sed -e 's|\\|\\\\|g' -e 's|^| \\|' -e 's|$|\\n\\|' -e 's|"|\\"|g' data/jsaddle.js | pbcopy
35+jsaddleJs :: ByteString
36+jsaddleJs = "\
37+ \if(typeof global !== \"undefined\") {\n\
38+ \ global.window = global;\n\
39+ \ global.WebSocket = require('ws');\n\
40+ \}\n\
41+ \\n\
42+ \var connect = function() {\n\
43+ \ var wsaddress =\n\
44+ \ typeof window.location === \"undefined\"\n\
45+ \ ? \"ws://localhost:3709/\"\n\
46+ \ : window.location.protocol.replace('http', 'ws')+\"//\"+window.location.hostname+(window.location.port?(\":\"+window.location.port):\"\");\n\
47+ \\n\
48+ \ var ws = new WebSocket(wsaddress);\n\
49+ \\n\
50+ \ ws.onopen = function(e) {\n\
51+ \ var jsaddle_values = new Map();\n\
52+ \ jsaddle_values.set(0, null);\n\
53+ \ jsaddle_values.set(1, undefined);\n\
54+ \ jsaddle_values.set(2, false);\n\
55+ \ jsaddle_values.set(3, true);\n\
56+ \ jsaddle_values.set(4, window);\n\
57+ \ var jsaddle_index = 100;\n\
58+ \\n\
59+ \ ws.onmessage = function(e) {\n\
60+ \ var batch = JSON.parse(e.data);\n\
61+ \\n\
62+ \ var processBatch = function(timestamp) {\n\
63+ \ try {\n\
64+ \ var nAsyncLength = batch[0].length;\n\
65+ \ for (var nAsync = 0; nAsync != nAsyncLength; nAsync++) {\n\
66+ \ var d = batch[0][nAsync];\n\
67+ \ switch (d.tag) {\n\
68+ \ case \"FreeRef\":\n\
69+ \ jsaddle_values.delete(d.contents);\n\
70+ \ break;\n\
71+ \ case \"SetPropertyByName\":\n\
72+ \ jsaddle_values.get(d.contents[0])[d.contents[1]]=jsaddle_values.get(d.contents[2]);\n\
73+ \ break;\n\
74+ \ case \"SetPropertyAtIndex\":\n\
75+ \ jsaddle_values.get(d.contents[0])[d.contents[1]]=jsaddle_values.get(d.contents[2]);\n\
76+ \ break;\n\
77+ \ case \"EvaluateScript\":\n\
78+ \ var n = d.contents[1];\n\
79+ \ jsaddle_values.set(n, eval(d.contents[0]));\n\
80+ \ break;\n\
81+ \ case \"StringToValue\":\n\
82+ \ var n = d.contents[1];\n\
83+ \ jsaddle_values.set(n, d.contents[0]);\n\
84+ \ break;\n\
85+ \ case \"GetPropertyByName\":\n\
86+ \ var n = d.contents[2];\n\
87+ \ jsaddle_values.set(n, jsaddle_values.get(d.contents[0])[d.contents[1]]);\n\
88+ \ break;\n\
89+ \ case \"GetPropertyAtIndex\":\n\
90+ \ var n = d.contents[2];\n\
91+ \ jsaddle_values.set(n, jsaddle_values.get(d.contents[0])[d.contents[1]]);\n\
92+ \ break;\n\
93+ \ case \"NumberToValue\":\n\
94+ \ var n = d.contents[1];\n\
95+ \ jsaddle_values.set(n, d.contents[0]);\n\
96+ \ break;\n\
97+ \ case \"NewEmptyObject\":\n\
98+ \ var n = d.contents;\n\
99+ \ jsaddle_values.set(n, {});\n\
100+ \ break;\n\
101+ \ case \"NewCallback\":\n\
102+ \ (function() {\n\
103+ \ var nFunction = d.contents;\n\
104+ \ jsaddle_values.set(nFunction, function() {\n\
105+ \ var nThis = ++jsaddle_index;\n\
106+ \ jsaddle_values.set(nThis, this);\n\
107+ \ var args = [];\n\
108+ \ for (var i = 0; i != arguments.length; i++) {\n\
109+ \ var nArg = ++jsaddle_index;\n\
110+ \ jsaddle_values.set(nArg, arguments[i]);\n\
111+ \ args[i] = nArg;\n\
112+ \ }\n\
113+ \ ws.send(JSON.stringify({\"tag\": \"Callback\", \"contents\": [nFunction, nThis, args]}));\n\
114+ \ })})();\n\
115+ \ break;\n\
116+ \ case \"CallAsFunction\":\n\
117+ \ var n = d.contents[3];\n\
118+ \ jsaddle_values.set(n,\n\
119+ \ jsaddle_values.get(d.contents[0]).apply(jsaddle_values.get(d.contents[1]),\n\
120+ \ d.contents[2].map(function(arg){return jsaddle_values.get(arg);})));\n\
121+ \ break;\n\
122+ \ case \"CallAsConstructor\":\n\
123+ \ var n = d.contents[2];\n\
124+ \ var r;\n\
125+ \ var f = jsaddle_values.get(d.contents[0]);\n\
126+ \ var a = d.contents[1].map(function(arg){return jsaddle_values.get(arg);});\n\
127+ \ switch(a.length) {\n\
128+ \ case 0 : r = new f(); break;\n\
129+ \ case 1 : r = new f(a[0]); break;\n\
130+ \ case 2 : r = new f(a[0],a[1]); break;\n\
131+ \ case 3 : r = new f(a[0],a[1],a[2]); break;\n\
132+ \ case 4 : r = new f(a[0],a[1],a[2],a[3]); break;\n\
133+ \ case 5 : r = new f(a[0],a[1],a[2],a[3],a[4]); break;\n\
134+ \ case 6 : r = new f(a[0],a[1],a[2],a[3],a[4],a[5]); break;\n\
135+ \ case 7 : r = new f(a[0],a[1],a[2],a[3],a[4],a[5],a[6]); break;\n\
136+ \ default:\n\
137+ \ var ret;\n\
138+ \ var temp = function() {\n\
139+ \ ret = f.apply(this, a);\n\
140+ \ };\n\
141+ \ temp.prototype = f.prototype;\n\
142+ \ var i = new temp();\n\
143+ \ if(ret instanceof Object)\n\
144+ \ r = ret;\n\
145+ \ else {\n\
146+ \ i.constructor = f;\n\
147+ \ r = i;\n\
148+ \ }\n\
149+ \ }\n\
150+ \ jsaddle_values.set(n, r);\n\
151+ \ break;\n\
152+ \ case \"NewArray\":\n\
153+ \ var n = d.contents[1];\n\
154+ \ jsaddle_values.set(n, d.contents[0].map(function(v){return jsaddle_values.get(v);}));\n\
155+ \ break;\n\
156+ \ case \"SyncWithAnimationFrame\":\n\
157+ \ var n = d.contents[0];\n\
158+ \ jsaddle_values.set(n, timestamp);\n\
159+ \ break;\n\
160+ \ default:\n\
161+ \ ws.send(JSON.stringify({\"tag\": \"ProtocolError\", \"contents\": e.data}));\n\
162+ \ return;\n\
163+ \ }\n\
164+ \ }\n\
165+ \ var d = batch[1];\n\
166+ \ switch (d.tag) {\n\
167+ \ case \"ValueToString\":\n\
168+ \ var val = jsaddle_values.get(d.contents);\n\
169+ \ var s = val === null ? \"null\" : val === undefined ? \"undefined\" : val.toString();\n\
170+ \ ws.send(JSON.stringify({\"tag\": \"ValueToStringResult\", \"contents\": s}));\n\
171+ \ break;\n\
172+ \ case \"ValueToBool\":\n\
173+ \ ws.send(JSON.stringify({\"tag\": \"ValueToBoolResult\", \"contents\": jsaddle_values.get(d.contents) ? true : false}));\n\
174+ \ break;\n\
175+ \ case \"ValueToNumber\":\n\
176+ \ ws.send(JSON.stringify({\"tag\": \"ValueToNumberResult\", \"contents\": Number(jsaddle_values.get(d.contents))}));\n\
177+ \ break;\n\
178+ \ case \"ValueToJSON\":\n\
179+ \ var s = jsaddle_values.get(d.contents) === undefined ? \"\" : JSON.stringify(jsaddle_values.get(d.contents));\n\
180+ \ ws.send(JSON.stringify({\"tag\": \"ValueToJSONResult\", \"contents\": s}));\n\
181+ \ break;\n\
182+ \ case \"DeRefVal\":\n\
183+ \ var n = d.contents;\n\
184+ \ var v = jsaddle_values.get(n);\n\
185+ \ var c = (v === null ) ? [0, \"\"] :\n\
186+ \ (v === undefined ) ? [1, \"\"] :\n\
187+ \ (v === false ) ? [2, \"\"] :\n\
188+ \ (v === true ) ? [3, \"\"] :\n\
189+ \ (typeof v === \"number\") ? [-1, v.toString()] :\n\
190+ \ (typeof v === \"string\") ? [-2, v]\n\
191+ \ : [n, \"\"];\n\
192+ \ ws.send(JSON.stringify({\"tag\": \"DeRefValResult\", \"contents\": c}));\n\
193+ \ break;\n\
194+ \ case \"IsNull\":\n\
195+ \ ws.send(JSON.stringify({\"tag\": \"IsNullResult\", \"contents\": jsaddle_values.get(d.contents) === null}));\n\
196+ \ break;\n\
197+ \ case \"IsUndefined\":\n\
198+ \ ws.send(JSON.stringify({\"tag\": \"IsUndefinedResult\", \"contents\": jsaddle_values.get(d.contents) === undefined}));\n\
199+ \ break;\n\
200+ \ case \"InstanceOf\":\n\
201+ \ ws.send(JSON.stringify({\"tag\": \"InstanceOfResult\", \"contents\": jsaddle_values.get(d.contents[0]) instanceof jsaddle_values.get(d.contents[1])}));\n\
202+ \ break;\n\
203+ \ case \"StrictEqual\":\n\
204+ \ ws.send(JSON.stringify({\"tag\": \"StrictEqualResult\", \"contents\": jsaddle_values.get(d.contents[0]) === jsaddle_values.get(d.contents[1])}));\n\
205+ \ break;\n\
206+ \ case \"PropertyNames\":\n\
207+ \ var result = [];\n\
208+ \ for (name in jsaddle_values.get(d.contents)) { result.push(name); }\n\
209+ \ ws.send(JSON.stringify({\"tag\": \"PropertyNamesResult\", \"contents\": result}));\n\
210+ \ break;\n\
211+ \ case \"Sync\":\n\
212+ \ ws.send(JSON.stringify({\"tag\": \"SyncResult\", \"contents\": []}));\n\
213+ \ break;\n\
214+ \ default:\n\
215+ \ ws.send(JSON.stringify({\"tag\": \"ProtocolError\", \"contents\": e.data}));\n\
216+ \ }\n\
217+ \ }\n\
218+ \ catch (err) {\n\
219+ \ var n = ++jsaddle_index;\n\
220+ \ jsaddle_values.set(n, err);\n\
221+ \ ws.send(JSON.stringify({\"tag\": \"ThrowJSValue\", \"contents\": n}));\n\
222+ \ }\n\
223+ \ };\n\
224+ \ if(batch[2]) {\n\
225+ \ window.requestAnimationFrame(processBatch);\n\
226+ \ }\n\
227+ \ else {\n\
228+ \ processBatch(window.performance ? window.performance.now() : null);\n\
229+ \ }\n\
230+ \ };\n\
231+ \ };\n\
232+ \ ws.onerror = function() {\n\
233+ \ setTimeout(connect, 1000);\n\
234+ \ };\n\
235+ \}\n\
236+ \\n\
237+ \connect();\n\
238+ \"
tests/DocTest.hs−1
@@ -49,7 +49,6 @@ main = do
49 "-package=websockets-" ++ VERSION_websockets,
49 "-package=websockets-" ++ VERSION_websockets,
50 "-package=wai-" ++ VERSION_wai,
50 "-package=wai-" ++ VERSION_wai,
51 "-package=wai-websockets-" ++ VERSION_wai_websockets,
51 "-package=wai-websockets-" ++ VERSION_wai_websockets,
52− "-package=wai-app-static-" ++ VERSION_wai_app_static,
53 "-package=warp-" ++ VERSION_warp,
52 "-package=warp-" ++ VERSION_warp,
54 "-package=http-types-" ++ VERSION_http_types,
53 "-package=http-types-" ++ VERSION_http_types,
55 "-package=stm-" ++ VERSION_stm,
54 "-package=stm-" ++ VERSION_stm,