@@ -1,7 +1,6 @@
11module Main where
22
33import Prelude
4−
54import Data.Array (fromFoldable, head, (..))
65import Data.Either (Either(..))
76import Data.Foldable (for_)
@@ -12,8 +11,7 @@ import Data.Posix.Signal (Signal(..))
1211import Data.String.Utils (lines)
1312import Data.Time.Duration (Seconds(..), fromDuration)
1413import Effect (Effect)
15−import Effect.AVar as AVar
16−import Effect.Aff (Aff, Milliseconds(..), bracket, delay, effectCanceler, launchAff_, makeAff)
14+import Effect.Aff (Aff, effectCanceler, launchAff_, makeAff)
1715import Effect.Aff.Class (liftAff)
1816import Effect.Class (class MonadEffect, liftEffect)
1917import Effect.Class.Console (info, log)
@@ -31,7 +29,7 @@ import Node.Express.App as E
3129import Node.Express.Handler (HandlerM(..), Handler)
3230import Node.Express.Middleware.Static (static)
3331import Node.Express.Request (getBody')
34−import Node.Express.Response (sendFile, setStatus)
32+import Node.Express.Response (setStatus)
3533import Node.Express.Response as Response
3634import Node.Express.Types (Request, Response)
3735import Node.FS.Aff (readTextFile, writeTextFile)
@@ -40,7 +38,7 @@ import Node.OS (numCpus)
4038import Node.Process (lookupEnv)
4139import Playground.Playground (Folder(..), copy)
4240import Shared.Json (readAff)
43−import Shared.Models.Body (RunResult, PursResult)
41+import Shared.Models.Body (PursResult, RunResult, CompileRequest)
4442import Shared.Models.Body as Body
4543import Simple.JSON (read_, write)
4644import Simple.JSON as JSON
@@ -91,54 +89,27 @@ execCommand folder command =
9189 childProcess <- exec command options (callback <<< Right)
9290 pure $ effectCanceler ((log $ "Killing " <> show (pid childProcess)) *> kill SIGKILL childProcess)
9391
94−compileHandler ∷ Queue Folder -> HandlerM Unit
95−compileHandler queue = do
92+compileAndRunJob ∷ CompileRequest -> (Handler -> Aff Unit) -> NewJob Folder
93+compileAndRunJob json handle =
94+ NewJob \folder -> do
95+ compileResult <- compileCode folder (json ∷ Body.CompileRequest).code
96+ if compileResult.errors /= [] then do
97+ handle $ setStatus 422
98+ handle $ Response.send $ write ({ result: compileResult } ∷ Body.CompileResult)
99+ else do
100+ runResult <- runCode folder
101+ resultBody <- toBody runResult
102+ handle $ Response.send $ write (resultBody ∷ Body.RunResult)
103+
104+compileAndRunHandler ∷ Queue Folder -> Handler
105+compileAndRunHandler queue = do
96106 body <- getBody'
97107 json <- readAff body # liftAff
98− resultVar <- AVar.empty # liftEffect
99− let
100− cleanup ∷ Aff Unit
101− cleanup = AVar.tryPut Nothing resultVar # liftEffect # void
102−
103− compileJob =
104− NewJob \folder ->
105− bracket (pure unit) (const cleanup) \_ -> do
106− result <- compileCode folder (json ∷ Body.CompileRequest).code
107− AVar.tryPut (Just result) resultVar # liftEffect # void
108− queueRes <- Q.enqueue compileJob queue # liftEffect
109− let
110− getResult ∷ Handler
111− getResult = do
112− maybeResult <- AVar.tryRead resultVar # liftEffect
113− case maybeResult of
114− Just (Just result) -> Response.send $ write ({ result } ∷ Body.CompileResult)
115− Just Nothing -> do
116− setStatus 500
117− Response.send $ write { error: "Timeout" }
118− Nothing -> do
119− delay (100.0 # Milliseconds) # liftAff
120− getResult
121− case queueRes of
122− Enqueued _ -> getResult
123− QueueFull -> do
124− setStatus 500
125− Response.send $ write { error: "Queue full" }
126−
127−unHandler ∷ ∀ t6. Request -> Response -> Effect Unit -> HandlerM t6 -> Aff t6
128−unHandler req res next (HandlerM h) = h req res next
129−
130−runHandler ∷ Queue Folder -> HandlerM Unit
131−runHandler queue =
132108 HandlerM \req res next -> do
133109 let
134110 handle = unHandler req res next
135111
136− runJob =
137− NewJob \folder ->
138− bracket (pure unit) (const (pure unit)) \_ -> do
139− result <- runCode folder
140− resultBody <- toBody result
141− handle $ Response.send $ write (resultBody ∷ Body.RunResult)
112+ runJob = compileAndRunJob json handle
142113 queueRes <- Q.enqueue runJob queue # liftEffect
143114 case queueRes of
144115 Enqueued _ -> pure unit
@@ -147,10 +118,13 @@ runHandler queue =
147118 setStatus 500
148119 Response.send $ write { error: "Queue full" }
149120
150−srcFolder :: String
121+unHandler ∷ ∀ a. Request -> Response -> Effect Unit -> HandlerM a -> Aff a
122+unHandler req res next (HandlerM h) = h req res next
123+
124+srcFolder ∷ String
151125srcFolder = "../playground"
152126
153−destFolder :: String
127+destFolder ∷ String
154128destFolder = "../playgrounds/"
155129
156130main ∷ Effect Unit
@@ -163,6 +137,7 @@ main =
163137 mkFolder = Folder <<< (destFolder <> _) <<< show
164138
165139 folders = mkFolder <$> (0 .. foldersToUse)
140+
166141 folderPool = ResourcePool folders
167142 for_ folders \(Folder f) -> copy srcFolder f
168143 q <-
@@ -177,8 +152,7 @@ makeApp ∷ Queue Folder -> App
177152makeApp q = do
178153 use $ static "assets"
179154 useExternal jsonBodyParser
180− E.post "/compile" (compileHandler q)
181− E.post "/run" (runHandler q)
155+ E.post "/compileAndRun" (compileAndRunHandler q)
182156
183157data CertificatesToUse
184158 = UseLocalCertificates
@@ -205,4 +179,4 @@ serverSetup app = do
205179 makeHttpsOptions = do
206180 key <- readTextFile UTF8 "server.key"
207181 cert <- readTextFile UTF8 "server.cert"
208− pure { key, cert }
182+ pure { key, cert }