@@ -14,6 +14,7 @@ import qualified Data.ByteString.Lazy as LBS
1414import qualified Data.HashSet as HashSet
1515import qualified Data.Map as Map
1616import qualified Data.Map.Utils as Map
17+import qualified Data.Name as N
1718import qualified Data.NonEmptyList as NE
1819import qualified Data.OneOrMore as OneOrMore
1920import Network.URI (parseURI)
@@ -23,6 +24,7 @@ import Snap.Util.CORS
2324import Snap.Util.FileServe (serveFile)
2425import Snap.Util.FileUploads
2526import qualified System.Directory as Dir
27+import qualified System.Exit as Exit
2628import qualified System.IO.Streams as Stream
2729import Text.RawString.QQ (r)
2830
@@ -34,6 +36,7 @@ import qualified Elm.Details as Details
3436import qualified Elm.Interface as I
3537import qualified Elm.ModuleName as ModuleName
3638import qualified Elm.Package as Pkg
39+import qualified File
3740import qualified Generate.Html as Html
3841import qualified Generate.JavaScript as Generate
3942import qualified Generate.Mode as Mode
@@ -43,7 +46,7 @@ import qualified Reporting
4346import qualified Reporting.Annotation as A
4447import qualified Reporting.Error as Error
4548import qualified Reporting.Error.Import as Import
46−import qualified Reporting.Render.Code as Code
49+import qualified Reporting.Exit as Exit
4750
4851
4952
@@ -96,7 +99,9 @@ compile artifacts =
9699 do parts <- handleMultipart defaultUploadPolicy handlePart
97100 case parts of
98101 [Just source] ->
99− writeBuilder $ compileToBuilder artifacts source
102+ case compileToBuilder artifacts source of
103+ Right builder -> writeBuilder builder
104+ Left exit -> writeBuilder (exitToHtmlBuilder exit)
100105
101106 _ ->
102107 pass
@@ -109,30 +114,48 @@ handlePart info stream =
109114 else return Nothing
110115
111116
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+
112135
113136-- COMPILE TO BUILDER
114137
115138
116−compileToBuilder :: Artifacts -> B.ByteString -> Either Error.Error B.Builder
139+compileToBuilder :: Artifacts -> B.ByteString -> Either Exit.Worker B.Builder
117140compileToBuilder (Artifacts interfaces objects) source =
118141 case Parse.fromByteString Pkg.dummyName source of
119142 Left err ->
120− toInputError N._Main source (Error.BadSyntax err)
143+ Left $ toInputError N._Main source (Error.BadSyntax err)
121144
122145 Right modul@(Src.Module _ _ _ imports _ _ _ _ _) ->
123146 case checkImports interfaces imports of
124147 Left err ->
125− toInputError (Src.getName modul) source (Error.BadImports err)
148+ Left $ toInputError (Src.getName modul) source (Error.BadImports err)
126149
127150 Right ifaces ->
128151 case Compile.compile Pkg.dummyName ifaces modul of
129152 Left err ->
130− toInputError (Src.getName modul) source err
153+ Left $ toInputError (Src.getName modul) source err
131154
132155 Right artifacts@(Compile.Artifacts modul _ locals) ->
133156 case locals of
134157 Opt.LocalGraph Nothing _ _ ->
135− exitToHtmlBuilder Exit.WorkerNoMain
158+ Left Exit.WorkerNoMain
136159
137160 Opt.LocalGraph (Just main) _ _ ->
138161 let
@@ -142,7 +165,7 @@ compileToBuilder (Artifacts interfaces objects) source =
142165 mains = Map.singleton home main
143166 graph = Opt.addLocalGraph locals objects
144167 in
145− Html.sandwich name $ Generate.generate mode graph mains
168+ Right $ Html.sandwich name $ Generate.generate mode graph mains
146169
147170
148171checkImports :: 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 =
164187 Left (fmap toError (NE.List i is))
165188
166189
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
172191toInputError name source err =
173− exitToHtmlBuilder $ Exit.WorkerInputError $
192+ Exit.WorkerInputError $
174193 Error.Module name "/try" File.zeroTime source err
175194
176195
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−
195196
196197-- COMPILE ERROR VIEWER
197198
198199
199−compileErrorViewer :: Artifacts -> B.ByteString
200+compileErrorViewer :: Artifacts -> IO B.ByteString
200201compileErrorViewer artifacts =
201202 do source <- File.readUtf8 "src/Error.elm"
202203 case compileToBuilder artifacts source of
203− Left err ->
204− error "problem compiling src/Error.elm"
204+ Left exit ->
205+ do putStrLn "Problem in src/Error.elm"
206+ Exit.toStderr (Exit.workerToReport exit)
207+ Exit.exitFailure
205208
206209 Right builder ->
207210 return (LBS.toStrict (B.toLazyByteString builder))