git.iko.soy/elk
on master help sign in
get worker Main compiling again
37de912Evan Czaplicki
worker/src/Main.hs+38−35
compare with master
unifiedsplit
@@ -14,6 +14,7 @@ import qualified Data.ByteString.Lazy as LBS
14import qualified Data.HashSet as HashSet
14import qualified Data.HashSet as HashSet
15import qualified Data.Map as Map
15import qualified Data.Map as Map
16import qualified Data.Map.Utils as Map
16import qualified Data.Map.Utils as Map
17+import qualified Data.Name as N
17import qualified Data.NonEmptyList as NE
18import qualified Data.NonEmptyList as NE
18import qualified Data.OneOrMore as OneOrMore
19import qualified Data.OneOrMore as OneOrMore
19import Network.URI (parseURI)
20import Network.URI (parseURI)
@@ -23,6 +24,7 @@ import Snap.Util.CORS
23import Snap.Util.FileServe (serveFile)
24import Snap.Util.FileServe (serveFile)
24import Snap.Util.FileUploads
25import Snap.Util.FileUploads
25import qualified System.Directory as Dir
26import qualified System.Directory as Dir
27+import qualified System.Exit as Exit
26import qualified System.IO.Streams as Stream
28import qualified System.IO.Streams as Stream
27import Text.RawString.QQ (r)
29import Text.RawString.QQ (r)
28
30
@@ -34,6 +36,7 @@ import qualified Elm.Details as Details
34import qualified Elm.Interface as I
36import qualified Elm.Interface as I
35import qualified Elm.ModuleName as ModuleName
37import qualified Elm.ModuleName as ModuleName
36import qualified Elm.Package as Pkg
38import qualified Elm.Package as Pkg
39+import qualified File
37import qualified Generate.Html as Html
40import qualified Generate.Html as Html
38import qualified Generate.JavaScript as Generate
41import qualified Generate.JavaScript as Generate
39import qualified Generate.Mode as Mode
42import qualified Generate.Mode as Mode
@@ -43,7 +46,7 @@ import qualified Reporting
43import qualified Reporting.Annotation as A
46import qualified Reporting.Annotation as A
44import qualified Reporting.Error as Error
47import qualified Reporting.Error as Error
45import qualified Reporting.Error.Import as Import
48import qualified Reporting.Error.Import as Import
46−import qualified Reporting.Render.Code as Code
49+import qualified Reporting.Exit as Exit
47
50
48
51
49
52
@@ -96,7 +99,9 @@ compile artifacts =
96 do parts <- handleMultipart defaultUploadPolicy handlePart
99 do parts <- handleMultipart defaultUploadPolicy handlePart
97 case parts of
100 case parts of
98 [Just source] ->
101 [Just source] ->
99− writeBuilder $ compileToBuilder artifacts source
102+ case compileToBuilder artifacts source of
103+ Right builder -> writeBuilder builder
104+ Left exit -> writeBuilder (exitToHtmlBuilder exit)
100
105
101 _ ->
106 _ ->
102 pass
107 pass
@@ -109,30 +114,48 @@ handlePart info stream =
109 else return Nothing
114 else return Nothing
110
115
111
116
117+exitToHtmlBuilder :: Exit.Worker -> B.Builder
118+exitToHtmlBuilder exit =
119+ let
120+ json =
121+ Encode.encodeUgly $ Exit.toJson $ Exit.workerToReport exit
122+ in
123+ [r|<!DOCTYPE HTML>
124+<html>
125+<head>
126+ <meta charset="UTF-8">
127+ <style>body { padding: 0; margin: 0; }</style>
128+ <script src="https://worker.elm-lang.org/compile/error.js"></script>
129+ <script>Elm.Error.init({flags:|] <> json <> [r|})</script>
130+</head>
131+<body></body>
132+</html>|]
133+
134+
112
135
113-- COMPILE TO BUILDER
136-- COMPILE TO BUILDER
114
137
115
138
116−compileToBuilder :: Artifacts -> B.ByteString -> Either Error.Error B.Builder
139+compileToBuilder :: Artifacts -> B.ByteString -> Either Exit.Worker B.Builder
117compileToBuilder (Artifacts interfaces objects) source =
140compileToBuilder (Artifacts interfaces objects) source =
118 case Parse.fromByteString Pkg.dummyName source of
141 case Parse.fromByteString Pkg.dummyName source of
119 Left err ->
142 Left err ->
120− toInputError N._Main source (Error.BadSyntax err)
143+ Left $ toInputError N._Main source (Error.BadSyntax err)
121
144
122 Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
145 Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
123 case checkImports interfaces imports of
146 case checkImports interfaces imports of
124 Left err ->
147 Left err ->
125− toInputError (Src.getName modul) source (Error.BadImports err)
148+ Left $ toInputError (Src.getName modul) source (Error.BadImports err)
126
149
127 Right ifaces ->
150 Right ifaces ->
128 case Compile.compile Pkg.dummyName ifaces modul of
151 case Compile.compile Pkg.dummyName ifaces modul of
129 Left err ->
152 Left err ->
130− toInputError (Src.getName modul) source err
153+ Left $ toInputError (Src.getName modul) source err
131
154
132 Right artifacts@(Compile.Artifacts modul _ locals) ->
155 Right artifacts@(Compile.Artifacts modul _ locals) ->
133 case locals of
156 case locals of
134 Opt.LocalGraph Nothing _ _ ->
157 Opt.LocalGraph Nothing _ _ ->
135− exitToHtmlBuilder Exit.WorkerNoMain
158+ Left Exit.WorkerNoMain
136
159
137 Opt.LocalGraph (Just main) _ _ ->
160 Opt.LocalGraph (Just main) _ _ ->
138 let
161 let
@@ -142,7 +165,7 @@ compileToBuilder (Artifacts interfaces objects) source =
142 mains = Map.singleton home main
165 mains = Map.singleton home main
143 graph = Opt.addLocalGraph locals objects
166 graph = Opt.addLocalGraph locals objects
144 in
167 in
145− Html.sandwich name $ Generate.generate mode graph mains
168+ Right $ Html.sandwich name $ Generate.generate mode graph mains
146
169
147
170
148checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
171checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
@@ -164,44 +187,24 @@ checkImports interfaces imports =
164 Left (fmap toError (NE.List i is))
187 Left (fmap toError (NE.List i is))
165
188
166
189
167−
168−-- COMPILE ERRORS
169−
170−
171−toInputError :: ModuleName.Raw -> B.ByteString -> Error.Error -> B.Builder
190+toInputError :: ModuleName.Raw -> B.ByteString -> Error.Error -> Exit.Worker
172toInputError name source err =
191toInputError name source err =
173− exitToHtmlBuilder $ Exit.WorkerInputError $
192+ Exit.WorkerInputError $
174 Error.Module name "/try" File.zeroTime source err
193 Error.Module name "/try" File.zeroTime source err
175
194
176
195
177−exitToHtmlBuilder :: Exit.Worker -> B.Builder
178−exitToHtmlBuilder exit =
179− let
180− json =
181− Encode.encodeUgly $ Exit.toJson $ Exit.workerToReport exit
182− in
183− [r|<!DOCTYPE HTML>
184−<html>
185−<head>
186− <meta charset="UTF-8">
187− <style>body { padding: 0; margin: 0; }</style>
188− <script src="https://worker.elm-lang.org/compile/error.js"></script>
189− <script>Elm.Error.init({flags:|] <> json <> [r|})</script>
190−</head>
191−<body></body>
192−</html>|]
193−
194−
195
196
196-- COMPILE ERROR VIEWER
197-- COMPILE ERROR VIEWER
197
198
198
199
199−compileErrorViewer :: Artifacts -> B.ByteString
200+compileErrorViewer :: Artifacts -> IO B.ByteString
200compileErrorViewer artifacts =
201compileErrorViewer artifacts =
201 do source <- File.readUtf8 "src/Error.elm"
202 do source <- File.readUtf8 "src/Error.elm"
202 case compileToBuilder artifacts source of
203 case compileToBuilder artifacts source of
203− Left err ->
204+ Left exit ->
204− error "problem compiling src/Error.elm"
205+ do putStrLn "Problem in src/Error.elm"
206+ Exit.toStderr (Exit.workerToReport exit)
207+ Exit.exitFailure
205
208
206 Right builder ->
209 Right builder ->
207 return (LBS.toStrict (B.toLazyByteString builder))
210 return (LBS.toStrict (B.toLazyByteString builder))