git.iko.soy/rowtype-yoga/psfp
on master help sign in
compileandrun in one
e1da511Mark Eibes
server/src/Main.purs+26−52
compare with master
unifiedsplit
@@ -1,7 +1,6 @@
1module Main where
1module Main where
2
2
3import Prelude
3import Prelude
4−
5import Data.Array (fromFoldable, head, (..))
4import Data.Array (fromFoldable, head, (..))
6import Data.Either (Either(..))
5import Data.Either (Either(..))
7import Data.Foldable (for_)
6import Data.Foldable (for_)
@@ -12,8 +11,7 @@ import Data.Posix.Signal (Signal(..))
12import Data.String.Utils (lines)
11import Data.String.Utils (lines)
13import Data.Time.Duration (Seconds(..), fromDuration)
12import Data.Time.Duration (Seconds(..), fromDuration)
14import Effect (Effect)
13import 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)
17import Effect.Aff.Class (liftAff)
15import Effect.Aff.Class (liftAff)
18import Effect.Class (class MonadEffect, liftEffect)
16import Effect.Class (class MonadEffect, liftEffect)
19import Effect.Class.Console (info, log)
17import Effect.Class.Console (info, log)
@@ -31,7 +29,7 @@ import Node.Express.App as E
31import Node.Express.Handler (HandlerM(..), Handler)
29import Node.Express.Handler (HandlerM(..), Handler)
32import Node.Express.Middleware.Static (static)
30import Node.Express.Middleware.Static (static)
33import Node.Express.Request (getBody')
31import Node.Express.Request (getBody')
34−import Node.Express.Response (sendFile, setStatus)
32+import Node.Express.Response (setStatus)
35import Node.Express.Response as Response
33import Node.Express.Response as Response
36import Node.Express.Types (Request, Response)
34import Node.Express.Types (Request, Response)
37import Node.FS.Aff (readTextFile, writeTextFile)
35import Node.FS.Aff (readTextFile, writeTextFile)
@@ -40,7 +38,7 @@ import Node.OS (numCpus)
40import Node.Process (lookupEnv)
38import Node.Process (lookupEnv)
41import Playground.Playground (Folder(..), copy)
39import Playground.Playground (Folder(..), copy)
42import Shared.Json (readAff)
40import Shared.Json (readAff)
43−import Shared.Models.Body (RunResult, PursResult)
41+import Shared.Models.Body (PursResult, RunResult, CompileRequest)
44import Shared.Models.Body as Body
42import Shared.Models.Body as Body
45import Simple.JSON (read_, write)
43import Simple.JSON (read_, write)
46import Simple.JSON as JSON
44import Simple.JSON as JSON
@@ -91,54 +89,27 @@ execCommand folder command =
91 childProcess <- exec command options (callback <<< Right)
89 childProcess <- exec command options (callback <<< Right)
92 pure $ effectCanceler ((log $ "Killing " <> show (pid childProcess)) *> kill SIGKILL childProcess)
90 pure $ effectCanceler ((log $ "Killing " <> show (pid childProcess)) *> kill SIGKILL childProcess)
93
91
94−compileHandler ∷ Queue Folder -> HandlerM Unit
92+compileAndRunJob ∷ CompileRequest -> (Handler -> Aff Unit) -> NewJob Folder
95−compileHandler queue = do
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
96 body <- getBody'
106 body <- getBody'
97 json <- readAff body # liftAff
107 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 =
132 HandlerM \req res next -> do
108 HandlerM \req res next -> do
133 let
109 let
134 handle = unHandler req res next
110 handle = unHandler req res next
135
111
136− runJob =
112+ runJob = compileAndRunJob json handle
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)
142 queueRes <- Q.enqueue runJob queue # liftEffect
113 queueRes <- Q.enqueue runJob queue # liftEffect
143 case queueRes of
114 case queueRes of
144 Enqueued _ -> pure unit
115 Enqueued _ -> pure unit
@@ -147,10 +118,13 @@ runHandler queue =
147 setStatus 500
118 setStatus 500
148 Response.send $ write { error: "Queue full" }
119 Response.send $ write { error: "Queue full" }
149
120
121+unHandler ∷ ∀ a. Request -> Response -> Effect Unit -> HandlerM a -> Aff a
122+unHandler req res next (HandlerM h) = h req res next
123+
150−srcFolder :: String
124+srcFolder ∷ String
151srcFolder = "../playground"
125srcFolder = "../playground"
152
126
153−destFolder :: String
127+destFolder ∷ String
154destFolder = "../playgrounds/"
128destFolder = "../playgrounds/"
155
129
156main ∷ Effect Unit
130main ∷ Effect Unit
@@ -163,6 +137,7 @@ main =
163 mkFolder = Folder <<< (destFolder <> _) <<< show
137 mkFolder = Folder <<< (destFolder <> _) <<< show
164
138
165 folders = mkFolder <$> (0 .. foldersToUse)
139 folders = mkFolder <$> (0 .. foldersToUse)
140+
166 folderPool = ResourcePool folders
141 folderPool = ResourcePool folders
167 for_ folders \(Folder f) -> copy srcFolder f
142 for_ folders \(Folder f) -> copy srcFolder f
168 q <-
143 q <-
@@ -177,8 +152,7 @@ makeApp ∷ Queue Folder -> App
177makeApp q = do
152makeApp q = do
178 use $ static "assets"
153 use $ static "assets"
179 useExternal jsonBodyParser
154 useExternal jsonBodyParser
180− E.post "/compile" (compileHandler q)
155+ E.post "/compileAndRun" (compileAndRunHandler q)
181− E.post "/run" (runHandler q)
182
156
183data CertificatesToUse
157data CertificatesToUse
184 = UseLocalCertificates
158 = UseLocalCertificates
@@ -205,4 +179,4 @@ serverSetup app = do
205 makeHttpsOptions = do
179 makeHttpsOptions = do
206 key <- readTextFile UTF8 "server.key"
180 key <- readTextFile UTF8 "server.key"
207 cert <- readTextFile UTF8 "server.cert"
181 cert <- readTextFile UTF8 "server.cert"
208− pure { key, cert }
182+ pure { key, cert }