rowtype-yoga/psfp
1
0
Fork 0
mirror of https://github.com/rowtype-yoga/psfp.git synced 2024-08-17 20:20:35 +03:00
Code Issues Packages Projects Releases Wiki Activity

works better

Browse Source
This commit is contained in:
Mark Eibes 2020-01-26 19:12:21 +01:00
parent 4a3f8f821f
commit 191a78d493
26 changed files with 8067 additions and 6671 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
client/dist/bundle.js vendored
View File

File diff suppressed because one or more lines are too long

6961
client/package-lock.json generated
View File

File diff suppressed because it is too large Load Diff

10
client/package.json
View File

@ -33,13 +33,13 @@
"dependencies": {
"@material-ui/styles": "^4.4.3",
"@monaco-editor/react": "^1.2.2",
"purty": "^4.5.1",
"react": "^16.9.0",
"react-dom": "^16.9.0",
"react-hot-loader": "^4.12.15",
"smoothscroll-polyfill": "^0.4.4"
},
"devDependencies": {
"react-hot-loader": "^4.12.15",
"purty": "^4.5.1",
"@babel/core": "^7.6.0",
"@storybook/react": "^5.2.0",
"@testing-library/react": "^9.1.4",
@ -48,11 +48,11 @@
"deep-equal": "^1.1.0",
"jsdom": "^15.1.1",
"jsdom-global": "^3.0.2",
"purescript": "^0.13.3",
"purescript": "^0.13.6",
"purescript-psa": "^0.7.3",
"purs-loader": "^3.6.0",
"purs-loader": "^3.7.0",
"react-svg-loader": "^3.0.3",
"spago": "^0.10.0",
"spago": "^0.13.1",
"webpack": "^4.41.0",
"webpack-cli": "^3.3.6",
"webpack-dev-server": "^3.8.1",

41
client/packages.dhall
View File

@ -121,21 +121,21 @@ let additions =
let upstream =
https://github.com/purescript/package-sets/releases/download/psc-0.13.3-20190920/packages.dhall sha256:53873cf2fc4a343a41f335ee47c1706ecf755ac7c5a336e8eb03ad23165dfd28
let overrides =
{ react-basic-hooks =
upstream.react-basic-hooks // { version = "v2.0.1" }
, spec-discovery =
upstream.spec-discovery // { version = "1ca3416e6c0729eca8d5204f22cf0aa09c98df9d" }
, react-basic =
upstream.react-basic
// { repo =
"https://github.com/i-am-the-slime/purescript-react-basic"
, version =
"dda3f711d84cd5dc1817a71ff01f0426b04ed791"
}
}
let overrides = {=}
-- { react-basic-hooks =
-- upstream.react-basic-hooks // { version = "v2.0.1" }
-- , spec-discovery =
-- upstream.spec-discovery // { version = "1ca3416e6c0729eca8d5204f22cf0aa09c98df9d" }
-- , react-basic =
-- upstream.react-basic
-- // { repo =
-- "https://github.com/i-am-the-slime/purescript-react-basic"
-- , version =
-- "dda3f711d84cd5dc1817a71ff01f0426b04ed791"
-- }
-- }
let additions =
let additions =
{ react-testing-library =
{ dependencies =
[ "aff-promise"
@ -171,19 +171,6 @@ let additions =
, version =
"7715e8a2c096c480a093a5e0a6df1ece4df5ed2a"
}
, matryoshka =
{ dependencies =
[ "prelude"
, "fixed-points"
, "free"
, "transformers"
, "profunctor"
]
, repo =
"https://github.com/slamdata/purescript-matryoshka.git"
, version =
"caaca2d836d52159ba7963333996286a00428394"
}
}
in upstream // overrides // additions

1
client/spago.dhall
View File

@ -9,7 +9,6 @@ You can edit this file as you like.
, "css"
, "debug"
, "effect"
, "matryoshka"
, "milkis"
, "psci-support"
, "pseudo-random"

24
client/src/Container/Component.purs
View File

@ -18,29 +18,29 @@ import Theme.Provider (mkThemeProvider)
import Theme.Styles (makeStyles)
import Theme.Types (CSSTheme)
mkContainer ∷ Effect (ReactComponent { theme ∷ CSSTheme, children ∷ Array JSX })
mkContainer ∷ Effect (ReactComponent { theme ∷ CSSTheme, kids ∷ Array JSX })
mkContainer = do
themeProvider <- mkThemeProvider
containerContent <- mkContainerContent
component "Container" \{ theme, children } -> React.do
component "Container" \{ theme, kids } -> React.do
pure
$ element themeProvider
{ theme
, children:
[ element containerContent { children }
[ element containerContent { kids }
]
}
mkContainerContent ∷ Effect (ReactComponent { children ∷ Array JSX })
mkContainerContent ∷ Effect (ReactComponent { kids ∷ Array JSX })
mkContainerContent = do
smoothScrollPolyfill
useStyles <-
makeStyles \(theme ∷ CSSTheme) ->
-- { "@global": cssSafer { "*": { outline: "1px solid red" } }
{ container:
--"@global": -- { "*": { outline: "1px solid red" } }
cssSafer
{ backgroundColor: theme.backgroundColour
, fontFamily: theme.textFontFamily
{ fontFamily: theme.textFontFamily
, color: theme.textColour
, display: "grid"
, transition: "0.2s ease-in-out"
@ -49,14 +49,14 @@ mkContainerContent = do
<> "'header header header' "
<> "'nav content content'"
-- , "footer footer footer"
-- , gridTemplateColumns: "max-content auto"
, minWidth: "100%"
, maxWidth: "100%"
, gridTemplateColumns: "max-content auto"
, width: "100%"
, maxHeight: "100%"
}
, content:
cssSafer
{ gridArea: "content"
, minHeight: "200vh"
, backgroundColor: theme.backgroundColour
}
, icon: cssSafer { fill: "theme.textColour" }
}
@ -65,7 +65,7 @@ mkContainerContent = do
header <- mkHeader
sidebarLink <- mkSidebarLink
editor <- mkCompileEditor
component "ContainerContent" \{ children } -> React.do
component "ContainerContent" \{ kids } -> React.do
classes <- useStyles
collapsed /\ modifyCollapsed <- useState true
editorRef <- useRef Nullable.null
@ -85,7 +85,7 @@ mkContainerContent = do
]
}
, element header {}
, R.div { className: classes.content, children: [ element editor { initialCode } ] <> children }
, R.div { className: classes.content, children: [ element editor { initialCode } ] <> kids }
]
}

20
client/src/Container/Landing.purs
View File

@ -1,7 +1,6 @@
module Container.Landing where
import Prelude
import Button.Component (ButtonType(..), mkButton)
import CSS.Safer (cssSafer)
import Data.Foldable (for_)
@ -84,7 +83,7 @@ mkLandingPage = do
h <- mkH
button <- mkButton
backgroundImage <- mkLandingPageBackground
component "LandingPage" \{ } -> React.do
component "LandingPage" \{} -> React.do
classes <- useStyles
theme <- useTheme
ref <- useRef null
@ -109,16 +108,17 @@ mkLandingPage = do
, children:
[ element button
{ buttonProps:
{ onClick: handler_ do
maybeNode <- readRefMaybe ref
for_ (maybeNode >>= HTMLElement.fromNode) \n -> do
height <- getBoundingClientRect n <#> _.height
win <- window
runEffectFn1 ((unsafeCoerce win).scrollTo)
{ top: height, left: 0, behavior: "smooth"}
{ onClick:
handler_ do
maybeNode <- readRefMaybe ref
for_ (maybeNode >>= HTMLElement.fromNode) \n -> do
height <- getBoundingClientRect n <#> _.height
win <- window
runEffectFn1 ((unsafeCoerce win).scrollTo)
{ top: height, left: 0, behavior: "smooth" }
}
, buttonType: HighlightedButton
, children: [ R.text buttonText ]
, kids: [ R.text buttonText ]
}
]
}

28
client/src/Example.purs
View File

@ -1,7 +1,6 @@
module Example (main) where
import Prelude
import Container.Component (mkContainer)
import Data.Maybe (fromJust)
import Effect (Effect)
@ -16,21 +15,24 @@ import Web.HTML (window) as DOM
import Web.HTML.HTMLDocument (toNonElementParentNode) as DOM
import Web.HTML.Window (document) as DOM
main ∷ Effect Unit
main = do
container <- mkContainer
let appEl = element container { theme: fromTheme darkTheme, children: [] }
if isServerSide
then void (log (renderToString appEl))
else void do
window <- DOM.window
document <- DOM.document window
let node = DOM.toNonElementParentNode document
elem <- DOM.getElementById "app" node
let element' = unsafePartial (fromJust elem)
ReactDOM.render appEl element'
let
appEl = element container { theme: fromTheme darkTheme, kids: [] }
if isServerSide then
void (log (renderToString appEl))
else
void do
window <- DOM.window
document <- DOM.document window
let
node = DOM.toNonElementParentNode document
elem <- DOM.getElementById "app" node
let
element' = unsafePartial (fromJust elem)
ReactDOM.render appEl element'
foreign import isServerSide ∷ Boolean
foreign import renderToString ∷ JSX -> String

3
client/stories/ContainerStories.purs
View File

@ -1,7 +1,6 @@
module ContainerStories where
import Prelude hiding (add)
import Container.Component (mkContainer)
import Decorator.FullScreen (fullScreenDecorator)
import Effect (Effect)
@ -23,5 +22,5 @@ stories = do
pure
$ element container
{ theme
, children: []
, kids: []
}

1
client/test/Main.purs
View File

@ -1,7 +1,6 @@
module Test.Main where
import Prelude
import Effect (Effect)
import Effect.Class.Console (log)

19
client/webpack.production.js
View File

@ -1,9 +1,16 @@
'use strict';
const merge = require('webpack-merge');
const common = require('./webpack.common.js');
const path = require('path');
"use strict";
const merge = require("webpack-merge");
const common = require("./webpack.common.js");
const path = require("path");
module.exports = merge(common, {
entry: './src/entrypoint.js',
mode: 'production'
entry: "./src/entrypoint.js",
resolve: {
alias: {
// Only resolve react and dom once
react: path.resolve("./node_modules/react"),
"react-dom": path.resolve("./node_modules/react-dom")
}
},
mode: "production"
});

7119
components/package-lock.json generated
View File

File diff suppressed because it is too large Load Diff

7
components/package.json
View File

@ -30,16 +30,15 @@
"url": "https://github.com/i-am-the-slime/psfp/issues"
},
"homepage": "https://github.com/i-am-the-slime/psfp#readme",
"dependencies": {
"dependencies": {},
"devDependencies": {
"@material-ui/styles": "^4.4.3",
"@monaco-editor/react": "^1.2.2",
"purty": "^4.5.1",
"react": "^16.9.0",
"react-dom": "^16.9.0",
"react-hot-loader": "^4.12.15",
"smoothscroll-polyfill": "^0.4.4"
},
"devDependencies": {
"smoothscroll-polyfill": "^0.4.4",
"@babel/core": "^7.6.0",
"@storybook/react": "^5.2.0",
"@testing-library/react": "^9.1.4",

6
components/src/Yoga/Button/Component.purs
View File

@ -33,7 +33,7 @@ mkButton ∷
Lacks "key" attrs =>
Effect
( ReactComponent
{ children ∷ Array JSX
{ kids ∷ Array JSX
, buttonType ∷ ButtonType
, buttonProps ∷ Record attrs
}
@ -135,7 +135,7 @@ mkButton = do
pure $ increaseContrast bg tc # toHexString
}
}
component "Button" \{ children, buttonType, buttonProps } -> React.do
component "Button" \{ kids, buttonType, buttonProps } -> React.do
rawClasses <- useStyles
let
classes = flip classNames rawClasses
@ -147,7 +147,7 @@ mkButton = do
, guard (buttonType == HighlightedButton) _.highlightedButton
]
, disabled: buttonType == DisabledButton
, children
, children: kids
}
`union`
buttonProps

30
components/src/Yoga/Card/Component.purs
View File

@ -1,7 +1,6 @@
module Card.Component where
import Prelude
import CSS.Safer (cssSafer)
import Effect (Effect)
import React.Basic (JSX)
@ -14,7 +13,7 @@ import Theme.Types (CSSTheme)
mkCard ∷
Effect
( ReactComponent
{ children ∷ Array JSX
{ kids ∷ Array JSX
}
)
mkCard = do
@ -26,26 +25,27 @@ mkCard = do
, color: theme.textColour
, margin: "20px"
, boxShadow:
"1px 1px 20px rgba(0,0,0,0." <>
(if theme.isLight then "17" else "43") <> ")"
"1px 1px 20px rgba(0,0,0,0."
<> (if theme.isLight then "17" else "43")
<> ")"
, borderRadius: "5px"
, padding: "36px 40px 32px 40px"
}
}
component "Card" \{ children } -> React.do
component "Card" \{ kids } -> React.do
rawClasses <- useStyles
let
classes = flip classNames rawClasses
pure
$ R.div
{ className: classes [ _.card ]
, children
, children: kids
}
mkCardTitle ∷
Effect
( ReactComponent
{ children ∷ Array JSX
{ kids ∷ Array JSX
}
)
mkCardTitle = do
@ -60,20 +60,20 @@ mkCardTitle = do
, padding: "4px 8px"
}
}
component "CardTitle" \{ children } -> React.do
component "CardTitle" \{ kids } -> React.do
rawClasses <- useStyles
let
classes = flip classNames rawClasses
pure
$ R.div
{ className: classes [ _.cardtitle ]
, children
, children: kids
}
mkCardSubtitle ∷
Effect
( ReactComponent
{ children ∷ Array JSX
{ kids ∷ Array JSX
}
)
mkCardSubtitle = do
@ -89,20 +89,20 @@ mkCardSubtitle = do
, padding: "4px 8px 22px 8px"
}
}
component "CardSubtitle" \{ children } -> React.do
component "CardSubtitle" \{ kids } -> React.do
rawClasses <- useStyles
let
classes = flip classNames rawClasses
pure
$ R.div
{ className: classes [ _.cardtitle ]
, children
, children: kids
}
mkCardContent ∷
Effect
( ReactComponent
{ children ∷ Array JSX
{ kids ∷ Array JSX
}
)
mkCardContent = do
@ -120,12 +120,12 @@ mkCardContent = do
, padding: "4px 8px 22px 8px"
}
}
component "CardContent" \{ children } -> React.do
component "CardContent" \{ kids } -> React.do
rawClasses <- useStyles
let
classes = flip classNames rawClasses
pure
$ R.div
{ className: classes [ _.cardContent ]
, children
, children: kids
}

4
components/src/Yoga/CompileEditor/Component.purs
View File

@ -51,7 +51,7 @@ mkCompileEditor = do
$ fragment
[ element button
{ buttonType: PlainButton
, children: [ R.text "Compile" ]
, kids: [ R.text "Compile" ]
, buttonProps:
{ onClick:
handler_ do
@ -65,7 +65,7 @@ mkCompileEditor = do
Right r -> r.stdout
}
}
, element card { children: [ R.text compileResult ] }
, element card { kids: [ R.text compileResult ] }
, R.div { children: [ element editor { onLoad } ], style: css { height: "100%" } }
]

52
components/src/Yoga/Monaco/Editor.purs
View File

@ -11,10 +11,10 @@ import Effect.Uncurried (EffectFn2, mkEffectFn2)
import Foreign (Foreign, unsafeToForeign)
import Prim.Row (class Union)
import React.Basic (JSX, ReactComponent, element, fragment)
import React.Basic.DOM as R
import React.Basic.Hooks (component)
import React.Basic.Hooks as React
import React.Basic.Hooks.Aff (useAff)
import React.Helpers (wrapperDiv)
import Theme.Styles (makeStyles, useTheme)
import Theme.Types (CSSTheme)
import Web.DOM (Node)
@ -92,10 +92,9 @@ mkEditor = do
cssSafer
{ margin: "0"
, boxSizing: "border-box"
, padding: "35px 40px"
, width: "100%"
, height: "100%"
, borderRadius: "32px"
, height: "200px"
, overflowY: "hidden"
, backgroundColor: theme.backgroundColour
}
}
@ -107,25 +106,28 @@ mkEditor = do
themeName = if theme.isLight then lightThemeName else darkThemeName
pure
$ fragment
[ wrapperDiv { className: classes.wrapper }
$ element editor
{ theme: themeName
, options:
unsafeToForeign
{ fontFamily: "PragmataPro"
, fontLigatures: true
, fontSize: "16pt"
, lineNumbers: "off"
, glyphMargin: false
, folding: false
, lineDecorationsWidth: 0
, lineNumbersMinChars: 0
, minimap: { enabled: false }
, automaticLayout: true
}
, language: "purescript"
-- https://microsoft.github.io/monaco-editor/playground.html#extending-language-services-custom-languages
, editorDidMount:
mkEffectFn2 \_ -> onLoad
}
[ R.div
{ className: classes.wrapper
, children:
[ element editor
{ theme: themeName
, options:
unsafeToForeign
{ fontFamily: "PragmataPro"
, fontLigatures: true
, fontSize: "16pt"
, lineNumbers: "off"
, glyphMargin: false
, folding: false
, lineDecorationsWidth: 0
, lineNumbersMinChars: 0
, minimap: { enabled: false }
}
, language: "purescript"
-- https://microsoft.github.io/monaco-editor/playground.html#extending-language-services-custom-languages
, editorDidMount:
mkEffectFn2 \_ -> onLoad
}
]
}
]

156
components/src/Yoga/React/Helpers.purs
View File

@ -1,156 +0,0 @@
module React.Helpers where
import Prelude
import Data.Nullable (Nullable)
import Data.Symbol (SProxy(..))
import Foreign.Object (Object)
import Prim.Row (class Lacks, class Union)
import React.Basic (JSX)
import React.Basic.DOM (CSS)
import React.Basic.DOM as R
import React.Basic.Events (EventHandler)
import React.Basic.Hooks (Ref)
import Record (insert)
import Web.DOM (Node)
wrapperDiv ∷
∀ attrs attrs_.
Lacks "children" attrs =>
Union attrs attrs_ Props_div_no_children =>
{ | attrs } ->
JSX ->
JSX
wrapperDiv props child = R.div $ insert (SProxy ∷ _ "children") [ child ] props
type Props_div_no_children
= ( _data ∷ Object String
, about ∷ String
, acceptCharset ∷ String
, accessKey ∷ String
, allowFullScreen ∷ Boolean
, allowTransparency ∷ Boolean
, autoComplete ∷ Boolean
, autoFocus ∷ Boolean
, autoPlay ∷ Boolean
, capture ∷ Boolean
, cellPadding ∷ String
, cellSpacing ∷ String
, charSet ∷ String
, classID ∷ String
, className ∷ String
, colSpan ∷ Int
, contentEditable ∷ Boolean
, contextMenu ∷ String
, crossOrigin ∷ String
, dangerouslySetInnerHTML ∷ { __html ∷ String }
, datatype ∷ String
, dateTime ∷ String
, dir ∷ String
, draggable ∷ Boolean
, encType ∷ String
, formAction ∷ String
, formEncType ∷ String
, formMethod ∷ String
, formNoValidate ∷ Boolean
, formTarget ∷ String
, frameBorder ∷ String
, hidden ∷ Boolean
, hrefLang ∷ String
, htmlFor ∷ String
, httpEquiv ∷ String
, icon ∷ String
, id ∷ String
, inlist ∷ String
, inputMode ∷ String
, is ∷ String
, itemID ∷ String
, itemProp ∷ String
, itemRef ∷ String
, itemScope ∷ Boolean
, itemType ∷ String
, key ∷ String
, keyParams ∷ String
, keyType ∷ String
, lang ∷ String
, marginHeight ∷ String
, marginWidth ∷ String
, maxLength ∷ Int
, mediaGroup ∷ String
, minLength ∷ Int
, noValidate ∷ Boolean
, onAnimationEnd ∷ EventHandler
, onAnimationIteration ∷ EventHandler
, onAnimationStart ∷ EventHandler
, onBlur ∷ EventHandler
, onClick ∷ EventHandler
, onCompositionEnd ∷ EventHandler
, onCompositionStart ∷ EventHandler
, onCompositionUpdate ∷ EventHandler
, onContextMenu ∷ EventHandler
, onCopy ∷ EventHandler
, onCut ∷ EventHandler
, onDoubleClick ∷ EventHandler
, onDrag ∷ EventHandler
, onDragEnd ∷ EventHandler
, onDragEnter ∷ EventHandler
, onDragExit ∷ EventHandler
, onDragLeave ∷ EventHandler
, onDragOver ∷ EventHandler
, onDragStart ∷ EventHandler
, onDrop ∷ EventHandler
, onFocus ∷ EventHandler
, onGotPointerCapture ∷ EventHandler
, onInvalid ∷ EventHandler
, onKeyDown ∷ EventHandler
, onKeyPress ∷ EventHandler
, onKeyUp ∷ EventHandler
, onLostPointerCapture ∷ EventHandler
, onMouseDown ∷ EventHandler
, onMouseEnter ∷ EventHandler
, onMouseLeave ∷ EventHandler
, onMouseMove ∷ EventHandler
, onMouseOut ∷ EventHandler
, onMouseOver ∷ EventHandler
, onMouseUp ∷ EventHandler
, onPaste ∷ EventHandler
, onPointerCancel ∷ EventHandler
, onPointerDown ∷ EventHandler
, onPointerEnter ∷ EventHandler
, onPointerLeave ∷ EventHandler
, onPointerMove ∷ EventHandler
, onPointerOut ∷ EventHandler
, onPointerOver ∷ EventHandler
, onPointerUp ∷ EventHandler
, onSelect ∷ EventHandler
, onSubmit ∷ EventHandler
, onTouchCancel ∷ EventHandler
, onTouchEnd ∷ EventHandler
, onTouchMove ∷ EventHandler
, onTouchStart ∷ EventHandler
, onTransitionEnd ∷ EventHandler
, onWheel ∷ EventHandler
, prefix ∷ String
, property ∷ String
, radioGroup ∷ String
, readOnly ∷ Boolean
, ref ∷ Ref (Nullable Node)
, resource ∷ String
, role ∷ String
, rowSpan ∷ Int
, scoped ∷ Boolean
, seamless ∷ Boolean
, security ∷ String
, spellCheck ∷ Boolean
, srcDoc ∷ JSX
, srcLang ∷ String
, srcSet ∷ String
, style ∷ CSS
, suppressContentEditableWarning ∷ Boolean
, tabIndex ∷ Int
, title ∷ String
, typeof ∷ String
, unselectable ∷ Boolean
, useMap ∷ String
, vocab ∷ String
, wmode ∷ String
)

4
components/src/Yoga/Theme/Provider.js
View File

@ -1,7 +1,7 @@
'use strict'
"use strict";
var styles = require("@material-ui/styles");
exports.mkThemeProviderImpl = function() {
return styles.ThemeProvider;
}
};

13
packages.dhall
View File

@ -121,18 +121,7 @@ let additions =
let upstream =
https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200123/packages.dhall sha256:687bb9a2d38f2026a89772c47390d02939340b01e31aaa22de9247eadd64af05
let overrides =
{ react-basic-hooks = upstream.react-basic-hooks // { version = "v2.0.1" }
, spec-discovery =
upstream.spec-discovery
// { version = "1ca3416e6c0729eca8d5204f22cf0aa09c98df9d" }
, react-basic =
upstream.react-basic
// { repo =
"https://github.com/i-am-the-slime/purescript-react-basic"
, version = "dda3f711d84cd5dc1817a71ff01f0426b04ed791"
}
}
let overrides = {=}
let additions =
{ react-testing-library =

5
playground/src/Main.purs
View File

@ -1,5 +1,6 @@
module Main where
import Effect.Class.Console (log)
import Batteries
main = log "Uh-oh"
main :: Effect Unit
main = log "Hello, World!"

38
server/assets/bundle.js
View File

File diff suppressed because one or more lines are too long

2
server/src/JobQueueSpec.purs
View File

@ -10,10 +10,10 @@ import Effect.Ref (Ref)
import Effect.Ref as Ref
import JobQueue (EnqueueResult(..), NewJob(..), QueueParams, ResourcePool(..), mkQueue)
import JobQueue as Q
import Main (execCommand)
import Playground.Playground (Folder(..))
import Test.Spec (Spec, describe, it)
import Test.Spec.Assertions (shouldEqual, shouldNotEqual)
import PscIdeClient (execCommand)
params ∷ QueueParams
params =

23
server/src/Main.purs
View File

@ -2,16 +2,16 @@ module Main where
import Prelude
import Control.Parallel (parTraverse)
import Data.Array ((..))
import Data.Either (Either(..))
import Data.Int (fromString)
import Data.Maybe (Maybe(..), fromMaybe)
import Data.Maybe (Maybe, fromMaybe)
import Data.Newtype (un)
import Data.Posix.Signal (Signal(..))
import Data.Time.Duration (Seconds(..), fromDuration)
import Data.Traversable (for)
import Effect (Effect)
import Effect.Aff (Aff, effectCanceler, launchAff_, makeAff, parallel, sequential)
import Effect.Aff (Aff, launchAff_)
import Effect.Aff.Class (liftAff)
import Effect.Class (class MonadEffect, liftEffect)
import Effect.Class.Console (info, log)
@ -21,7 +21,7 @@ import JobQueue as Q
import Middleware.JsonBodyParser (jsonBodyParser)
import Node.Buffer (Buffer)
import Node.Buffer as Buffer
import Node.ChildProcess (ExecResult, defaultExecOptions, exec, kill, pid)
import Node.ChildProcess (ExecResult)
import Node.Encoding (Encoding(..))
import Node.Express.App (App, listenHttp, listenHttps, use, useExternal)
import Node.Express.App as E
@ -36,7 +36,7 @@ import Node.HTTP (Server)
import Node.OS (numCpus)
import Node.Process (lookupEnv)
import Playground.Playground (Folder(..), copy)
import PscIdeClient (PscIdeConnection, compileCode, getFolder, mkConnection)
import PscIdeClient (PscIdeConnection, compileCode, getFolder, mkConnection, execCommand)
import Shared.Json (readAff)
import Shared.Models.Body (CompileRequest, RunResult, CompileResult)
import Shared.Models.Body as Body
@ -61,14 +61,6 @@ asErrorWithCode = read_ <<< unsafeToForeign
runCode ∷ Folder -> Aff ExecResult
runCode folder = execCommand folder "node run.js"
execCommand ∷ Folder -> String -> Aff ExecResult
execCommand folder command =
makeAff \callback -> do
let
options = defaultExecOptions { cwd = Just (un Folder folder) }
childProcess <- exec command options (callback <<< Right)
pure $ effectCanceler ((log $ "Killing " <> show (pid childProcess)) *> kill SIGKILL childProcess)
compileAndRunJob ∷ CompileRequest -> (Handler -> Aff Unit) -> NewJob PscIdeConnection
compileAndRunJob json handle =
NewJob \jobId conn -> do
@ -117,13 +109,14 @@ main = do
launchAff_ do
cpus <- numCpus # liftEffect
let
poolSize = max 2 (cpus - 1) -- use at least 2
poolSize = max 2 (cpus / 2) -- use at least 2
mkFolder = Folder <<< (destFolder <> _) <<< show
connections <- for (0 .. poolSize) \n -> do
connections <- (1 .. poolSize) # parTraverse \n -> do
let folder = mkFolder n
port = 14100 + n
log $ "Copying to folder " <> (un Folder folder)
copy srcFolder (un Folder folder)
mkConnection folder port

96
server/src/PscIdeClient.purs
View File

@ -1,23 +1,16 @@
module PscIdeClient where
import Prelude
import Data.Array as Array
import Data.Either (Either(..), either)
import Data.Foldable (intercalate)
import Data.Maybe (Maybe(..))
import Data.Newtype (class Newtype, un, unwrap)
import Data.Posix.Signal (Signal(..))
import Data.String.Utils (endsWith)
import Debug.Trace (spy)
import Effect (Effect)
import Effect.Aff (Aff, Canceler, effectCanceler, makeAff)
import Effect.Class (liftEffect)
import Effect.Class.Console (log)
import Effect.Exception (message)
import Effect.Ref (Ref)
import Effect.Ref as Ref
import Foreign (renderForeignError)
import Node.Buffer as Buf
import Node.ChildProcess (ChildProcess)
import Node.ChildProcess as CP
@ -26,8 +19,7 @@ import Node.FS.Aff (writeTextFile)
import Node.Net.Socket (Socket)
import Node.Net.Socket as Socket
import Playground.Playground (Folder(..))
import Shared.Models.Body (CompileResult)
import Simple.JSON (readJSON, writeJSON)
import Simple.JSON (writeJSON)
type BuildCommand
= { command ∷ String
@ -36,6 +28,13 @@ type BuildCommand
}
}
loadCommand ∷
{ command ∷ String
}
loadCommand =
{ command: "load"
}
buildCommand ∷ BuildCommand
buildCommand =
{ "command": "rebuild"
@ -53,18 +52,32 @@ closeSocketCanceller s =
startIdeServer ∷ Folder -> Int -> Aff ChildProcess
startIdeServer folder port = do
log
$ "Spawning ide server in folder "
<> un Folder folder
<> " on port "
<> show port
cp <- spawnProcess folder ("npx purs ide server -p " <> show port)
log
$ "Spawned ide server in folder "
<> un Folder folder
<> " on port "
<> show port
log $ "Spawning ide server" <> infoString
cp <- spawnProcess folder "npx" [ "purs", "ide", "server", "-p", show port, "--editor-mode", "--no-watch" ]
-- liftEffect $ onDataString (CP.stdout cp) UTF8 \str -> do
-- log $ "--------" <> infoString <> "\n----------\n" <> str <> "\n----------\n"
log $ "Spawned ide server" <> infoString
-- building once
{ error, stderr, stdout } <- execCommand folder "npx spago build"
stderrStr <- liftEffect $ Buf.toString UTF8 stderr
log $ "Built: " <> stderrStr
log $ "Loading modules" <> infoString
loadPscIde folder port
pure cp
where
infoString =
" in folder "
<> un Folder folder
<> " on port "
<> show port
execCommand ∷ Folder -> String -> Aff CP.ExecResult
execCommand folder command =
makeAff \callback -> do
let
options = CP.defaultExecOptions { cwd = Just (un Folder folder) }
childProcess <- CP.exec command options (callback <<< Right)
pure $ effectCanceler ((log $ "Killing " <> show (CP.pid childProcess)) *> CP.kill SIGKILL childProcess)
restartIdeServer ∷ Folder -> Int -> Ref ChildProcess -> Aff Unit
restartIdeServer folder port processRef = do
@ -73,18 +86,18 @@ restartIdeServer folder port processRef = do
newCp <- startIdeServer folder port
Ref.write newCp processRef # liftEffect
spawnProcess ∷ Folder -> String -> Aff ChildProcess
spawnProcess folder command =
spawnProcess ∷ Folder -> String -> Array String -> Aff ChildProcess
spawnProcess folder command args =
makeAff \callback -> do
let
options = CP.defaultExecOptions { cwd = Just (un Folder folder) }
childProcess <- CP.exec command options mempty
options = CP.defaultSpawnOptions { cwd = Just (un Folder folder) }
childProcess <- CP.spawn command args options
callback (Right childProcess)
pure $ effectCanceler ((log $ "Killing " <> show (CP.pid childProcess)) *> CP.kill SIGKILL childProcess)
newtype PscIdeConnection
= PscIdeConnection
{ serverProcess ∷ ChildProcess
{ serverProcessRef ∷ Ref ChildProcess
, port ∷ Int
, folder ∷ Folder
}
@ -99,12 +112,29 @@ saveMainFile folder code = writeTextFile UTF8 (un Folder folder <> "/src/Main.pu
getFolder ∷ PscIdeConnection -> Folder
getFolder (PscIdeConnection { folder }) = folder
loadPscIde ∷ Folder -> Int -> Aff Unit
loadPscIde folder port = do
makeAff \affCb -> do
socket <- Socket.createConnectionTCP port "localhost" mempty
-- maybe timeout?
Socket.onError socket (affCb <<< Left)
void
$ Socket.writeString socket (writeJSON 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"
Socket.onReady socket (void $ Socket.writeString socket command UTF8 mempty)
pure (closeSocketCanceller socket)
compileCode ∷ String -> PscIdeConnection -> Aff String
compileCode code (PscIdeConnection { port, folder }) = do
compileCode code (PscIdeConnection { port, folder, serverProcessRef }) = do
serverProcess :: ChildProcess <- Ref.read serverProcessRef # liftEffect
saveMainFile folder code
makeAff \affCb -> do
log $
"Compiling code in " <> (un Folder folder) <> " on port " <> show port
socket <- Socket.createConnectionTCP port "localhost" mempty
-- maybe timeout?
Socket.onError socket (affCb <<< Left)
@ -128,11 +158,13 @@ compileCode code (PscIdeConnection { port, folder }) = do
mkConnection ∷ Folder -> Int -> Aff PscIdeConnection
mkConnection folder port = do
serverProcess <- startIdeServer folder port
liftEffect $ CP.onError serverProcess \e ->
log $ "Server process on port " <> show port <> " got error " <> show e
serverProcessRef <- Ref.new serverProcess # liftEffect
liftEffect
$ CP.onError serverProcess \e ->
log $ "Server process on port " <> show port <> " got error " <> show e
pure
$ PscIdeConnection
{ serverProcess
{ serverProcessRef
, port
, folder
}
}

24
shared/Shared/Models/Body.purs
View File

@ -1,6 +1,6 @@
module Shared.Models.Body where
import Data.Maybe (Maybe(..))
import Data.Maybe (Maybe)
type CompileRequest
= { code ∷ String }
@ -10,27 +10,7 @@ type CompileRequest
-- , resultType :: String
-- }
type CompileResult
= { result ∷
Array
{ allSpans ∷
Array
{ end ∷ Array Int
, name ∷ String
, start ∷ Array Int
}
, errorCode ∷ String
, errorLink ∷ String
, filename ∷ String
, message ∷ String
, moduleName ∷ String
, position ∷
{ endColumn ∷ Int
, endLine ∷ Int
, startColumn ∷ Int
, startLine ∷ Int
}
, suggestion ∷ Maybe Suggestion
}
= { result ∷ Array ErrorOrWarning
, resultType ∷ String
}