on master help sign in
Get rid of record config + add easier names
commit2b1be53565cf9a845e7614b7528b67b89c074e42 authorTereza Sokol <terezasokol@gmail.com> dateSun 22 Aug 2021, 13:27 (5 years ago) parent87a474e
2 files changed+50−43
worker/src/Endpoint/Compile.hs+48−41 worker/src/Main.hs+2−2
worker/src/Endpoint/Compile.hs+48−41
@@ -1,8 +1,8 @@
11{-# OPTIONS_GHC -Wall #-}
22{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
33module Endpoint.Compile
4− ( endpointV1
5− , endpointV2
4+ ( endpoint_V1
5+ , endpoint_V2
66 , loadErrorJS
77 )
88 where
@@ -64,51 +64,50 @@ allowedOrigins =
6464
6565
6666
67−-- ENDPOINT
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+
6877
6978
70−endpointV1 :: A.Artifacts -> Snap ()
71−endpointV1 artifacts =
72− endpoint artifacts $
73− RenderTemplates
74− { onSuccess = Html.sandwich
75− , onProblems = renderV1ProblemHtml
76− }
79+-- ENDPOINT (V2)
7780
7881
79−endpointV2 :: A.Artifacts -> Snap ()
80−endpointV2 artifacts =
81− endpoint artifacts $
82− RenderTemplates
83− { onSuccess = renderV2SuccessHtml
84− , onProblems = renderV2ProblemHtml
85− }
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+
91+-- ENDPOINT
8692
8793
88−data RenderTemplates =
89− RenderTemplates
90− { onSuccess :: N.Name -> B.Builder -> B.Builder
91− , onProblems :: Help.Report -> B.Builder
92− }
94+data Result
95+ = Ok N.Name B.Builder
96+ | Err Help.Report
9397
9498
95−endpoint :: A.Artifacts -> RenderTemplates -> Snap ()
96−endpoint artifacts templates =
99+endpoint :: A.Artifacts -> (Result -> Snap ()) -> Snap ()
100+endpoint artifacts callback =
97101 Cors.allow POST allowedOrigins $
98102 do result <- foldMultipart defaultUploadPolicy ignoreFile 0
99103 case result of
100104 ([("code",source)], 0) ->
101105 do modifyResponse $ setContentType "text/html; charset=utf-8"
102− case compile artifacts source of
103− Success name builder ->
104− writeBuilder (onSuccess templates name builder)
105−
106− NoMain ->
107− writeBuilder $ onProblems templates noMain
108−
109− BadInput name err ->
110− writeBuilder $ onProblems templates $
111− Help.compilerReport "/" (Error.Module name "/try" File.zeroTime source err) []
106+ callback $
107+ case compile artifacts source of
108+ Success name js -> Ok name js
109+ NoMain -> Err noMain
110+ BadInput name err -> Err $ Help.compilerReport "/" (Error.Module name "/try" File.zeroTime source err) []
112111
113112 _ ->
114113 do modifyResponse $ setResponseStatus 400 "Bad Request"
@@ -189,11 +188,11 @@ checkImports interfaces imports =
189188
190189
191190
192−-- RENDER RESULTING HTML
191+-- RENDER PROBLEM (V1)
193192
194193
195−renderV1ProblemHtml :: Help.Report -> B.Builder
196−renderV1ProblemHtml report =
194+renderProblem_V1 :: Help.Report -> B.Builder
195+renderProblem_V1 report =
197196 [r|<!DOCTYPE HTML>
198197<html>
199198<head>
@@ -212,8 +211,12 @@ renderV1ProblemHtml report =
212211</html>|]
213212
214213
215−renderV2SuccessHtml :: N.Name -> B.Builder -> B.Builder
216−renderV2SuccessHtml moduleName javascript =
214+
215+-- RENDER SUCCESS (V2)
216+
217+
218+renderSuccess_V2 :: N.Name -> B.Builder -> B.Builder
219+renderSuccess_V2 moduleName javascript =
217220 let name = N.toBuilder moduleName in
218221 [r|<!DOCTYPE HTML>
219222<html>
@@ -252,8 +255,12 @@ catch (e)
252255</html>|]
253256
254257
255−renderV2ProblemHtml :: Help.Report -> B.Builder
256−renderV2ProblemHtml report =
258+
259+-- RENDER PROBLEM (V2)
260+
261+
262+renderProblem_V2 :: Help.Report -> B.Builder
263+renderProblem_V2 report =
257264 [r|<!DOCTYPE HTML>
258265<html>
259266<head>
worker/src/Main.hs+2−2
@@ -31,8 +31,8 @@ main =
3131 httpServe config $ msum $
3232 [ ifTop $ status
3333 , path "repl" $ Repl.endpoint rArtifacts
34− , path "compile" $ Compile.endpointV1 cArtifacts
35− , path "compile/v2" $ Compile.endpointV2 cArtifacts
34+ , path "compile" $ Compile.endpoint_V1 cArtifacts
35+ , path "compile/v2" $ Compile.endpoint_V2 cArtifacts
3636 , path "compile/errors.js" $ serveJavaScript errorJS
3737 , path "compile/deps-info.json" $ serveDepsInfo depsInfo
3838 , notFound