git.iko.soy/lynxjs-elm/compiler
on master help sign in
Merge pull request #2217 from elm/new-compile-endpoint
3994905Evan Czaplicki
worker/src/Endpoint/Compile.hs+109−19
compare with master
unifiedsplit
@@ -1,7 +1,8 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
2{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
3module Endpoint.Compile
3module Endpoint.Compile
4− ( endpoint
4+ ( endpoint_V1
5+ , endpoint_V2
5 , loadErrorJS
6 , loadErrorJS
6 )
7 )
7 where
8 where
@@ -63,26 +64,50 @@ allowedOrigins =
63
64
64
65
65
66
67+-- ENDPOINT (V1)
68+
69+
70+endpoint_V1 :: A.Artifacts -> Snap ()
71+endpoint_V1 artifacts =
72+ endpoint artifacts $ \result ->
73+ case result of
74+ Ok name js -> writeBuilder $ Html.sandwich name js
75+ Err report -> writeBuilder $ renderProblem_V1 report
76+
77+
78+
79+-- ENDPOINT (V2)
80+
81+
82+endpoint_V2 :: A.Artifacts -> Snap ()
83+endpoint_V2 artifacts =
84+ endpoint artifacts $ \result ->
85+ case result of
86+ Ok name js -> writeBuilder $ renderSuccess_V2 name js
87+ Err report -> writeBuilder $ renderProblem_V2 report
88+
89+
90+
66-- ENDPOINT
91-- ENDPOINT
67
92
68
93
94+data Result
95+ = Ok N.Name B.Builder
96+ | Err Help.Report
97+
98+
69−endpoint :: A.Artifacts -> Snap ()
99+endpoint :: A.Artifacts -> (Result -> Snap ()) -> Snap ()
70−endpoint artifacts =
100+endpoint artifacts callback =
71 Cors.allow POST allowedOrigins $
101 Cors.allow POST allowedOrigins $
72 do result <- foldMultipart defaultUploadPolicy ignoreFile 0
102 do result <- foldMultipart defaultUploadPolicy ignoreFile 0
73 case result of
103 case result of
74 ([("code",source)], 0) ->
104 ([("code",source)], 0) ->
75 do modifyResponse $ setContentType "text/html; charset=utf-8"
105 do modifyResponse $ setContentType "text/html; charset=utf-8"
106+ callback $
76− case compile artifacts source of
107+ case compile artifacts source of
77− Success builder ->
108+ Success name js -> Ok name js
78− writeBuilder builder
79−
80− NoMain ->
109+ NoMain -> Err noMain
81− writeBuilder $ renderReport noMain
82−
83− BadInput name err ->
84− writeBuilder $ renderReport $
85− Help.compilerReport "/" (Error.Module name "/try" File.zeroTime source err) []
110+ BadInput name err -> Err $ Help.compilerReport "/" (Error.Module name "/try" File.zeroTime source err) []
86
111
87 _ ->
112 _ ->
88 do modifyResponse $ setResponseStatus 400 "Bad Request"
113 do modifyResponse $ setResponseStatus 400 "Bad Request"
@@ -104,7 +129,7 @@ ignoreFile _ _ count =
104
129
105
130
106data Outcome
131data Outcome
107− = Success B.Builder
132+ = Success N.Name B.Builder
108 | NoMain
133 | NoMain
109 | BadInput ModuleName.Raw Error.Error
134 | BadInput ModuleName.Raw Error.Error
110
135
@@ -138,7 +163,7 @@ compile (A.Artifacts interfaces objects) source =
138 mains = Map.singleton home main_
163 mains = Map.singleton home main_
139 graph = Opt.addLocalGraph locals objects
164 graph = Opt.addLocalGraph locals objects
140 in
165 in
141− Success $ Html.sandwich name $ JS.generate mode graph mains
166+ Success name $ JS.generate mode graph mains
142
167
143
168
144checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
169checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
@@ -163,11 +188,11 @@ checkImports interfaces imports =
163
188
164
189
165
190
166−-- RENDER REPORT
191+-- RENDER PROBLEM (V1)
167
192
168
193
169−renderReport :: Help.Report -> B.Builder
194+renderProblem_V1 :: Help.Report -> B.Builder
170−renderReport report =
195+renderProblem_V1 report =
171 [r|<!DOCTYPE HTML>
196 [r|<!DOCTYPE HTML>
172<html>
197<html>
173<head>
198<head>
@@ -179,7 +204,7 @@ renderReport report =
179 <script>
204 <script>
180 var app = Elm.Errors.init({flags:|] <> Encode.encodeUgly (Exit.toJson report) <> [r|});
205 var app = Elm.Errors.init({flags:|] <> Encode.encodeUgly (Exit.toJson report) <> [r|});
181 app.ports.jumpTo.subscribe(function(region) {
206 app.ports.jumpTo.subscribe(function(region) {
182− window.parent.postMessage(JSON.stringify(region), '*');
207+ window.parent.postMessage(JSON.stringify(region), "*");
183 });
208 });
184 </script>
209 </script>
185</body>
210</body>
@@ -187,6 +212,71 @@ renderReport report =
187
212
188
213
189
214
215+-- RENDER SUCCESS (V2)
216+
217+
218+renderSuccess_V2 :: N.Name -> B.Builder -> B.Builder
219+renderSuccess_V2 moduleName javascript =
220+ let name = N.toBuilder moduleName in
221+ [r|<!DOCTYPE HTML>
222+<html>
223+<head>
224+ <meta charset="UTF-8">
225+ <title>|] <> name <> [r|</title>
226+ <style>body { padding: 0; margin: 0; }</style>
227+</head>
228+
229+<body>
230+
231+<pre id="elm"></pre>
232+
233+<script>
234+window.parent.postMessage("SUCCESS", "*");
235+
236+try {
237+|] <> javascript <> [r|
238+
239+ var app = Elm.|] <> name <> [r|.init({ node: document.getElementById("elm") });
240+}
241+catch (e)
242+{
243+ // display initialization errors (e.g. bad flags, infinite recursion)
244+ var header = document.createElement("h1");
245+ header.style.fontFamily = "monospace";
246+ header.innerText = "Initialization Error";
247+ var pre = document.getElementById("elm");
248+ document.body.insertBefore(header, pre);
249+ pre.innerText = e;
250+ throw e;
251+}
252+</script>
253+
254+</body>
255+</html>|]
256+
257+
258+
259+-- RENDER PROBLEM (V2)
260+
261+
262+renderProblem_V2 :: Help.Report -> B.Builder
263+renderProblem_V2 report =
264+ [r|<!DOCTYPE HTML>
265+<html>
266+<head>
267+ <meta charset="UTF-8">
268+ <style>body { padding: 0; margin: 0; display: none; }</style>
269+</head>
270+<body>
271+ <script>
272+ var errors = |] <> Encode.encodeUgly (Exit.toJson report) <> [r|;
273+ window.parent.postMessage(JSON.stringify(errors), "*");
274+ </script>
275+</body>
276+</html>|]
277+
278+
279+
190-- NO MAIN
280-- NO MAIN
191
281
192
282
worker/src/Main.hs+2−1
@@ -31,7 +31,8 @@ main =
31 httpServe config $ msum $
31 httpServe config $ msum $
32 [ ifTop $ status
32 [ ifTop $ status
33 , path "repl" $ Repl.endpoint rArtifacts
33 , path "repl" $ Repl.endpoint rArtifacts
34− , path "compile" $ Compile.endpoint cArtifacts
34+ , path "compile" $ Compile.endpoint_V1 cArtifacts
35+ , path "compile/v2" $ Compile.endpoint_V2 cArtifacts
35 , path "compile/errors.js" $ serveJavaScript errorJS
36 , path "compile/errors.js" $ serveJavaScript errorJS
36 , path "compile/deps-info.json" $ serveDepsInfo depsInfo
37 , path "compile/deps-info.json" $ serveDepsInfo depsInfo
37 , notFound
38 , notFound