Skip to content

Commit

Permalink
Get rid of record config + add easier names
Browse files Browse the repository at this point in the history
  • Loading branch information
terezka committed Aug 22, 2021
1 parent 87a474e commit 2b1be53
Show file tree
Hide file tree
Showing 2 changed files with 50 additions and 43 deletions.
89 changes: 48 additions & 41 deletions worker/src/Endpoint/Compile.hs
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE OverloadedStrings, QuasiQuotes #-}
module Endpoint.Compile
( endpointV1
, endpointV2
( endpoint_V1
, endpoint_V2
, loadErrorJS
)
where
Expand Down Expand Up @@ -64,51 +64,50 @@ allowedOrigins =



-- ENDPOINT
-- ENDPOINT (V1)


endpoint_V1 :: A.Artifacts -> Snap ()
endpoint_V1 artifacts =
endpoint artifacts $ \result ->
case result of
Ok name js -> writeBuilder $ Html.sandwich name js
Err report -> writeBuilder $ renderProblem_V1 report



endpointV1 :: A.Artifacts -> Snap ()
endpointV1 artifacts =
endpoint artifacts $
RenderTemplates
{ onSuccess = Html.sandwich
, onProblems = renderV1ProblemHtml
}
-- ENDPOINT (V2)


endpointV2 :: A.Artifacts -> Snap ()
endpointV2 artifacts =
endpoint artifacts $
RenderTemplates
{ onSuccess = renderV2SuccessHtml
, onProblems = renderV2ProblemHtml
}
endpoint_V2 :: A.Artifacts -> Snap ()
endpoint_V2 artifacts =
endpoint artifacts $ \result ->
case result of
Ok name js -> writeBuilder $ renderSuccess_V2 name js
Err report -> writeBuilder $ renderProblem_V2 report



-- ENDPOINT


data RenderTemplates =
RenderTemplates
{ onSuccess :: N.Name -> B.Builder -> B.Builder
, onProblems :: Help.Report -> B.Builder
}
data Result
= Ok N.Name B.Builder
| Err Help.Report


endpoint :: A.Artifacts -> RenderTemplates -> Snap ()
endpoint artifacts templates =
endpoint :: A.Artifacts -> (Result -> Snap ()) -> Snap ()
endpoint artifacts callback =
Cors.allow POST allowedOrigins $
do result <- foldMultipart defaultUploadPolicy ignoreFile 0
case result of
([("code",source)], 0) ->
do modifyResponse $ setContentType "text/html; charset=utf-8"
case compile artifacts source of
Success name builder ->
writeBuilder (onSuccess templates name builder)

NoMain ->
writeBuilder $ onProblems templates noMain

BadInput name err ->
writeBuilder $ onProblems templates $
Help.compilerReport "/" (Error.Module name "/try" File.zeroTime source err) []
callback $
case compile artifacts source of
Success name js -> Ok name js
NoMain -> Err noMain
BadInput name err -> Err $ Help.compilerReport "/" (Error.Module name "/try" File.zeroTime source err) []

_ ->
do modifyResponse $ setResponseStatus 400 "Bad Request"
Expand Down Expand Up @@ -189,11 +188,11 @@ checkImports interfaces imports =



-- RENDER RESULTING HTML
-- RENDER PROBLEM (V1)


renderV1ProblemHtml :: Help.Report -> B.Builder
renderV1ProblemHtml report =
renderProblem_V1 :: Help.Report -> B.Builder
renderProblem_V1 report =
[r|<!DOCTYPE HTML>
<html>
<head>
Expand All @@ -212,8 +211,12 @@ renderV1ProblemHtml report =
</html>|]


renderV2SuccessHtml :: N.Name -> B.Builder -> B.Builder
renderV2SuccessHtml moduleName javascript =

-- RENDER SUCCESS (V2)


renderSuccess_V2 :: N.Name -> B.Builder -> B.Builder
renderSuccess_V2 moduleName javascript =
let name = N.toBuilder moduleName in
[r|<!DOCTYPE HTML>
<html>
Expand Down Expand Up @@ -252,8 +255,12 @@ catch (e)
</html>|]


renderV2ProblemHtml :: Help.Report -> B.Builder
renderV2ProblemHtml report =

-- RENDER PROBLEM (V2)


renderProblem_V2 :: Help.Report -> B.Builder
renderProblem_V2 report =
[r|<!DOCTYPE HTML>
<html>
<head>
Expand Down
4 changes: 2 additions & 2 deletions worker/src/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -31,8 +31,8 @@ main =
httpServe config $ msum $
[ ifTop $ status
, path "repl" $ Repl.endpoint rArtifacts
, path "compile" $ Compile.endpointV1 cArtifacts
, path "compile/v2" $ Compile.endpointV2 cArtifacts
, path "compile" $ Compile.endpoint_V1 cArtifacts
, path "compile/v2" $ Compile.endpoint_V2 cArtifacts
, path "compile/errors.js" $ serveJavaScript errorJS
, path "compile/deps-info.json" $ serveDepsInfo depsInfo
, notFound
Expand Down

0 comments on commit 2b1be53

Please sign in to comment.