mirror of
https://github.com/rowtype-yoga/psfp.git
synced 2024-09-11 16:25:36 +03:00
Update server to 0.14
This commit is contained in:
parent
6709b95553
commit
3ddabbe512
42
server/.vscode/settings.json
vendored
42
server/.vscode/settings.json
vendored
@ -1,21 +1,23 @@
|
||||
{
|
||||
"editor.formatOnSave": true,
|
||||
"regreplace.commands": [
|
||||
{
|
||||
"name": "replace double colon with unicode version",
|
||||
"match": "\\.purs?$",
|
||||
"regexp": " ::(\\s)",
|
||||
"global": true,
|
||||
"replace": " ∷$1"
|
||||
},
|
||||
{
|
||||
"name": "replace forall with unicode version",
|
||||
"match": "\\.purs?$",
|
||||
"regexp": "forall(\\s)",
|
||||
"global": true,
|
||||
"replace": "∀$1"
|
||||
},
|
||||
],
|
||||
"purescript.buildCommand": "npx spago build --purs-args '--json-errors'",
|
||||
"vscode_custom_css.imports": ["file:///Users/mark/.vscode-oss/extensions/webrender.synthwave-x-fluoromachine-0.0.9/synthwave-x-fluoromachine.css"]
|
||||
}
|
||||
"editor.formatOnSave": false,
|
||||
"regreplace.commands": [
|
||||
{
|
||||
"name": "replace double colon with unicode version",
|
||||
"match": "\\.purs?$",
|
||||
"regexp": " ::(\\s)",
|
||||
"global": true,
|
||||
"replace": " ∷$1"
|
||||
},
|
||||
{
|
||||
"name": "replace forall with unicode version",
|
||||
"match": "\\.purs?$",
|
||||
"regexp": "forall(\\s)",
|
||||
"global": true,
|
||||
"replace": "∀$1"
|
||||
},
|
||||
],
|
||||
"purescript.buildCommand": "npx spago build --purs-args '--json-errors'",
|
||||
"vscode_custom_css.imports": [
|
||||
"file:///Users/mark/.vscode-oss/extensions/webrender.synthwave-x-fluoromachine-0.0.9/synthwave-x-fluoromachine.css"
|
||||
]
|
||||
}
|
File diff suppressed because one or more lines are too long
2847
server/package-lock.json
generated
2847
server/package-lock.json
generated
File diff suppressed because it is too large
Load Diff
@ -21,7 +21,7 @@
|
||||
"uuid": "^7.0.2"
|
||||
},
|
||||
"devDependencies": {
|
||||
"purescript": "^0.13.6",
|
||||
"spago": "^0.14.0"
|
||||
"purescript": "^0.14.0",
|
||||
"spago": "^0.19.1"
|
||||
}
|
||||
}
|
||||
|
@ -116,103 +116,165 @@ let additions =
|
||||
}
|
||||
-------------------------------
|
||||
-}
|
||||
|
||||
|
||||
let upstream =
|
||||
https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200309/packages.dhall sha256:9221987b4e7ea99ccd0efbe056f7bebc872cd92e0058efe5baa181d73359e7b3
|
||||
-- https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200309/packages.dhall sha256:9221987b4e7ea99ccd0efbe056f7bebc872cd92e0058efe5baa181d73359e7b3
|
||||
https://github.com/purescript/package-sets/releases/download/psc-0.14.0-20210317/packages.dhall sha256:e2e744972f9b60188dcf07f41418661b505c9ee2e9f91e57e67daefad3a5ae09
|
||||
|
||||
let overrides =
|
||||
{ react-basic-hooks =
|
||||
upstream.react-basic-hooks
|
||||
⫽ { repo =
|
||||
"https://github.com/i-am-the-slime/purescript-react-basic-hooks.git"
|
||||
, version = "e04b106ab2dfda3f9a1407420c434a908ff72b90"
|
||||
}
|
||||
upstream.react-basic-hooks
|
||||
// { repo =
|
||||
"https://github.com/i-am-the-slime/purescript-react-basic-hooks.git"
|
||||
, version = "e04b106ab2dfda3f9a1407420c434a908ff72b90"
|
||||
}
|
||||
, css =
|
||||
upstream.css
|
||||
⫽ { repo = "https://github.com/i-am-the-slime/purescript-css.git"
|
||||
, version = "8ea0bab17c268d9c62a09892d7ba231dcbe6308b"
|
||||
}
|
||||
upstream.css
|
||||
// { repo = "https://github.com/i-am-the-slime/purescript-css.git"
|
||||
, version = "8ea0bab17c268d9c62a09892d7ba231dcbe6308b"
|
||||
}
|
||||
|
||||
, node-net = upstream.node-net
|
||||
// { repo = "https://github.com/i-am-the-slime/purescript-node-net.git"
|
||||
, version = "b4efc12a6bc8df695f90e408290b3b82dcd8548b"
|
||||
}
|
||||
}
|
||||
|
||||
let additions =
|
||||
{ react-testing-library =
|
||||
{ dependencies =
|
||||
[ "aff-promise"
|
||||
, "console"
|
||||
, "debug"
|
||||
, "effect"
|
||||
, "foreign"
|
||||
, "foreign-object"
|
||||
, "psci-support"
|
||||
, "react-basic-hooks"
|
||||
, "remotedata"
|
||||
, "run"
|
||||
, "simple-json"
|
||||
, "spec"
|
||||
, "spec-discovery"
|
||||
]
|
||||
, repo =
|
||||
"https://github.com/i-am-the-slime/purescript-react-testing-library.git"
|
||||
, version = "13a63056506a3ce32572e326130be325931ba7c0"
|
||||
}
|
||||
{ dependencies =
|
||||
[ "aff-promise"
|
||||
, "console"
|
||||
, "debug"
|
||||
, "effect"
|
||||
, "foreign"
|
||||
, "foreign-object"
|
||||
, "psci-support"
|
||||
, "react-basic-hooks"
|
||||
, "remotedata"
|
||||
, "run"
|
||||
, "simple-json"
|
||||
, "spec"
|
||||
, "spec-discovery"
|
||||
]
|
||||
, repo =
|
||||
"https://github.com/i-am-the-slime/purescript-react-testing-library.git"
|
||||
, version = "13a63056506a3ce32572e326130be325931ba7c0"
|
||||
}
|
||||
, pseudo-random =
|
||||
{ dependencies =
|
||||
[ "prelude", "console", "effect", "lcg", "arrays", "st" ]
|
||||
, repo = "https://github.com/opyapeus/purescript-pseudo-random.git"
|
||||
, version = "7715e8a2c096c480a093a5e0a6df1ece4df5ed2a"
|
||||
}
|
||||
{ dependencies =
|
||||
[ "prelude", "console", "effect", "lcg", "arrays", "st" ]
|
||||
, repo = "https://github.com/opyapeus/purescript-pseudo-random.git"
|
||||
, version = "7715e8a2c096c480a093a5e0a6df1ece4df5ed2a"
|
||||
}
|
||||
, oneof =
|
||||
{ dependencies =
|
||||
[ "assert"
|
||||
, "console"
|
||||
, "effect"
|
||||
, "foreign"
|
||||
, "foreign-object"
|
||||
, "literal"
|
||||
, "maybe"
|
||||
, "newtype"
|
||||
, "proxy"
|
||||
, "psci-support"
|
||||
, "tuples"
|
||||
, "unsafe-coerce"
|
||||
]
|
||||
, repo = "https://github.com/jvliwanag/purescript-oneof.git"
|
||||
, version = "0325fddf6ee8a181fac2128c9b542c2c01ddd361"
|
||||
}
|
||||
{ dependencies =
|
||||
[ "assert"
|
||||
, "console"
|
||||
, "effect"
|
||||
, "foreign"
|
||||
, "foreign-object"
|
||||
, "literal"
|
||||
, "maybe"
|
||||
, "newtype"
|
||||
, "proxy"
|
||||
, "psci-support"
|
||||
, "tuples"
|
||||
, "unsafe-coerce"
|
||||
]
|
||||
, repo = "https://github.com/jvliwanag/purescript-oneof.git"
|
||||
, version = "0325fddf6ee8a181fac2128c9b542c2c01ddd361"
|
||||
}
|
||||
, literal =
|
||||
{ dependencies =
|
||||
[ "assert"
|
||||
, "effect"
|
||||
, "console"
|
||||
, "integers"
|
||||
, "numbers"
|
||||
, "partial"
|
||||
, "psci-support"
|
||||
, "unsafe-coerce"
|
||||
, "typelevel-prelude"
|
||||
]
|
||||
, repo = "https://github.com/jvliwanag/purescript-literal.git"
|
||||
, version = "7b2ae20f77c67b7e419a92fdd0dc7a09b447b18e"
|
||||
}
|
||||
{ dependencies =
|
||||
[ "assert"
|
||||
, "effect"
|
||||
, "console"
|
||||
, "integers"
|
||||
, "numbers"
|
||||
, "partial"
|
||||
, "psci-support"
|
||||
, "unsafe-coerce"
|
||||
, "typelevel-prelude"
|
||||
]
|
||||
, repo = "https://github.com/jvliwanag/purescript-literal.git"
|
||||
, version = "7b2ae20f77c67b7e419a92fdd0dc7a09b447b18e"
|
||||
}
|
||||
, justifill =
|
||||
{ dependencies = [ "record", "typelevel-prelude" ]
|
||||
, repo = "https://github.com/i-am-the-slime/purescript-justifill.git"
|
||||
, version = "2de06260ae8e37355678198180bbdd06c91457e3"
|
||||
}
|
||||
{ dependencies = [ "record", "typelevel-prelude" ]
|
||||
, repo = "https://github.com/i-am-the-slime/purescript-justifill.git"
|
||||
, version = "2de06260ae8e37355678198180bbdd06c91457e3"
|
||||
}
|
||||
, matryoshka =
|
||||
{ dependencies =
|
||||
[ "prelude", "fixed-points", "free", "transformers", "profunctor" ]
|
||||
, repo = "https://github.com/slamdata/purescript-matryoshka.git"
|
||||
, version = "caaca2d836d52159ba7963333996286a00428394"
|
||||
}
|
||||
{ dependencies =
|
||||
[ "prelude", "fixed-points", "free", "transformers", "profunctor" ]
|
||||
, repo = "https://github.com/slamdata/purescript-matryoshka.git"
|
||||
, version = "caaca2d836d52159ba7963333996286a00428394"
|
||||
}
|
||||
, interpolate =
|
||||
{ dependencies = [ "prelude" ]
|
||||
, repo =
|
||||
"https://github.com/jordanmartinez/purescript-interpolate.git"
|
||||
, version = "v2.0.1"
|
||||
}
|
||||
{ dependencies = [ "prelude" ]
|
||||
, repo = "https://github.com/jordanmartinez/purescript-interpolate.git"
|
||||
, version = "v2.0.1"
|
||||
}
|
||||
, yoga-components = ../components/spago.dhall as Location
|
||||
}
|
||||
, foreign-generic = {
|
||||
dependencies =
|
||||
[ "effect"
|
||||
, "foreign"
|
||||
, "foreign-object"
|
||||
, "ordered-collections"
|
||||
, "exceptions"
|
||||
, "record"
|
||||
, "identity"
|
||||
]
|
||||
, repo =
|
||||
"https://github.com/fsoikin/purescript-foreign-generic.git"
|
||||
, version =
|
||||
"c9ceaa48d4a03ee3db55f1abfb45f830cae329e7"
|
||||
}
|
||||
, uuid = {
|
||||
dependencies =
|
||||
[ "console"
|
||||
, "effect"
|
||||
, "psci-support"
|
||||
, "spec"
|
||||
, "foreign-generic"
|
||||
]
|
||||
, repo =
|
||||
"https://github.com/spicydonuts/purescript-uuid.git"
|
||||
, version =
|
||||
"7c9b1a1261aadb4db4886b3123683ca29c2663a5"
|
||||
}
|
||||
, express = {
|
||||
dependencies =
|
||||
[ "aff"
|
||||
, "console"
|
||||
, "effect"
|
||||
, "foreign"
|
||||
, "foreign-generic"
|
||||
, "node-http"
|
||||
, "psci-support"
|
||||
, "test-unit"
|
||||
]
|
||||
, repo =
|
||||
"https://github.com/i-am-the-slime/purescript-express.git"
|
||||
, version =
|
||||
"0.14"
|
||||
}
|
||||
, simple-json = {
|
||||
dependencies =
|
||||
[ "prelude"
|
||||
, "typelevel-prelude"
|
||||
, "record"
|
||||
, "variant"
|
||||
, "nullable"
|
||||
, "foreign-object"
|
||||
, "foreign"
|
||||
, "exceptions"
|
||||
, "arrays"
|
||||
]
|
||||
, repo = "https://github.com/angelinatarapko/purescript-simple-json.git"
|
||||
, version = "patch-1"
|
||||
}
|
||||
}
|
||||
|
||||
in upstream ⫽ overrides ⫽ additions
|
||||
in upstream // overrides // additions
|
@ -4,26 +4,27 @@ You can edit this file as you like.
|
||||
-}
|
||||
{ name = "my-project"
|
||||
, dependencies =
|
||||
[ "aff-promise"
|
||||
, "avar"
|
||||
, "console"
|
||||
, "debug"
|
||||
, "effect"
|
||||
, "express"
|
||||
, "functions"
|
||||
, "maybe"
|
||||
, "node-child-process"
|
||||
, "node-fs"
|
||||
, "node-fs-aff"
|
||||
, "node-net"
|
||||
, "node-process"
|
||||
, "psci-support"
|
||||
, "simple-json"
|
||||
, "spec"
|
||||
, "spec-discovery"
|
||||
, "stringutils"
|
||||
, "uuid"
|
||||
]
|
||||
[ "aff-promise"
|
||||
, "argonaut"
|
||||
, "argonaut-codecs"
|
||||
, "avar"
|
||||
, "console"
|
||||
, "debug"
|
||||
, "effect"
|
||||
, "express"
|
||||
, "functions"
|
||||
, "maybe"
|
||||
, "node-child-process"
|
||||
, "node-fs"
|
||||
, "node-fs-aff"
|
||||
, "node-net"
|
||||
, "node-process"
|
||||
, "psci-support"
|
||||
, "spec"
|
||||
, "spec-discovery"
|
||||
, "stringutils"
|
||||
, "uuid"
|
||||
]
|
||||
, packages = ./packages.dhall
|
||||
, sources = [ "src/**/*.purs", "test/**/*.purs" ]
|
||||
}
|
||||
|
@ -1,7 +1,9 @@
|
||||
module Auth.Handler where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Auth.Types (Token(..))
|
||||
import Data.Argonaut (encodeJson)
|
||||
import Data.Array (elem)
|
||||
import Data.JSDate (now, toISOString)
|
||||
import Data.Maybe (Maybe(..))
|
||||
@ -16,7 +18,6 @@ import Node.Express.Request (getRequestHeader)
|
||||
import Node.Express.Response (end, setStatus)
|
||||
import Node.Express.Response as Response
|
||||
import Node.FS.Aff (appendTextFile, readTextFile)
|
||||
import Simple.JSON (write)
|
||||
|
||||
readAllowedTokens ∷ Aff (Array Token)
|
||||
readAllowedTokens = do
|
||||
@ -33,7 +34,7 @@ authHandler authorizedTokens = do
|
||||
Nothing -> do
|
||||
setStatus 401
|
||||
log $ "Denied request without token"
|
||||
Response.send $ write { error: "Jetzt hör'n Sie mir mal zu! Erstens brauch ich ihren Namen!!" }
|
||||
Response.send $ encodeJson { error: "Jetz her'n Sie mir moi zua! Erstens brach i earna Nomen!!" }
|
||||
end
|
||||
Just token@(Token raw)
|
||||
| elem token authorizedTokens -> do
|
||||
@ -42,5 +43,5 @@ authHandler authorizedTokens = do
|
||||
Just (Token invalid) -> do
|
||||
setStatus 403
|
||||
log $ "Access denied to " <> invalid
|
||||
Response.send $ write { error: "Ich seh' ja ein das man hier der gläserne Mensch ist." }
|
||||
Response.send $ encodeJson { error: "Ich seh' ja ein, dass man hier der gläserne Mensch ist." }
|
||||
end
|
||||
|
@ -4,7 +4,7 @@ import Prelude
|
||||
import Data.Array (delete, filter, find, length, snoc, zip)
|
||||
import Data.Foldable (for_)
|
||||
import Data.Generic.Rep (class Generic)
|
||||
import Data.Generic.Rep.Show (genericShow)
|
||||
import Data.Show.Generic (genericShow)
|
||||
import Data.JSDate (JSDate)
|
||||
import Data.JSDate as JSDate
|
||||
import Data.Maybe (Maybe(..))
|
||||
@ -12,6 +12,7 @@ import Data.Newtype (class Newtype, over, un)
|
||||
import Data.Time.Duration (Milliseconds(..))
|
||||
import Data.Tuple.Nested ((/\))
|
||||
import Data.UUID (UUID, genUUID)
|
||||
import Data.UUID as UUID
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff, Fiber, delay, error, killFiber, launchAff, launchAff_, parallel, sequential)
|
||||
import Effect.Class (class MonadEffect, liftEffect)
|
||||
|
@ -1,21 +1,33 @@
|
||||
module Main where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Auth.Handler (authHandler, readAllowedTokens)
|
||||
import Auth.Types (Token(..))
|
||||
import Control.Parallel (parOneOf, parTraverse)
|
||||
import Data.Argonaut (jsonParser)
|
||||
import Data.Argonaut.Core (Json)
|
||||
import Data.Argonaut.Core as Json
|
||||
import Data.Argonaut.Core as Json
|
||||
import Data.Argonaut.Decode (class DecodeJson, decodeJson, printJsonDecodeError)
|
||||
import Data.Argonaut.Decode.Class (class DecodeJson)
|
||||
import Data.Argonaut.Decode.Decoders (decodeString)
|
||||
import Data.Argonaut.Encode (encodeJson)
|
||||
import Data.Array (elem, (..))
|
||||
import Data.Bifunctor (lmap)
|
||||
import Data.Either (Either(..))
|
||||
import Data.Either (hush)
|
||||
import Data.Int (fromString)
|
||||
import Data.Maybe (Maybe(..), fromMaybe)
|
||||
import Data.Newtype (un)
|
||||
import Data.Time.Duration (class Duration, Seconds(..), fromDuration)
|
||||
import Data.Traversable (traverse)
|
||||
import Effect (Effect)
|
||||
import Effect.Aff (Aff, attempt, delay, launchAff_, message)
|
||||
import Effect.Aff.Class (liftAff)
|
||||
import Effect.Class (class MonadEffect, liftEffect)
|
||||
import Effect.Class.Console (info, log)
|
||||
import Effect.Exception (Error)
|
||||
import Foreign (unsafeToForeign)
|
||||
import JobQueue (EnqueueResult(..), NewJob(..), Queue, ResourcePool(..))
|
||||
import JobQueue as Q
|
||||
@ -38,10 +50,10 @@ import Node.OS (numCpus)
|
||||
import Node.Process (lookupEnv)
|
||||
import Playground.Playground (Folder(..), copy)
|
||||
import PscIdeClient (PscIdeConnection, compileCode, getFolder, mkConnection, execCommand)
|
||||
import Shared.Json (readAff)
|
||||
import Shared.Json (readAff, readJsonAff)
|
||||
import Shared.Models.Body (CompileRequest, RunResult, CompileResult)
|
||||
import Shared.Models.Body as Body
|
||||
import Simple.JSON (readJSON, read_, write)
|
||||
import Unsafe.Coerce (unsafeCoerce)
|
||||
|
||||
toBody ∷ ∀ r m. MonadEffect m => { stdout ∷ Buffer, stderr ∷ Buffer | r } -> m RunResult
|
||||
toBody result =
|
||||
@ -56,7 +68,7 @@ type ErrorWithCode =
|
||||
{ code ∷ Maybe Int }
|
||||
|
||||
asErrorWithCode ∷ ∀ a. a -> Maybe ErrorWithCode
|
||||
asErrorWithCode = read_ <<< unsafeToForeign
|
||||
asErrorWithCode = unsafeCoerce >>> decodeJson >>> hush
|
||||
|
||||
runCode ∷ ∀ d. Duration d => d -> Folder -> Aff (Maybe ExecResult)
|
||||
runCode timeout folder =
|
||||
@ -68,36 +80,37 @@ runCode timeout folder =
|
||||
compileAndRunJob ∷ CompileRequest -> (Handler -> Aff Unit) -> NewJob PscIdeConnection
|
||||
compileAndRunJob json handle =
|
||||
NewJob \jobId conn -> do
|
||||
stringOrErr <- attempt $ compileCode json.code conn
|
||||
case ((readJSON <$> stringOrErr) ∷ _ _ (_ _ CompileResult)) of
|
||||
stringOrErr ∷ Either Error String <- attempt $ compileCode json.code conn
|
||||
jsonOrErr ∷ Either Error (Either Error CompileResult) <- attempt $ readJsonAff `traverse` stringOrErr
|
||||
case jsonOrErr of
|
||||
Left e -> do
|
||||
handle $ setStatus 500
|
||||
log $ "Aff failed with " <> message e
|
||||
handle $ Response.send $ write {}
|
||||
handle $ Response.send $ encodeJson {}
|
||||
Right (Right res)
|
||||
| res.resultType == "error" -> do
|
||||
handle $ setStatus 422
|
||||
handle $ Response.send $ write res
|
||||
handle $ Response.send $ encodeJson res
|
||||
Right (Right res) -> do
|
||||
runResult <- runCode timeout (getFolder conn)
|
||||
case runResult of
|
||||
Nothing -> do
|
||||
handle $ setStatus 408
|
||||
handle $ Response.send $ write { error: "Timed out after running for " <> show timeout }
|
||||
handle $ Response.send $ encodeJson { error: "Timed out after running for " <> show timeout }
|
||||
Just rr -> do
|
||||
resultBody <- toBody rr
|
||||
handle $ Response.send $ write (resultBody ∷ Body.RunResult)
|
||||
handle $ Response.send $ encodeJson (resultBody ∷ Body.RunResult)
|
||||
Right (Left errs) -> do
|
||||
handle $ setStatus 500
|
||||
log $ "Could not decode: " <> show (lmap (const "no way") stringOrErr) <> "\nErrors: " <> show errs
|
||||
handle $ Response.send $ write {}
|
||||
handle $ Response.send $ encodeJson {}
|
||||
where
|
||||
timeout = 1.0 # Seconds
|
||||
timeout = 1.0 # Seconds
|
||||
|
||||
compileAndRunHandler ∷ Queue PscIdeConnection -> Handler
|
||||
compileAndRunHandler queue = do
|
||||
body <- getBody'
|
||||
json <- readAff body # liftAff
|
||||
json <- readAff (unsafeCoerce body) # liftAff
|
||||
HandlerM \req res next -> do
|
||||
let
|
||||
handle = unHandler req res next
|
||||
@ -108,7 +121,7 @@ compileAndRunHandler queue = do
|
||||
QueueFull ->
|
||||
handle do
|
||||
setStatus 500
|
||||
Response.send $ write { error: "Queue full" }
|
||||
Response.send $ encodeJson { error: "Queue full" }
|
||||
|
||||
unHandler ∷ ∀ a. Request -> Response -> Effect Unit -> HandlerM a -> Aff a
|
||||
unHandler req res next (HandlerM h) = h req res next
|
||||
@ -158,7 +171,7 @@ serverSetup app = do
|
||||
let port = maybePortString >>= fromString # fromMaybe 14188
|
||||
liftEffect $ (listenHttp app port) \_ -> info $ "psfp server started on port " <> show port
|
||||
where
|
||||
makeHttpsOptions = do
|
||||
key <- readTextFile UTF8 "server.key"
|
||||
cert <- readTextFile UTF8 "server.cert"
|
||||
pure { key, cert }
|
||||
makeHttpsOptions = do
|
||||
key <- readTextFile UTF8 "server.key"
|
||||
cert <- readTextFile UTF8 "server.cert"
|
||||
pure { key, cert }
|
||||
|
@ -1,8 +1,8 @@
|
||||
module Middleware.JsonBodyParser where
|
||||
|
||||
import Prelude
|
||||
import Data.Function.Uncurried (Fn3)
|
||||
import Effect (Effect)
|
||||
import Effect.Uncurried (EffectFn3)
|
||||
import Node.Express.Types (Request, Response)
|
||||
|
||||
foreign import jsonBodyParser ∷ Fn3 Request Response (Effect Unit) (Effect Unit)
|
||||
foreign import jsonBodyParser ∷ EffectFn3 Request Response (Effect Unit) Unit
|
||||
|
@ -1,39 +0,0 @@
|
||||
module Playground.Handler where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Data.Maybe (Maybe)
|
||||
import Effect.Aff.Class (liftAff)
|
||||
import Effect.Class (class MonadEffect, liftEffect)
|
||||
import Node.Buffer (Buffer)
|
||||
import Node.Buffer as Buffer
|
||||
import Node.Encoding (Encoding(..))
|
||||
import Node.Express.Handler (HandlerM)
|
||||
import Node.Express.Request (getBody')
|
||||
import Node.Express.Response as Response
|
||||
import Playground.Playground (asErrorWithCode, compileCode, runCode)
|
||||
import Shared.Json (readAff)
|
||||
import Shared.Models.Body (RunResult)
|
||||
import Shared.Models.Body as Body
|
||||
import Simple.JSON (write)
|
||||
|
||||
toBody ∷ ∀ r m. MonadEffect m => { stdout ∷ Buffer, stderr ∷ Buffer | r } -> m RunResult
|
||||
toBody result = liftEffect $ ado
|
||||
stdout <- Buffer.toString UTF8 result.stdout
|
||||
stderr <- Buffer.toString UTF8 result.stderr
|
||||
let (code ∷ Maybe Int) = asErrorWithCode result >>= _.code
|
||||
in { code, stdout, stderr } ∷ RunResult
|
||||
|
||||
compileHandler ∷ HandlerM Unit
|
||||
compileHandler = do
|
||||
body <- getBody'
|
||||
json <- readAff body # liftAff
|
||||
result <- compileCode (json ∷ Body.CompileRequest).code # liftAff
|
||||
Response.send $ write ({ result } ∷ Body.CompileResult)
|
||||
|
||||
runHandler ∷ HandlerM Unit
|
||||
runHandler = do
|
||||
result <- liftAff do
|
||||
result <- runCode
|
||||
toBody result
|
||||
Response.send $ write (result ∷ Body.RunResult)
|
@ -1,6 +1,8 @@
|
||||
module PscIdeClient where
|
||||
|
||||
import Prelude
|
||||
import Data.Argonaut.Encode
|
||||
import Data.Argonaut.Core
|
||||
import Data.Either (Either(..), either)
|
||||
import Data.Maybe (Maybe(..))
|
||||
import Data.Newtype (class Newtype, un, unwrap)
|
||||
@ -19,7 +21,6 @@ import Node.FS.Aff (writeTextFile)
|
||||
import Node.Net.Socket (Socket)
|
||||
import Node.Net.Socket as Socket
|
||||
import Playground.Playground (Folder(..))
|
||||
import Simple.JSON (writeJSON)
|
||||
|
||||
type BuildCommand =
|
||||
{ command ∷ String
|
||||
@ -58,15 +59,15 @@ startIdeServer folder port = do
|
||||
{ error, stderr, stdout } <- execCommand folder "npx spago build"
|
||||
stderrStr <- liftEffect $ Buf.toString UTF8 stderr
|
||||
log $ "Built: " <> stderrStr
|
||||
log $ "Loading modules" <> infoString
|
||||
log $ "Loading modules: " <> infoString
|
||||
loadPscIde folder port
|
||||
pure cp
|
||||
where
|
||||
infoString =
|
||||
" in folder "
|
||||
<> un Folder folder
|
||||
<> " on port "
|
||||
<> show port
|
||||
infoString =
|
||||
" in folder "
|
||||
<> un Folder folder
|
||||
<> " on port "
|
||||
<> show port
|
||||
|
||||
execCommand ∷ Folder -> String -> Aff CP.ExecResult
|
||||
execCommand folder command =
|
||||
@ -116,13 +117,13 @@ loadPscIde folder port = do
|
||||
-- maybe timeout?
|
||||
Socket.onError socket (affCb <<< Left)
|
||||
void
|
||||
$ Socket.writeString socket (writeJSON loadCommand <> "\n") UTF8 (affCb (Right unit))
|
||||
$ Socket.writeString socket ((stringify <<< encodeJson) loadCommand <> "\n") UTF8 (affCb (Right unit))
|
||||
liftEffect
|
||||
$ Socket.onClose socket case _ of
|
||||
true -> mempty -- should be covered in onError
|
||||
false -> do
|
||||
affCb (Right unit)
|
||||
let command = writeJSON buildCommand <> "\n"
|
||||
let command = (stringify <<< encodeJson) buildCommand <> "\n"
|
||||
Socket.onReady socket (void $ Socket.writeString socket command UTF8 mempty)
|
||||
pure (closeSocketCanceller socket)
|
||||
|
||||
@ -143,7 +144,7 @@ compileCode code (PscIdeConnection { port, folder, serverProcessRef }) = do
|
||||
log $ "Enough data on " <> show port <> " ending socket\n"
|
||||
void $ Socket.endString socket "" UTF8 mempty
|
||||
affCb (Right newStr)
|
||||
let command = writeJSON buildCommand
|
||||
let command = (stringify <<< encodeJson) buildCommand
|
||||
Socket.onReady socket do
|
||||
log $ "Socket " <> show port <> " ready"
|
||||
void $ Socket.writeString socket (command <> "\n") UTF8 mempty
|
||||
|
@ -2,18 +2,21 @@ module Shared.Json (readJsonAff, readAff) where
|
||||
|
||||
import Prelude
|
||||
|
||||
import Control.Monad.Error.Class (throwError)
|
||||
import Data.Argonaut (jsonParser)
|
||||
import Data.Argonaut.Core (Json)
|
||||
import Data.Argonaut.Decode (decodeJson, printJsonDecodeError)
|
||||
import Data.Argonaut.Decode.Class (class DecodeJson)
|
||||
import Data.Either (Either, either)
|
||||
import Effect.Aff (Aff)
|
||||
import Effect.Class (liftEffect)
|
||||
import Effect.Exception (throw)
|
||||
import Foreign (Foreign)
|
||||
import Simple.JSON (class ReadForeign, read, readJSON)
|
||||
import Effect.Exception (throw, error)
|
||||
|
||||
readJsonAff ∷ ∀ a. ReadForeign a => String -> Aff a
|
||||
readJsonAff = readJSON >>> orThrow
|
||||
readJsonAff ∷ ∀ a. DecodeJson a => String -> Aff a
|
||||
readJsonAff s = either (throwError <<< error) pure (jsonParser s) >>= readAff
|
||||
|
||||
readAff ∷ ∀ a. ReadForeign a => Foreign -> Aff a
|
||||
readAff = read >>> orThrow
|
||||
readAff ∷ ∀ a. DecodeJson a => Json -> Aff a
|
||||
readAff s = either (throwError <<< error <<< printJsonDecodeError) pure (decodeJson s)
|
||||
|
||||
orThrow ∷ ∀ a s. Show s => Either s a -> Aff a
|
||||
orThrow = either (show >>> throw >>> liftEffect) pure
|
||||
|
Loading…
Reference in New Issue
Block a user