git.iko.soy/elk
on master help sign in
make sure the worker gives JSON errors appropriately
d3b9f59Evan Czaplicki
worker/src/Main.hs+44−35
compare with master
unifiedsplit
@@ -53,10 +53,10 @@ import qualified Reporting.Render.Code as Code
53main :: IO ()
53main :: IO ()
54main =
54main =
55 do artifacts <- loadArtifacts
55 do artifacts <- loadArtifacts
56− errorHtml <- compileErrorViewer artifacts
56+ errorJS <- compileErrorViewer artifacts
57 httpServe config $ msum $
57 httpServe config $ msum $
58 [ path "compile" $ compile artifacts
58 [ path "compile" $ compile artifacts
59− , path "compile/error.js" $ writeBS errorHtml
59+ , path "compile/error.js" $ writeBS errorJS
60 , notFound
60 , notFound
61 ]
61 ]
62
62
@@ -87,7 +87,7 @@ notFound =
87
87
88
88
89
89
90−-- COMPILE
90+-- COMPILE ENDPOINT
91
91
92
92
93compile :: Artifacts -> Snap ()
93compile :: Artifacts -> Snap ()
@@ -96,12 +96,7 @@ compile artifacts =
96 do parts <- handleMultipart defaultUploadPolicy handlePart
96 do parts <- handleMultipart defaultUploadPolicy handlePart
97 case parts of
97 case parts of
98 [Just source] ->
98 [Just source] ->
99− case compileToBuilder artifacts source of
99+ writeBuilder $ compileToBuilder artifacts source
100− Left err ->
101− writeBuilder $ errorToHtmlBuilder source err
102−
103− Right builder ->
104− writeBuilder builder
105
100
106 _ ->
101 _ ->
107 pass
102 pass
@@ -114,46 +109,32 @@ handlePart info stream =
114 else return Nothing
109 else return Nothing
115
110
116
111
117−errorToHtmlBuilder :: B.ByteString -> Error.Error -> B.Builder
118−errorToHtmlBuilder source err =
119− let
120− json = Encode.encodeUgly (Error.errorToJson (Code.toSource source) err)
121− in
122− [r|<!DOCTYPE HTML>
123−<html>
124−<head>
125− <meta charset="UTF-8">
126− <style>body { padding: 0; margin: 0; }</style>
127− <script src="https://worker.elm-lang.org/compile/error.js"></script>
128− <script>Elm.Error.init({flags:|] <> json <> [r|})</script>
129−</head>
130−<body></body>
131−</html>|]
132
112
113+-- COMPILE TO BUILDER
133
114
134
115
135compileToBuilder :: Artifacts -> B.ByteString -> Either Error.Error B.Builder
116compileToBuilder :: Artifacts -> B.ByteString -> Either Error.Error B.Builder
136compileToBuilder (Artifacts interfaces objects) source =
117compileToBuilder (Artifacts interfaces objects) source =
137 case Parse.fromByteString Pkg.dummyName source of
118 case Parse.fromByteString Pkg.dummyName source of
138 Left err ->
119 Left err ->
139− Left (Error.BadSyntax err)
120+ toInputError N._Main source (Error.BadSyntax err)
140
121
141 Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
122 Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
142 case checkImports interfaces imports of
123 case checkImports interfaces imports of
143 Left err ->
124 Left err ->
144− Left err
125+ toInputError (Src.getName modul) source (Error.BadImports err)
145
126
146 Right ifaces ->
127 Right ifaces ->
147 case Compile.compile Pkg.dummyName ifaces modul of
128 case Compile.compile Pkg.dummyName ifaces modul of
148 Left err ->
129 Left err ->
149− Left err
130+ toInputError (Src.getName modul) source err
150
131
151− Right artifacts@(Compile.Artifacts modul _ locals@(Opt.LocalGraph maybeMain _ _)) ->
132+ Right artifacts@(Compile.Artifacts modul _ locals) ->
152− case maybeMain of
133+ case locals of
153− Nothing ->
134+ Opt.LocalGraph Nothing _ _ ->
154− Left (error "TODO no main")
135+ exitToHtmlBuilder Exit.WorkerNoMain
155
136
156− Just main ->
137+ Opt.LocalGraph (Just main) _ _ ->
157 let
138 let
158 mode = Mode.Dev Nothing
139 mode = Mode.Dev Nothing
159 home = Can._name modul
140 home = Can._name modul
@@ -161,10 +142,10 @@ compileToBuilder (Artifacts interfaces objects) source =
161 mains = Map.singleton home main
142 mains = Map.singleton home main
162 graph = Opt.addLocalGraph locals objects
143 graph = Opt.addLocalGraph locals objects
163 in
144 in
164− Right $ Html.sandwich name $ Generate.generate mode graph mains
145+ Html.sandwich name $ Generate.generate mode graph mains
165
146
166
147
167−checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either Error.Error (Map.Map ModuleName.Raw I.Interface)
148+checkImports :: Map.Map ModuleName.Raw I.Interface -> [Src.Import] -> Either (NE.List Import.Error) (Map.Map ModuleName.Raw I.Interface)
168checkImports interfaces imports =
149checkImports interfaces imports =
169 let
150 let
170 importDict = Map.fromValues Src.getImportName imports
151 importDict = Map.fromValues Src.getImportName imports
@@ -180,7 +161,35 @@ checkImports interfaces imports =
180 toError (Src.Import (A.At region name) _ _) =
161 toError (Src.Import (A.At region name) _ _) =
181 Import.Error region name unimported Import.NotFound
162 Import.Error region name unimported Import.NotFound
182 in
163 in
183− Left (Error.BadImports (fmap toError (NE.List i is)))
164+ Left (fmap toError (NE.List i is))
165+
166+
167+
168+-- COMPILE ERRORS
169+
170+
171+toInputError :: ModuleName.Raw -> B.ByteString -> Error.Error -> B.Builder
172+toInputError name source err =
173+ exitToHtmlBuilder $ Exit.WorkerInputError $
174+ Error.Module name "/try" File.zeroTime source err
175+
176+
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>|]
184
193
185
194
186
195