├── .envrc ├── .prettierignore ├── _redirects ├── docs ├── atestat │ ├── .latexmkrc │ ├── graph.png │ ├── long.pdf │ ├── examples.png │ ├── projects.png │ ├── tutorial.png │ └── .gitignore └── infoeducatie │ ├── assets │ ├── elm.png │ └── file-structure.png │ └── external.md ├── .prettierrc ├── public ├── favicon.png ├── styles │ ├── utils │ │ ├── center.scss │ │ ├── input.scss │ │ ├── _utils.scss │ │ └── stack.scss │ ├── _fonts.scss │ ├── components │ │ ├── error.scss │ │ ├── with-logo.scss │ │ ├── node-input.scss │ │ ├── tabs.scss │ │ ├── dropdown.scss │ │ ├── input.scss │ │ ├── switch.scss │ │ └── loading.scss │ ├── theme.scss │ ├── pages │ │ ├── editor │ │ │ ├── settings.scss │ │ │ ├── scene.scss │ │ │ ├── edit-node.scss │ │ │ ├── panel.scss │ │ │ ├── problems.scss │ │ │ ├── tree.scss │ │ │ └── add.scss │ │ ├── login.scss │ │ ├── editTutorial.scss │ │ ├── editor.scss │ │ ├── tutorial.scss │ │ ├── projects.scss │ │ └── home.scss │ └── index.scss ├── index.ts └── index.html ├── src ├── Foreign │ ├── Marked.purs │ ├── Marked.js │ └── Render.js ├── Math │ ├── SeededRandom.purs │ └── SeededRandom.js ├── Data │ ├── Foreign │ │ ├── Set.js │ │ └── Set.purs │ ├── Editor │ │ ├── Class │ │ │ └── Depends.purs │ │ ├── FunctionUi.purs │ │ ├── Node │ │ │ ├── NodeId.purs │ │ │ ├── NodeDescriptor.purs │ │ │ ├── NodeData.purs │ │ │ └── PinLocation.purs │ │ ├── FunctionName.purs │ │ ├── Constants.purs │ │ ├── Save.purs │ │ ├── DataflowFunction.purs │ │ ├── NodeGroup.purs │ │ ├── FunctionData.purs │ │ └── Location.purs │ ├── Char.purs │ ├── Vector.purs │ ├── Utils.purs │ ├── Functor.purs │ ├── Map.purs │ ├── Lens.purs │ ├── Dataflow │ │ ├── Scheme.purs │ │ ├── TypeEnv.purs │ │ ├── Expression │ │ │ ├── Optimize.purs │ │ │ └── Lint.purs │ │ ├── Runtime │ │ │ ├── ValueMap.purs │ │ │ ├── Class │ │ │ │ ├── Typeable.purs │ │ │ │ └── Describable.purs │ │ │ └── TermEnvironment.purs │ │ ├── Native │ │ │ ├── Prelude.purs │ │ │ ├── NativeConfig.purs │ │ │ ├── Literal.purs │ │ │ ├── ControlFlow.purs │ │ │ ├── Logic.purs │ │ │ ├── String.purs │ │ │ └── Predicate.purs │ │ ├── Constraint.purs │ │ ├── TypeError.purs │ │ └── Class │ │ │ └── Substituable.purs │ ├── Ord.purs │ ├── Math.purs │ ├── MouseButton.purs │ ├── Class │ │ └── GraphRep.purs │ ├── ProjectId.purs │ ├── List.purs │ ├── Tab.purs │ ├── ProjectList.purs │ ├── TutorialConfig.purs │ ├── Gist.purs │ ├── Profile.purs │ ├── String.purs │ ├── Tutorial.purs │ ├── Route.purs │ └── ValidateSolution.purs ├── typescript │ ├── helpers │ │ ├── findLast.ts │ │ └── minBy.ts │ ├── mouse.ts │ ├── types │ │ ├── ForeignAction.ts │ │ ├── Hiccup.ts │ │ └── Node.ts │ ├── constants.ts │ ├── preview.ts │ ├── save.ts │ └── components │ │ └── TextWithBackground.ts ├── Component │ ├── Loading.purs │ ├── Foreign │ │ └── Modal.js │ ├── Icon.purs │ ├── WithLogo.purs │ ├── HighlightedText.purs │ ├── Error.purs │ ├── Tooltip.purs │ ├── Switch.purs │ ├── Tabs.purs │ ├── Clone.purs │ ├── Editor │ │ ├── NodeUiManager.purs │ │ ├── HighlightedType.purs │ │ ├── NodePreview.purs │ │ └── EditNode.purs │ ├── Utils.purs │ └── HOC │ │ └── Connect.purs ├── Control │ └── Monad │ │ ├── Effect.purs │ │ └── Dataflow │ │ ├── Solve │ │ ├── SolveConstraintSet.purs │ │ ├── SolveExpression.purs │ │ └── Unify.purs │ │ └── Solve.purs ├── Capability │ ├── Navigate.purs │ └── Resource │ │ ├── Gist.purs │ │ ├── User.purs │ │ ├── Tutorial.purs │ │ └── Project.purs ├── Constants.purs ├── Page │ └── FormPage.purs ├── Api │ ├── Endpoint.purs │ └── Utils.purs ├── Main.purs ├── Form │ └── Field.purs └── Config.purs ├── _templates ├── purescript │ ├── component │ │ ├── index.js │ │ └── main.ejs │ ├── module │ │ └── main.ejs │ ├── render-function │ │ ├── index.js │ │ └── main.ejs │ └── help │ │ └── index.ejs └── generator │ ├── help │ └── index.ejs │ ├── new │ └── hello.ejs │ └── with-prompt │ ├── prompt.ejs │ └── hello.ejs ├── nodemon.json ├── .gitignore ├── .releaserc.json ├── test └── Main.purs ├── tsconfig.json ├── .github ├── ISSUE_TEMPLATE │ ├── feature_request.md │ └── bug_report.md └── workflows │ ├── release.yml │ └── test.yml ├── packages.dhall ├── .vscode └── settings.json ├── flake.nix ├── spago.dhall ├── package.json ├── CONTRIBUTING.md ├── .all-contributorsrc └── flake.lock /.envrc: -------------------------------------------------------------------------------- 1 | use flake 2 | -------------------------------------------------------------------------------- /.prettierignore: -------------------------------------------------------------------------------- 1 | *.ejs 2 | -------------------------------------------------------------------------------- /_redirects: -------------------------------------------------------------------------------- 1 | /* /index.html 200 -------------------------------------------------------------------------------- /docs/atestat/.latexmkrc: -------------------------------------------------------------------------------- 1 | $pdflatex = 'pdflatex --shell-escape %O %S'; 2 | -------------------------------------------------------------------------------- /.prettierrc: -------------------------------------------------------------------------------- 1 | { 2 | "semi": false, 3 | "trailingComma": "none" 4 | } 5 | -------------------------------------------------------------------------------- /public/favicon.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lunarcast/lunarbox/HEAD/public/favicon.png -------------------------------------------------------------------------------- /docs/atestat/graph.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lunarcast/lunarbox/HEAD/docs/atestat/graph.png -------------------------------------------------------------------------------- /docs/atestat/long.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lunarcast/lunarbox/HEAD/docs/atestat/long.pdf -------------------------------------------------------------------------------- /docs/atestat/examples.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lunarcast/lunarbox/HEAD/docs/atestat/examples.png -------------------------------------------------------------------------------- /docs/atestat/projects.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lunarcast/lunarbox/HEAD/docs/atestat/projects.png -------------------------------------------------------------------------------- /docs/atestat/tutorial.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lunarcast/lunarbox/HEAD/docs/atestat/tutorial.png -------------------------------------------------------------------------------- /docs/infoeducatie/assets/elm.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lunarcast/lunarbox/HEAD/docs/infoeducatie/assets/elm.png -------------------------------------------------------------------------------- /src/Foreign/Marked.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Foreign.Marked where 2 | 3 | foreign import parseMarkdown :: String -> String 4 | -------------------------------------------------------------------------------- /docs/infoeducatie/assets/file-structure.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/lunarcast/lunarbox/HEAD/docs/infoeducatie/assets/file-structure.png -------------------------------------------------------------------------------- /src/Math/SeededRandom.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Math.SeededRandom (seededInt) where 2 | 3 | foreign import seededInt :: String -> Int -> Int -> Int 4 | -------------------------------------------------------------------------------- /_templates/purescript/component/index.js: -------------------------------------------------------------------------------- 1 | exports.prompt = async ({ args }) => ({ 2 | ...args, 3 | folder: args.page || args.p ? "Page" : "Component", 4 | }); 5 | -------------------------------------------------------------------------------- /_templates/purescript/module/main.ejs: -------------------------------------------------------------------------------- 1 | --- 2 | to: src/<%= name.replace(/\./g, "/") %>.purs 3 | --- 4 | module Lunarbox.<%= name %> where 5 | 6 | import Prelude 7 | -------------------------------------------------------------------------------- /nodemon.json: -------------------------------------------------------------------------------- 1 | { 2 | "$schema": "http://json.schemastore.org/nodemon", 3 | "exec": "yarn build:purescript", 4 | "watch": ["src"], 5 | "ext": "purs,ts" 6 | } 7 | -------------------------------------------------------------------------------- /public/styles/utils/center.scss: -------------------------------------------------------------------------------- 1 | @mixin center { 2 | display: flex; 3 | flex-direction: column; 4 | justify-content: center; 5 | align-items: center; 6 | } 7 | -------------------------------------------------------------------------------- /public/styles/utils/input.scss: -------------------------------------------------------------------------------- 1 | // Very basic styles for most inputs 2 | @mixin base-input { 3 | background: transparent; 4 | outline: none; 5 | border: none; 6 | } 7 | -------------------------------------------------------------------------------- /docs/atestat/.gitignore: -------------------------------------------------------------------------------- 1 | # Latex stuf 2 | *.aux 3 | *.log 4 | *.out 5 | *.fls 6 | *.toc 7 | *.thm 8 | *.synctex* 9 | *.fdb_latexmk 10 | node_modules 11 | _minted-* 12 | 13 | -------------------------------------------------------------------------------- /_templates/generator/help/index.ejs: -------------------------------------------------------------------------------- 1 | --- 2 | message: | 3 | hygen {bold generator new} --name [NAME] --action [ACTION] 4 | hygen {bold generator with-prompt} --name [NAME] --action [ACTION] 5 | --- -------------------------------------------------------------------------------- /src/Data/Foreign/Set.js: -------------------------------------------------------------------------------- 1 | "use strict" 2 | 3 | /** 4 | * Converts an array to a set (here for using from within purescript). 5 | * 6 | * @param arr The array to convert. 7 | */ 8 | exports.arrayToSet = (arr) => new Set(arr) 9 | -------------------------------------------------------------------------------- /public/styles/_fonts.scss: -------------------------------------------------------------------------------- 1 | @import url("https://fonts.googleapis.com/css2?family=Nunito&family=Oxanium:wght@400;700&family=Roboto+Mono:wght@700&display=swap"); 2 | 3 | $oxanium: "Oxanium", cursive; 4 | $montserrat: "Nunito", sans-serif; 5 | -------------------------------------------------------------------------------- /public/styles/utils/_utils.scss: -------------------------------------------------------------------------------- 1 | // This is here so we can do: 2 | // @use utils/utils 3 | // and then we can access stuff with utils.foo, utils.bar etc 4 | @import "./center.scss"; 5 | @import "./stack.scss"; 6 | @import "./input.scss"; 7 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /node_modules/ 2 | /.spago 3 | 4 | /.psc* 5 | /.purs* 6 | 7 | .cache 8 | pnpm-debug.log 9 | yarn-error.log 10 | 11 | output 12 | dce-output 13 | dist 14 | generated-docs 15 | public/index.js 16 | 17 | .env.* 18 | .direnv 19 | -------------------------------------------------------------------------------- /_templates/purescript/render-function/index.js: -------------------------------------------------------------------------------- 1 | const toCamelCase = (s) => `${s[0].toLowerCase()}${s.slice(1)}`; 2 | 3 | exports.prompt = async ({ args }) => ({ 4 | ...args, 5 | renderFunction: toCamelCase(args.name.split(".").pop()), 6 | }); 7 | -------------------------------------------------------------------------------- /src/Data/Editor/Class/Depends.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.Class.Depends where 2 | 3 | import Data.Set as Set 4 | 5 | -- Typeclass representing something which depens on other dependencies 6 | class Depends f a where 7 | getDependencies :: f -> Set.Set a 8 | -------------------------------------------------------------------------------- /src/Foreign/Marked.js: -------------------------------------------------------------------------------- 1 | "use strict" 2 | 3 | const marked = require("marked") 4 | 5 | /** 6 | * Parse a string of markdown to html 7 | * 8 | * @param {String} input The string to parse. 9 | */ 10 | exports.parseMarkdown = (input) => marked(input, {}) 11 | -------------------------------------------------------------------------------- /.releaserc.json: -------------------------------------------------------------------------------- 1 | { 2 | "branches": ["master"], 3 | "plugins": [ 4 | "@semantic-release/commit-analyzer", 5 | "@semantic-release/release-notes-generator", 6 | "@semantic-release/changelog", 7 | "@semantic-release/git", 8 | "@semantic-release/github" 9 | ] 10 | } 11 | -------------------------------------------------------------------------------- /src/Data/Char.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Char (arrow) where 2 | 3 | import Prelude 4 | import Data.Char (fromCharCode) 5 | import Data.Maybe (maybe) 6 | import Data.String.CodeUnits as Char 7 | 8 | -- Used for printing the types 9 | arrow :: String 10 | arrow = maybe "->" Char.singleton $ fromCharCode 8594 11 | -------------------------------------------------------------------------------- /test/Main.purs: -------------------------------------------------------------------------------- 1 | module Test.Main where 2 | 3 | import Prelude 4 | import Effect (Effect) 5 | import Effect.Aff (launchAff_) 6 | import Test.Spec.Reporter (consoleReporter) 7 | import Test.Spec.Runner (runSpec) 8 | 9 | main :: Effect Unit 10 | main = 11 | launchAff_ 12 | $ runSpec [ consoleReporter ] do 13 | pure unit 14 | -------------------------------------------------------------------------------- /_templates/generator/new/hello.ejs: -------------------------------------------------------------------------------- 1 | --- 2 | to: _templates/<%= name %>/<%= action || 'new' %>/hello.ejs.t 3 | --- 4 | --- 5 | to: app/hello.js 6 | --- 7 | const hello = ``` 8 | Hello! 9 | This is your first hygen template. 10 | 11 | Learn what it can do here: 12 | 13 | https://github.com/jondot/hygen 14 | ``` 15 | 16 | console.log(hello) 17 | 18 | 19 | -------------------------------------------------------------------------------- /src/Data/Vector.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Vector where 2 | 3 | import Data.Typelevel.Num (D2) 4 | import Data.Vec (Vec) 5 | 6 | -- Shorthand for vectors with 2 elements 7 | -- Basically with this package we specify the number of elements 8 | -- At the type level, so we are sure we handle exactly the right amount. 9 | type Vec2 a 10 | = Vec D2 a 11 | -------------------------------------------------------------------------------- /_templates/generator/with-prompt/prompt.ejs: -------------------------------------------------------------------------------- 1 | --- 2 | to: _templates/<%= name %>/<%= action || 'new' %>/prompt.js 3 | --- 4 | 5 | // see types of prompts: 6 | // https://github.com/enquirer/enquirer/tree/master/examples 7 | // 8 | module.exports = [ 9 | { 10 | type: 'input', 11 | name: 'message', 12 | message: "What's your message?" 13 | } 14 | ] 15 | -------------------------------------------------------------------------------- /_templates/generator/with-prompt/hello.ejs: -------------------------------------------------------------------------------- 1 | --- 2 | to: _templates/<%= name %>/<%= action || 'new' %>/hello.ejs.t 3 | --- 4 | --- 5 | to: app/hello.js 6 | --- 7 | const hello = ``` 8 | Hello! 9 | This is your first prompt based hygen template. 10 | 11 | Learn what it can do here: 12 | 13 | https://github.com/jondot/hygen 14 | ``` 15 | 16 | console.log(hello) 17 | 18 | 19 | -------------------------------------------------------------------------------- /public/styles/utils/stack.scss: -------------------------------------------------------------------------------- 1 | // This file was sponsored by RAID SHADOW LEGEND! 2 | // (Vyctor said I should let this here so here you go) 3 | 4 | @mixin stack { 5 | display: block; 6 | position: relative; 7 | } 8 | 9 | @mixin layer { 10 | top: 0; 11 | left: 0; 12 | right: 0; 13 | bottom: 0; 14 | position: absolute; 15 | width: 100%; 16 | height: 100%; 17 | } 18 | -------------------------------------------------------------------------------- /src/Data/Utils.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Utils 2 | ( decodeAt 3 | ) where 4 | 5 | import Prelude 6 | import Data.Argonaut.Core (Json) 7 | import Data.Argonaut (decodeJson, (.:), class DecodeJson) 8 | import Data.Either (Either) 9 | 10 | -- Decode a single field of some json 11 | decodeAt :: forall a. DecodeJson a => String -> Json -> Either String a 12 | decodeAt key = (_ .: key) <=< decodeJson 13 | -------------------------------------------------------------------------------- /src/Data/Foreign/Set.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Set (NativeSet, toNative) where 2 | 3 | import Prelude 4 | import Data.Set (Set) 5 | import Data.Set as Set 6 | 7 | foreign import data NativeSet :: Type -> Type 8 | 9 | foreign import arrayToSet :: forall a. Array a -> NativeSet a 10 | 11 | -- | Convert a purs set to a js one. 12 | toNative :: Set ~> NativeSet 13 | toNative = arrayToSet <<< Set.toUnfoldable 14 | -------------------------------------------------------------------------------- /public/styles/components/error.scss: -------------------------------------------------------------------------------- 1 | @use "../utils/utils"; 2 | 3 | @import "../theme.scss"; 4 | 5 | .error-container { 6 | @include utils.center; 7 | 8 | width: 100%; 9 | height: 100%; 10 | 11 | background: $primary; 12 | color: $on-dark-pale; 13 | } 14 | 15 | .error-text { 16 | font-weight: bold; 17 | font-size: 2rem; 18 | } 19 | 20 | .error-illustration { 21 | max-height: 50vh; 22 | margin-bottom: 2rem; 23 | } 24 | -------------------------------------------------------------------------------- /src/typescript/helpers/findLast.ts: -------------------------------------------------------------------------------- 1 | /** 2 | * Find the last element in an array to pass a predicate. 3 | * 4 | * @param arr The array to search trough. 5 | * @param predicate The predicate to run on all elements. 6 | */ 7 | export const findLast = ( 8 | arr: T[], 9 | predicate: (v: T) => boolean 10 | ): T | null => { 11 | return arr.reduce( 12 | (acc, curr) => (predicate(curr) ? curr : acc), 13 | null as T | null 14 | ) 15 | } 16 | -------------------------------------------------------------------------------- /src/Data/Functor.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Functor (indexed) where 2 | 3 | import Data.FunctorWithIndex (class FunctorWithIndex, mapWithIndex) 4 | import Data.Tuple (Tuple(..)) 5 | 6 | -- Asspcoiate all the elements of an indexed functor with an index 7 | -- Example: 8 | -- Given ["a", "b", "c] 9 | -- this returns [(0, "a"), (1, "b"), (2, "C")] 10 | indexed :: forall a i f. FunctorWithIndex i f => f a -> f (Tuple i a) 11 | indexed = mapWithIndex Tuple 12 | -------------------------------------------------------------------------------- /src/Data/Map.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Map (maybeBimap) where 2 | 3 | import Prelude 4 | import Data.Array (catMaybes) 5 | import Data.Map as Map 6 | import Data.Maybe (Maybe) 7 | import Data.Tuple (Tuple, uncurry) 8 | 9 | -- A combination of bimap and mapMaybeWithKeys 10 | maybeBimap :: forall k v k' v'. Ord k => Ord k' => (k -> v -> Maybe (Tuple k' v')) -> Map.Map k v -> Map.Map k' v' 11 | maybeBimap mapper = Map.fromFoldable <<< catMaybes <<< map (uncurry mapper) <<< Map.toUnfoldable 12 | -------------------------------------------------------------------------------- /tsconfig.json: -------------------------------------------------------------------------------- 1 | { 2 | "compilerOptions": { 3 | "moduleResolution": "Node", 4 | "module": "ESNext", 5 | "target": "ESNext", 6 | "lib": ["DOM", "DOM.Iterable", "ESNext.Array", "ESNext"], 7 | "downlevelIteration": true, 8 | "strictNullChecks": true, 9 | "strictBindCallApply": true, 10 | "esModuleInterop": true, 11 | "importHelpers": true, 12 | "baseUrl": "." 13 | }, 14 | "include": ["src/typescript", "public"], 15 | "exclude": ["node_modules"] 16 | } 17 | -------------------------------------------------------------------------------- /_templates/purescript/render-function/main.ejs: -------------------------------------------------------------------------------- 1 | --- 2 | to: src/Component/<%= name.replace(/\./g, "/") %>.purs 3 | --- 4 | module Lunarbox.Component.<%= name %> 5 | ( <%= renderFunction %> 6 | ) where 7 | 8 | import Prelude 9 | import Halogen.HTML as HH 10 | import Halogen.HTML (HTML) 11 | 12 | type Actions a 13 | = {} 14 | 15 | type Input = Unit 16 | 17 | <%= renderFunction %> :: forall h a. Input -> Actions a -> HTML h a 18 | <%= renderFunction %> state actions = HH.text "unimplemented" 19 | -------------------------------------------------------------------------------- /src/typescript/mouse.ts: -------------------------------------------------------------------------------- 1 | /** 2 | * Enum containing mouse buttons we can check for. 3 | */ 4 | export const enum MouseButtons { 5 | LeftButton = 1, 6 | Wheel = -1, // Todo: find the correct code for this 7 | RightButton = 2 8 | } 9 | 10 | /** 11 | * Check if a mouse button is pressed. 12 | * 13 | * @param button The button to check for.. 14 | * @param bits The bits from the event object. 15 | */ 16 | export const isPressed = (bits: number) => (button: MouseButtons) => 17 | bits & button 18 | -------------------------------------------------------------------------------- /src/Component/Loading.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Loading 2 | ( loading 3 | ) where 4 | 5 | import Prelude 6 | import Data.Array (replicate) 7 | import Halogen.HTML (HTML) 8 | import Halogen.HTML as HH 9 | import Lunarbox.Component.Utils (className) 10 | 11 | -- Loading animation 12 | -- Based on loading.io 13 | loading :: forall h a. HTML h a 14 | loading = 15 | HH.div [ className "loading-container" ] 16 | [ HH.div [ className "lds-roller" ] 17 | $ replicate 8 (HH.div_ []) 18 | ] 19 | -------------------------------------------------------------------------------- /src/Control/Monad/Effect.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Control.Monad.Effect (print, printString) where 2 | 3 | import Prelude 4 | import Effect.Class (class MonadEffect, liftEffect) 5 | import Effect.Class.Console (log, logShow) 6 | 7 | -- pirnt anything with a Show instance to the console 8 | print :: forall m s. MonadEffect m => Show s => s -> m Unit 9 | print = liftEffect <<< logShow 10 | 11 | -- print a string to the console 12 | printString :: forall m. MonadEffect m => String -> m Unit 13 | printString = liftEffect <<< log 14 | -------------------------------------------------------------------------------- /_templates/purescript/help/index.ejs: -------------------------------------------------------------------------------- 1 | --- 2 | message: | 3 | 4 | hygen {bold purescript component} [NAME] [-p | --page] 5 | hygen {bold purescript module} [NAME] 6 | hygen {bold purescript render-function} [NAME] 7 | hygen {bold purescript help} 8 | 9 | 10 | component Gnerate a new halogen componen 11 | module Generate a new purescript module 12 | render-function Generate a pure function taking some inputs and some actions and generating html. 13 | help Display a list of all commands 14 | --- -------------------------------------------------------------------------------- /src/Math/SeededRandom.js: -------------------------------------------------------------------------------- 1 | "use strict" 2 | 3 | const seedrandom = require("seedrandom") 4 | 5 | /** 6 | * Generate a seeded random int inside the interval [min, max). 7 | * 8 | * @param seed The seed to use for the generation. 9 | * @param min THe minimum value. 10 | * @param max The maximum value. 11 | * @type { (seed: string) => (min: number) => (max: number) => number } 12 | */ 13 | exports.seededInt = (seed) => (min) => (max) => { 14 | const generator = seedrandom(seed) 15 | return min + Math.floor((max - min) * generator()) 16 | } 17 | -------------------------------------------------------------------------------- /src/typescript/helpers/minBy.ts: -------------------------------------------------------------------------------- 1 | /** 2 | * find the smallest element in an array based on a certain criteria 3 | * 4 | * @param isSmaller The compare function 5 | * @param arr The array to search trough 6 | * @param def Fallback in case of empty arrays 7 | */ 8 | export const minBy = ( 9 | isSmaller: (a: T, b: T) => boolean, 10 | arr: T[] 11 | ): T | null => 12 | arr.reduce((acc, curr) => { 13 | if (acc === null) { 14 | return curr 15 | } 16 | 17 | return isSmaller(curr, acc) ? curr : acc 18 | }, null as T | null) 19 | -------------------------------------------------------------------------------- /src/Capability/Navigate.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Capability.Navigate where 2 | 3 | import Prelude 4 | import Control.Monad.Trans.Class (lift) 5 | import Lunarbox.Data.Route (Route) 6 | import Halogen (HalogenM) 7 | 8 | class 9 | Monad m <= Navigate m where 10 | navigate :: Route -> m Unit 11 | logout :: m Unit 12 | 13 | -- | This instance lets us avoid having to use `lift` when we use these functions in a component. 14 | instance navigateHalogenM :: Navigate m => Navigate (HalogenM st act slots msg m) where 15 | navigate = lift <<< navigate 16 | logout = lift logout 17 | -------------------------------------------------------------------------------- /src/Component/Foreign/Modal.js: -------------------------------------------------------------------------------- 1 | "use strict" 2 | 3 | const micromodal = require("micromodal").default 4 | 5 | // Reexporting those for use from withing purescript 6 | exports.showModal = (name) => () => 7 | new Promise((resolve) => { 8 | let resolved = false 9 | 10 | micromodal.show(name, { 11 | onClose: (element) => { 12 | if (resolved) return 13 | 14 | resolved = true 15 | 16 | resolve(element) 17 | }, 18 | awaitCloseAnimation: true 19 | }) 20 | }) 21 | 22 | exports.closeModal = (name) => () => micromodal.close(name) 23 | -------------------------------------------------------------------------------- /public/styles/components/with-logo.scss: -------------------------------------------------------------------------------- 1 | @use "../utils/utils"; 2 | 3 | @import "../theme.scss"; 4 | 5 | .with-logo { 6 | display: grid; 7 | grid-template-columns: 30% auto; 8 | height: 100vh; 9 | overflow: hidden; 10 | 11 | .left { 12 | @include utils.center; 13 | height: 100vh; 14 | 15 | background: $primary-dark; 16 | } 17 | 18 | .right { 19 | background: $primary; 20 | } 21 | } 22 | 23 | @media only screen and (max-width: 1000px) { 24 | .with-logo { 25 | grid-template-columns: 1fr; 26 | 27 | .left { 28 | display: none; 29 | } 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /public/index.ts: -------------------------------------------------------------------------------- 1 | import "./styles/index.scss" 2 | import { main as mainImpl } from "../output/Main" 3 | 4 | type Effect = (v: T) => void 5 | 6 | const main = mainImpl as (prod: boolean) => (apiUrl: string) => Effect 7 | 8 | const production = process.env.NODE_ENV === "production" 9 | 10 | if (production) { 11 | throw new Error("Api not deployed anywhere at the moment") 12 | } 13 | const apiUrl = "http://localhost:8090" 14 | 15 | const start = main(production)(apiUrl) 16 | 17 | if (!production && module.hot) { 18 | module.hot.accept(() => location.reload(true)) 19 | } 20 | 21 | start() 22 | -------------------------------------------------------------------------------- /src/Capability/Resource/Gist.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Capability.Resource.Gist where 2 | 3 | import Prelude 4 | import Data.Either (Either) 5 | import Halogen (HalogenM, lift) 6 | import Lunarbox.Data.Gist (Gist, GistId) 7 | 8 | -- | Capability for managing gists 9 | class 10 | Monad m <= ManageGists m where 11 | fetchGist :: GistId -> m (Either String Gist) 12 | 13 | -- | This instance lets us avoid having to use `lift` when we use these functions in a component. 14 | instance manageGistsHalogenM :: ManageGists m => ManageGists (HalogenM st act slots msg m) where 15 | fetchGist = lift <<< fetchGist 16 | -------------------------------------------------------------------------------- /src/Data/Editor/FunctionUi.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.FunctionUi 2 | ( FunctionUiActions 3 | , FunctionUiInputs 4 | , FunctionUi 5 | ) where 6 | 7 | import Data.Maybe (Maybe) 8 | import Halogen.HTML (ComponentHTML) 9 | import Lunarbox.Data.Dataflow.Runtime (RuntimeValue) 10 | 11 | type FunctionUiActions a 12 | = { setValue :: RuntimeValue -> Maybe a 13 | } 14 | 15 | type FunctionUiInputs 16 | = { value :: RuntimeValue 17 | } 18 | 19 | -- Functions can have custom ui under them 20 | type FunctionUi a s m 21 | = FunctionUiInputs -> FunctionUiActions a -> ComponentHTML a s m 22 | -------------------------------------------------------------------------------- /src/Data/Lens.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Lens 2 | ( listToArrayIso 3 | , newtypeIso 4 | ) where 5 | 6 | import Data.Array as Array 7 | import Data.Lens (Lens', Iso', iso) 8 | import Data.List as List 9 | import Data.Newtype (class Newtype, unwrap, wrap) 10 | 11 | -- Generic iso which can be used for any data type with a newtype instance 12 | newtypeIso :: forall a b. Newtype a b => Lens' a b 13 | newtypeIso = iso unwrap wrap 14 | 15 | -- I usually use this when I want to focus on a single element of a lsit 16 | listToArrayIso :: forall a. Iso' (List.List a) (Array a) 17 | listToArrayIso = iso List.toUnfoldable Array.toUnfoldable 18 | -------------------------------------------------------------------------------- /src/typescript/types/ForeignAction.ts: -------------------------------------------------------------------------------- 1 | import { Fn3, Fn2, Fn } from "@thi.ng/api" 2 | import { NodeId } from "./Node" 3 | 4 | // Those are here so we can do purescript interop properly 5 | export type ForeignAction = { readonly foreignAction: unique symbol } 6 | 7 | export interface ForeignActionConfig { 8 | createConnection: Fn3 9 | selectInput: Fn2 10 | selectOutput: Fn 11 | deleteConnection: Fn2 12 | goto: Fn 13 | editNode: Fn 14 | nothing: ForeignAction 15 | } 16 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Scheme.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Scheme 2 | ( Scheme(..) 3 | , fromType 4 | ) where 5 | 6 | import Prelude 7 | import Data.Foldable (fold) 8 | import Lunarbox.Data.Dataflow.Type (TVarName(..), Type) 9 | 10 | data Scheme 11 | = Forall (Array TVarName) Type 12 | 13 | derive instance eqScheme :: Eq Scheme 14 | 15 | instance showScheme :: Show Scheme where 16 | show (Forall [] t) = show t 17 | show (Forall quantifiers t) = "forall" <> fold (quantifiers <#> (\(TVarName n) -> " " <> n)) <> ". " <> show t 18 | 19 | -- Create a scheme with no type variables 20 | fromType :: Type -> Scheme 21 | fromType = Forall [] 22 | -------------------------------------------------------------------------------- /src/Data/Ord.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Ord (sortBySearch) where 2 | 3 | import Prelude 4 | import Data.Array as Array 5 | import Data.Fuzzy (matchStr) 6 | import Data.Tuple (Tuple(..), fst) 7 | 8 | -- Order a list by a search term 9 | sortBySearch :: forall a. Ord a => (a -> String) -> String -> Array a -> Array a 10 | sortBySearch toString search elements = 11 | if search == "" then 12 | elements 13 | else 14 | fst <$> sorted 15 | where 16 | withMatches = (\element -> Tuple element $ matchStr true search $ toString element) <$> elements 17 | 18 | sorted = Array.sortBy (\(Tuple _ match) (Tuple _ match') -> compare match match') withMatches 19 | -------------------------------------------------------------------------------- /src/Constants.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Constants where 2 | 3 | -- THe logo for lunarbox 4 | logo :: String 5 | logo = "https://cdn.discordapp.com/attachments/494734149978947584/705349608267579453/unknown.png" 6 | 7 | logoWithText :: String 8 | logoWithText = "https://cdn.discordapp.com/attachments/494734149978947584/705352232006320138/unknown.png" 9 | 10 | transparentLogoWithText :: String 11 | transparentLogoWithText = "https://cdn.discordapp.com/attachments/485859146558865408/707597859138043964/Screensasdfahot_1.png" 12 | 13 | transparentLogo :: String 14 | transparentLogo = "https://cdn.discordapp.com/attachments/672889285438865453/708081533151477890/favicon.png" 15 | -------------------------------------------------------------------------------- /public/styles/theme.scss: -------------------------------------------------------------------------------- 1 | // I currently have only one theme so using hard-coded scss variables is ok 2 | // In the future I might take a more complex approach if I want to allow multiple themes 3 | 4 | $primary: #262335; 5 | $on-primary: #e2e2e2; 6 | $primary-dark: #241b2f; 7 | $dark-input-bg: #2a2139; 8 | $primary-bright: #2a2139; 9 | $very-dark: #171520; 10 | $on-dark: #ffffff; 11 | $on-dark-pale: #d7c9aa; 12 | $secondary: #6af1b8; 13 | $error: #f16a6a; 14 | $bright: #36f9f6; 15 | $disabled: #5f5e65; 16 | $blue: #2667ff; 17 | 18 | $error-bg: #290000; 19 | $error-text: #df6d6d; 20 | 21 | $warning-bg: #332b00; 22 | $warning-text: #ffdd9e; 23 | 24 | $transition-time: 0.2s; 25 | -------------------------------------------------------------------------------- /public/styles/components/node-input.scss: -------------------------------------------------------------------------------- 1 | @import "../theme.scss"; 2 | 3 | .node-input { 4 | border: none; 5 | outline: none; 6 | border-bottom: 3px solid transparent; 7 | 8 | background: transparent; 9 | color: $on-dark-pale; 10 | 11 | transition: filter $transition-time; 12 | filter: none; 13 | 14 | text-overflow: ellipsis; 15 | 16 | white-space: nowrap; 17 | overflow: hidden; 18 | 19 | user-select: none; 20 | 21 | &:focus { 22 | filter: brightness(1.5); 23 | } 24 | } 25 | 26 | .node-input.node-input--number { 27 | border-bottom-color: rgb(35, 78, 196); 28 | } 29 | 30 | .node-input.node-input--string { 31 | border-bottom-color: rgb(97, 196, 35); 32 | } 33 | -------------------------------------------------------------------------------- /src/Component/Icon.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Icon where 2 | 3 | import Halogen.HTML as HH 4 | import Lunarbox.Component.Tooltip as Tooltip 5 | import Lunarbox.Component.Utils (StaticHtml, className) 6 | 7 | -- | Helper for using material icons 8 | icon :: forall a b. StaticHtml String a b 9 | icon name = HH.i [ className "material-icons" ] [ HH.text name ] 10 | 11 | -- | Tooltip integration for material icons 12 | iconWithTooltip :: forall a b. String -> Tooltip.TooltipPosition -> String -> HH.HTML a b 13 | iconWithTooltip tooltipText position name = 14 | Tooltip.tooltip 15 | tooltipText 16 | position 17 | HH.i 18 | [ className "material-icons" ] 19 | [ HH.text name ] 20 | -------------------------------------------------------------------------------- /src/typescript/types/Hiccup.ts: -------------------------------------------------------------------------------- 1 | import { Vec2Like } from "@thi.ng/vectors" 2 | import { IToHiccup } from "@thi.ng/api" 3 | 4 | type TextAlign = "center" 5 | 6 | export type TextAttribs = { 7 | stroke: string 8 | align: TextAlign 9 | scale: number 10 | baseline: "hanging" | "baseline" | "middle" 11 | font: string 12 | fill: string 13 | 14 | // Used to know if the text changed so we can resize the background 15 | __dirtyBackground: boolean 16 | } 17 | 18 | export type TextElement = ["text", Partial, Vec2Like, string] 19 | 20 | /** 21 | * Elements which can be rendered on a canvas. 22 | */ 23 | export type CanvasElement = TextElement | IToHiccup | null | CanvasElement[] 24 | -------------------------------------------------------------------------------- /src/Data/Math.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Math 2 | ( normalizeAngle 3 | , polarToCartesian 4 | ) where 5 | 6 | import Prelude 7 | import Data.Vec (vec2) 8 | import Lunarbox.Data.Vector (Vec2) 9 | import Math (Radians, cos, sin, tau, (%)) 10 | 11 | -- Take any number of radians and bring it in the [0, tau) interval 12 | normalizeAngle :: Radians -> Radians 13 | normalizeAngle angle = 14 | ( if angle < 0.0 then 15 | tau - (-angle % tau) 16 | else 17 | angle 18 | ) 19 | % tau 20 | 21 | -- Transforms from polar coordinates to cartesian coordinates 22 | polarToCartesian :: Number -> Radians -> Vec2 Number 23 | polarToCartesian radius angle = (radius * _) <$> vec2 (cos angle) (sin angle) 24 | -------------------------------------------------------------------------------- /src/Data/Dataflow/TypeEnv.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.TypeEnv 2 | ( TypeEnv(..) 3 | , singleton 4 | ) where 5 | 6 | import Prelude 7 | import Data.Map (Map) 8 | import Data.Map as Map 9 | import Data.Newtype (class Newtype) 10 | import Lunarbox.Data.Dataflow.Expression (VarName) 11 | import Lunarbox.Data.Dataflow.Scheme (Scheme) 12 | 13 | newtype TypeEnv 14 | = TypeEnv (Map VarName Scheme) 15 | 16 | derive instance newTypeTypeEnv :: Newtype TypeEnv _ 17 | 18 | derive newtype instance semigroupTypeEnv :: Semigroup TypeEnv 19 | 20 | derive newtype instance monoidTypeEnv :: Monoid TypeEnv 21 | 22 | singleton :: VarName -> Scheme -> TypeEnv 23 | singleton name scheme = TypeEnv $ Map.singleton name scheme 24 | -------------------------------------------------------------------------------- /public/styles/pages/editor/settings.scss: -------------------------------------------------------------------------------- 1 | @import "../../theme.scss"; 2 | 3 | .setting { 4 | $margin: 1rem; 5 | 6 | color: $on-primary; 7 | 8 | margin: $margin; 9 | margin-bottom: 2rem; 10 | 11 | width: calc(100% - 2 * #{$margin}); 12 | display: flex; 13 | align-items: center; 14 | } 15 | 16 | .setting__label { 17 | margin-right: 0.5rem; 18 | } 19 | 20 | .setting__switch-input { 21 | margin-left: 1rem; 22 | flex-grow: 1; 23 | } 24 | 25 | .setting__text-input { 26 | background: transparent; 27 | color: inherit; 28 | 29 | border: none; 30 | outline: none; 31 | 32 | margin-left: 2rem; 33 | width: calc(100% - 2rem); 34 | padding: 0.5rem; 35 | 36 | border-bottom: 3px solid $on-dark-pale; 37 | } 38 | -------------------------------------------------------------------------------- /src/Component/WithLogo.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.WithLogo 2 | ( withLogo 3 | ) where 4 | 5 | import Halogen.HTML (HTML) 6 | import Halogen.HTML as HH 7 | import Halogen.HTML.Properties as HP 8 | import Lunarbox.Component.Utils (className, container) 9 | import Lunarbox.Constants (logoWithText) 10 | 11 | -- Page with a logo on the left 12 | withLogo :: forall h a. HTML h a -> HTML h a 13 | withLogo content = 14 | HH.div [ className "with-logo" ] 15 | [ HH.div [ className "left" ] 16 | [ container "logo" 17 | [ HH.img 18 | [ HP.src logoWithText 19 | ] 20 | ] 21 | ] 22 | , HH.div [ className "right" ] 23 | [ content 24 | ] 25 | ] 26 | -------------------------------------------------------------------------------- /src/Data/MouseButton.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.MouseButton 2 | ( MouseButton(..) 3 | , buttonCode 4 | , isPressed 5 | ) where 6 | 7 | import Prelude 8 | import Data.Int.Bits (and) 9 | 10 | -- ADT with all the mouse buttons (well, those are not all of them but I don't need the other ones) 11 | data MouseButton 12 | = LeftButton 13 | | Wheel 14 | | RightButton 15 | 16 | -- Turns a button into it's code 17 | buttonCode :: MouseButton -> Int 18 | buttonCode = case _ of 19 | LeftButton -> 1 20 | Wheel -> -1 -- Todo: find the correct code for this 21 | RightButton -> 2 22 | 23 | -- Check if a button is pressed 24 | isPressed :: MouseButton -> Int -> Boolean 25 | isPressed button bits = 0 /= bits `and` buttonCode button 26 | -------------------------------------------------------------------------------- /docs/infoeducatie/external.md: -------------------------------------------------------------------------------- 1 | # Stuff I didn't make myself 2 | 3 | - The logo was made by [Vyctor](https://github.com/Vyctor661/). He also gave me ideas for the design. 4 | - Some of the auth stuff was originally taken from [this repo](https://github.com/thomashoneyman/purescript-halogen-realworld/) 5 | - All the purescript dependencies I used are listed in spago.dhall 6 | - Other tooling I used can be found in package.json 7 | - The loading animation is taken from [loading.io](https://loading.io/css/) 8 | - THe svg illustrations are taken from [undraw](https://undraw.co/) 9 | 10 | ## Why are there other contributors? 11 | 12 | Victor Sandu helped me with some design ideas & feedback and ImperialWater helped me with ideas and by fixing some typos 13 | -------------------------------------------------------------------------------- /public/styles/pages/editor/scene.scss: -------------------------------------------------------------------------------- 1 | @use "../../utils/utils"; 2 | @use "../../fonts"; 3 | @import "../../theme.scss"; 4 | 5 | .scene { 6 | background: $primary; 7 | width: 100%; 8 | 9 | overflow: hidden; 10 | } 11 | 12 | .scene__canvas { 13 | height: 100%; 14 | width: 100%; 15 | } 16 | 17 | .scene__illustration-container { 18 | @include utils.center; 19 | height: 100%; 20 | } 21 | 22 | .scene__illustration-container .scene__illustration { 23 | width: 40vw; 24 | 25 | img { 26 | width: 100%; 27 | } 28 | } 29 | 30 | .scene__text { 31 | width: 100%; 32 | text-align: center; 33 | font-size: 1.5rem; 34 | padding: 2rem; 35 | box-sizing: border-box; 36 | font-family: fonts.$oxanium; 37 | color: $disabled; 38 | } 39 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/feature_request.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Feature request 3 | about: Suggest an idea for this project 4 | title: 'Feature request: ...' 5 | labels: enhancement 6 | assignees: Mateiadrielrafael 7 | 8 | --- 9 | 10 | **Is your feature request related to a problem? Please describe.** 11 | A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] 12 | 13 | **Describe the solution you'd like** 14 | A clear and concise description of what you want to happen. 15 | 16 | **Describe alternatives you've considered** 17 | A clear and concise description of any alternative solutions or features you've considered. 18 | 19 | **Additional context** 20 | Add any other context or screenshots about the feature request here. 21 | -------------------------------------------------------------------------------- /src/Component/HighlightedText.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.HighlightedText 2 | ( highlight 3 | , bold 4 | ) where 5 | 6 | import Prelude 7 | import CSS (Color) 8 | import CSS as CSS 9 | import Halogen.HTML as HH 10 | import Halogen.HTML.CSS (style) 11 | 12 | highlightedClass :: String 13 | highlightedClass = "highlighted" 14 | 15 | -- Make some text of any color 16 | highlight :: forall h a. Color -> HH.HTML h a -> HH.HTML h a 17 | highlight color inner = 18 | HH.span 19 | [ style 20 | $ CSS.color 21 | color 22 | ] 23 | [ inner ] 24 | 25 | -- Make some text bold and bigger (for highlighting small chars) 26 | bold :: forall h a. HH.HTML h a -> HH.HTML h a 27 | bold = HH.span [ style $ CSS.fontWeight CSS.bold ] <<< pure 28 | -------------------------------------------------------------------------------- /packages.dhall: -------------------------------------------------------------------------------- 1 | let upstream = 2 | https://github.com/purescript/package-sets/releases/download/psc-0.13.6-20200507/packages.dhall sha256:9c1e8951e721b79de1de551f31ecb5a339e82bbd43300eb5ccfb1bf8cf7bbd62 3 | 4 | let overrides = {=} 5 | 6 | let additions = 7 | { colehaus-graphs = 8 | { dependencies = [ "ordered-collections", "catenable-lists" ] 9 | , repo = "https://github.com/colehaus/purescript-graphs" 10 | , version = "v7.0.0" 11 | } 12 | , data-default = 13 | { dependencies = [ "maybe", "record", "psci-support", "lists" ] 14 | , repo = "https://github.com/thought2/purescript-data-default" 15 | , version = "v0.3.2" 16 | } 17 | } 18 | 19 | in upstream // overrides // additions 20 | -------------------------------------------------------------------------------- /src/Data/Class/GraphRep.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Class.GraphRep where 2 | 3 | import Prelude 4 | import Data.Map (Map) 5 | import Data.Tuple (Tuple(..)) 6 | import Lunarbox.Data.Editor.Class.Depends (class Depends, getDependencies) 7 | import Lunarbox.Data.Graph (Graph(..), invert) 8 | 9 | -- Generic typeclass for everything which can be represented as a graph 10 | class GraphRep f k v | f -> k, f -> v where 11 | toGraph :: f -> Graph k v 12 | 13 | instance graphRepDependencyMap :: (Ord k, Depends v k) => GraphRep (Map k v) k v where 14 | toGraph functions = invert $ Graph $ go <$> functions 15 | where 16 | go function = Tuple function $ getDependencies function 17 | 18 | instance graphRepGraph :: GraphRep (Graph k v) k v where 19 | toGraph = identity 20 | -------------------------------------------------------------------------------- /src/Data/ProjectId.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.ProjectId 2 | ( ProjectId(..) 3 | ) where 4 | 5 | import Prelude 6 | import Data.Argonaut (class DecodeJson, class EncodeJson) 7 | import Data.Generic.Rep (class Generic) 8 | import Data.Newtype (class Newtype) 9 | 10 | newtype ProjectId 11 | = ProjectId Int 12 | 13 | derive instance eqProjectId :: Eq ProjectId 14 | 15 | derive instance ordProjectID :: Ord ProjectId 16 | 17 | derive instance newtypeProjectId :: Newtype ProjectId _ 18 | 19 | derive instance genericProjectId :: Generic ProjectId _ 20 | 21 | derive newtype instance encodeJsonProjectId :: EncodeJson ProjectId 22 | 23 | derive newtype instance decodeJsonProjectId :: DecodeJson ProjectId 24 | 25 | derive newtype instance showProjectId :: Show ProjectId 26 | -------------------------------------------------------------------------------- /src/Data/List.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.List 2 | ( chunk 3 | , alterLast 4 | ) where 5 | 6 | import Prelude 7 | import Data.List (List(..), alterAt, drop, take, length, (:)) 8 | import Data.Maybe (Maybe(..), fromMaybe) 9 | 10 | -- Split a List into chunks of a given size 11 | chunk :: forall a. Int -> List a -> List (List a) 12 | chunk _ Nil = Nil 13 | 14 | chunk size list = take size list : chunk size (drop size list) 15 | 16 | -- Helper to apply a function on the last element of a List 17 | -- Accepts a default param in case the list is empty 18 | alterLast :: forall a. a -> (a -> a) -> List a -> List a 19 | alterLast defaultValue mapper = case _ of 20 | Nil -> pure $ mapper defaultValue 21 | list -> fromMaybe list $ alterAt (length list - 1) (Just <<< mapper) list 22 | -------------------------------------------------------------------------------- /.vscode/settings.json: -------------------------------------------------------------------------------- 1 | { 2 | "editor.formatOnSave": true, 3 | "purescript.censorWarnings": [ 4 | "ScopeShadowing" 5 | ], 6 | "cSpell.words": [ 7 | "Roboto", 8 | "dcons", 9 | "downlevel", 10 | "hdom", 11 | "htmlnano", 12 | "hygen", 13 | "lunarbox", 14 | "micromodal", 15 | "microtip", 16 | "monospace", 17 | "neumorphism", 18 | "oxanium", 19 | "prebuild", 20 | "purescript", 21 | "purs", 22 | "purs ts", 23 | "scenegraph", 24 | "scrollbar", 25 | "seedrandom", 26 | "spago", 27 | "textfield", 28 | "ts", 29 | "tslib", 30 | "typeahead", 31 | "unconnectable", 32 | "unmount", 33 | "unselectable", 34 | "width" 35 | ], 36 | "typescript.tsdk": "node_modules/typescript/lib" 37 | } -------------------------------------------------------------------------------- /src/Component/Error.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Error 2 | ( error 3 | ) where 4 | 5 | import Halogen.HTML (HTML) 6 | import Halogen.HTML as HH 7 | import Halogen.HTML.Properties as HP 8 | import Lunarbox.Component.Utils (className) 9 | 10 | -- Illustration for errors 11 | dreamer :: String 12 | dreamer = "https://cdn.discordapp.com/attachments/672889285438865453/708301925510283264/undraw_dreamer_gxxi.png" 13 | 14 | -- A component which shows up when something errored out 15 | error :: forall h a. String -> HTML h a 16 | error text = 17 | HH.div [ className "error-container" ] 18 | [ HH.img 19 | [ HP.src dreamer 20 | , HP.alt "error" 21 | , className "error-illustration" 22 | ] 23 | , HH.div [ className "error-text" ] [ HH.text text ] 24 | ] 25 | -------------------------------------------------------------------------------- /.github/ISSUE_TEMPLATE/bug_report.md: -------------------------------------------------------------------------------- 1 | --- 2 | name: Bug report 3 | about: Create a report to help us improve 4 | title: '' 5 | labels: bug 6 | assignees: Mateiadrielrafael 7 | 8 | --- 9 | 10 | **Describe the bug** 11 | A clear and concise description of what the bug is. 12 | 13 | **To Reproduce** 14 | Steps to reproduce the behavior: 15 | 1. Go to '...' 16 | 2. Click on '....' 17 | 3. Scroll down to '....' 18 | 4. See error 19 | 20 | **Expected behavior** 21 | A clear and concise description of what you expected to happen. 22 | 23 | **Screenshots** 24 | If applicable, add screenshots to help explain your problem. 25 | 26 | **Desktop (please complete the following information):** 27 | - OS: [e.g. iOS] 28 | - Browser [e.g. chrome, safari] 29 | - Version [e.g. 22] 30 | 31 | **Additional context** 32 | Add any other context about the problem here. 33 | -------------------------------------------------------------------------------- /src/typescript/constants.ts: -------------------------------------------------------------------------------- 1 | import { Vec2Like } from "@thi.ng/vectors" 2 | 3 | export const inputLayerOffset = 10 4 | export const nodeRadius = 50 5 | export const arcSpacing = 0.1 6 | export const constantInputStroke = `rgb(176, 112, 107)` 7 | export const nodeBackgroundOpacity = 0.2 8 | 9 | export const connectionWidth = { 10 | normal: 5, 11 | onHover: 10 12 | } 13 | 14 | export const textBgPadding = 10 15 | export const nodeBackgrounds = { 16 | onHover: "#2483bf", 17 | selected: "#29adff" 18 | } 19 | 20 | export const arcStrokeWidth = { 21 | normal: 5, 22 | onHover: 10 23 | } 24 | 25 | export const nodeOutputRadius = { 26 | normal: 10, 27 | onHover: 15 28 | } 29 | 30 | export const pickDistance = { 31 | output: nodeOutputRadius.onHover, 32 | input: 10, 33 | node: nodeRadius 34 | } 35 | 36 | export const font = "normal normal bold 20px 'Roboto Mono', monospace" 37 | export const textPadding: Vec2Like = [5, 5] 38 | -------------------------------------------------------------------------------- /src/Data/Editor/Node/NodeId.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.Node.NodeId where 2 | 3 | import Prelude 4 | import Data.Argonaut (class DecodeJson, class EncodeJson) 5 | import Data.Default (class Default) 6 | import Data.Lens (Lens') 7 | import Data.Newtype (class Newtype, unwrap) 8 | import Lunarbox.Data.Lens (newtypeIso) 9 | 10 | newtype NodeId 11 | = NodeId String 12 | 13 | derive instance eqNodeId :: Eq NodeId 14 | 15 | derive instance ordNodeId :: Ord NodeId 16 | 17 | derive instance newtypeNodeId :: Newtype NodeId _ 18 | 19 | derive newtype instance encodeJsonNodeId :: EncodeJson NodeId 20 | 21 | derive newtype instance decodeJsonNodeId :: DecodeJson NodeId 22 | 23 | derive newtype instance semigroupNodeId :: Semigroup NodeId 24 | 25 | instance defaultNodeId :: Default NodeId where 26 | def = NodeId "" 27 | 28 | instance showNodeId :: Show NodeId where 29 | show = unwrap 30 | 31 | _NodeId :: Lens' NodeId String 32 | _NodeId = newtypeIso 33 | -------------------------------------------------------------------------------- /flake.nix: -------------------------------------------------------------------------------- 1 | { 2 | description = "API for lunarbox"; 3 | 4 | inputs = { 5 | nixpkgs.url = "github:nixos/nixpkgs/release-22.11"; 6 | flake-utils.url = "github:numtide/flake-utils"; 7 | easy-purescript-nix = { 8 | url = "github:justinwoo/easy-purescript-nix"; 9 | flake = false; 10 | }; 11 | }; 12 | 13 | outputs = { self, nixpkgs, flake-utils, easy-purescript-nix }: 14 | flake-utils.lib.eachSystem 15 | (with flake-utils.lib.system; [ x86_64-linux ]) 16 | (system: 17 | let 18 | pkgs = nixpkgs.legacyPackages.${system}; 19 | easy-ps-nix = pkgs.callPackage easy-purescript-nix { }; 20 | in 21 | { 22 | devShell = pkgs.mkShell { 23 | nativeBuildInputs = with pkgs; [ 24 | easy-ps-nix.purs-0_13_6 25 | easy-ps-nix.spago 26 | nodejs 27 | yarn 28 | python3 29 | ]; 30 | }; 31 | }); 32 | } 33 | -------------------------------------------------------------------------------- /src/Data/Editor/FunctionName.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.FunctionName where 2 | 3 | import Prelude 4 | import Data.Argonaut (class DecodeJson, class EncodeJson) 5 | import Data.Default (class Default) 6 | import Data.Lens (Lens') 7 | import Data.Newtype (class Newtype, unwrap) 8 | import Lunarbox.Data.Lens (newtypeIso) 9 | 10 | newtype FunctionName 11 | = FunctionName String 12 | 13 | derive instance eqFunctionName :: Eq FunctionName 14 | 15 | derive instance ordFunctionName :: Ord FunctionName 16 | 17 | derive instance newtypeFunctionName :: Newtype FunctionName _ 18 | 19 | derive newtype instance encodeJsonFunctionName :: EncodeJson FunctionName 20 | 21 | derive newtype instance decodeJsonFunctionName :: DecodeJson FunctionName 22 | 23 | instance defaultFunctionName :: Default FunctionName where 24 | def = FunctionName "" 25 | 26 | instance showFunctionName :: Show FunctionName where 27 | show = unwrap 28 | 29 | _FunctionName :: Lens' FunctionName String 30 | _FunctionName = newtypeIso 31 | -------------------------------------------------------------------------------- /public/styles/pages/editor/edit-node.scss: -------------------------------------------------------------------------------- 1 | @import "../../theme.scss"; 2 | 3 | .edit-node__type { 4 | margin: 1rem; 5 | margin-left: 0; 6 | padding: 0.3rem; 7 | 8 | font-size: 1.2rem; 9 | background: $primary-dark; 10 | } 11 | 12 | .edit-node__description { 13 | width: 100%; 14 | padding: 1em; 15 | 16 | background: $primary-dark; 17 | color: $on-primary; 18 | 19 | border-left: 2px solid $secondary; 20 | } 21 | 22 | .edit-node__inputs { 23 | margin-top: 1em; 24 | padding: 1em; 25 | 26 | background: $primary-dark; 27 | color: $on-primary; 28 | 29 | border-left: 2px solid $secondary; 30 | } 31 | 32 | .edit-node__inputs-header { 33 | margin: 0; 34 | } 35 | 36 | .edit-node__input-name { 37 | outline: none; 38 | cursor: pointer; 39 | } 40 | 41 | .edit-node__input-description { 42 | margin-left: 1rem; 43 | color: darken($color: $on-primary, $amount: 20); 44 | } 45 | 46 | .edit-node__value { 47 | margin-top: 1rem; 48 | display: grid; 49 | grid-template-columns: auto auto; 50 | } 51 | -------------------------------------------------------------------------------- /src/Capability/Resource/User.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Capability.Resource.User 2 | ( class ManageUser 3 | , loginUser 4 | , registerUser 5 | , getCurrentUser 6 | ) where 7 | 8 | import Prelude 9 | import Data.Either (Either) 10 | import Data.Maybe (Maybe) 11 | import Halogen (HalogenM, lift) 12 | import Lunarbox.Api.Request (LoginFields, RegisterFields) 13 | import Lunarbox.Data.Profile (Profile) 14 | 15 | -- This capability represents the ability to manage users in our system. 16 | class 17 | Monad m <= ManageUser m where 18 | loginUser :: LoginFields -> m (Either String Profile) 19 | registerUser :: RegisterFields -> m (Either String Profile) 20 | getCurrentUser :: m (Maybe Profile) 21 | 22 | -- | This instance lets us avoid having to use `lift` when we use these functions in a component. 23 | instance manageUserHalogenM :: ManageUser m => ManageUser (HalogenM st act slots msg m) where 24 | loginUser = lift <<< loginUser 25 | registerUser = lift <<< registerUser 26 | getCurrentUser = lift getCurrentUser 27 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Expression/Optimize.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Expression.Optimize where 2 | 3 | import Prelude 4 | import Data.Array as Array 5 | import Lunarbox.Data.Dataflow.Expression (Expression(..), everywhereOnExpression, mapExpression, references) 6 | 7 | -- | Inline variales only used once an expression 8 | inline :: forall l. Eq l => Expression l -> Expression l 9 | inline = mapExpression go 10 | where 11 | go expr@(Let location name value body) = case references name body of 12 | [ ref ] -> Expression location $ everywhereOnExpression (const true) go' body 13 | where 14 | go' (Variable location' name') 15 | | name' == name && location' == ref = Expression location' value 16 | 17 | go' a = a 18 | _ -> expr 19 | 20 | go expr = expr 21 | 22 | -- | Remove unused stuff 23 | dce :: forall l. Eq l => Expression l -> Expression l 24 | dce = mapExpression go 25 | where 26 | go (Let location name _ body) 27 | | Array.null (references name body) = Expression location body 28 | 29 | go expr = expr 30 | -------------------------------------------------------------------------------- /src/Data/Tab.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Tab where 2 | 3 | import Prelude 4 | import Data.Argonaut (class DecodeJson, class EncodeJson) 5 | import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson) 6 | import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson) 7 | import Data.Generic.Rep (class Generic) 8 | import Data.Generic.Rep.Show (genericShow) 9 | 10 | data Tab 11 | = Settings 12 | | Add 13 | | Tree 14 | | Problems 15 | 16 | derive instance eqTab :: Eq Tab 17 | 18 | derive instance genericTab :: Generic Tab _ 19 | 20 | instance showTab :: Show Tab where 21 | show = genericShow 22 | 23 | instance encodeJsonTab :: EncodeJson Tab where 24 | encodeJson = genericEncodeJson 25 | 26 | instance decodeJsonTab :: DecodeJson Tab where 27 | decodeJson = genericDecodeJson 28 | 29 | -- Return the icon for a Tab 30 | -- I could use a show instance 31 | -- but this is more explicit I think 32 | tabIcon :: Tab -> String 33 | tabIcon = case _ of 34 | Settings -> "settings" 35 | Add -> "add" 36 | Tree -> "account_tree" 37 | Problems -> "error" 38 | -------------------------------------------------------------------------------- /public/styles/components/tabs.scss: -------------------------------------------------------------------------------- 1 | @use "../utils/utils"; 2 | 3 | .tabs { 4 | display: flex; 5 | flex-direction: column; 6 | height: 100%; 7 | } 8 | 9 | .tabs__header { 10 | display: flex; 11 | } 12 | 13 | .tabs__tab { 14 | background: transparent; 15 | color: $on-primary; 16 | padding: 1rem; 17 | 18 | transition: filter $transition-time, border-top-color $transition-time, 19 | background $transition-time; 20 | cursor: pointer; 21 | 22 | outline: none; 23 | border: none; 24 | 25 | border-top-width: 3px; 26 | border-top-style: solid; 27 | border-top-color: transparent; 28 | } 29 | 30 | .tabs__tab:hover:not(.tabs__tab--current) { 31 | background: rgba($primary, 0.5); 32 | filter: brightness(1.1); 33 | } 34 | 35 | // Changing this every time is annoying so I just made a var 36 | $content-bg: lighten($very-dark, 3); 37 | 38 | .tabs__tab--current { 39 | background: $content-bg; 40 | border-top-color: $on-primary; 41 | } 42 | 43 | .tabs__content { 44 | height: 100%; 45 | background: $content-bg; 46 | color: $on-primary; 47 | padding: 1rem; 48 | } 49 | -------------------------------------------------------------------------------- /src/Component/Tooltip.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Tooltip where 2 | 3 | import Prelude 4 | import Halogen.HTML (AttrName(..), IProp, attr) 5 | import Halogen.HTML.Properties.ARIA as HA 6 | 7 | data TooltipPosition 8 | = Top 9 | | TopLeft 10 | | TopRight 11 | | Bottom 12 | | BottomLeft 13 | | BottomRight 14 | | Left 15 | | Right 16 | 17 | instance showTooltipPosition :: Show TooltipPosition where 18 | show Top = "top" 19 | show TopLeft = "top-left" 20 | show TopRight = "top-right" 21 | show Bottom = "bottom" 22 | show BottomLeft = "bottom-left" 23 | show BottomRight = "bottom-right" 24 | show Left = "left" 25 | show Right = "right" 26 | 27 | -- | Wrapper around microtip.css 28 | tooltip :: 29 | forall r i h. 30 | String -> 31 | TooltipPosition -> 32 | (Array (IProp r i) -> h) -> Array (IProp r i) -> h 33 | tooltip text position element extraAttribs = element attribs 34 | where 35 | attribs = 36 | [ HA.role "tooltip" 37 | , HA.label text 38 | , attr (AttrName "data-microtip-position") $ show position 39 | ] 40 | <> extraAttribs 41 | -------------------------------------------------------------------------------- /_templates/purescript/component/main.ejs: -------------------------------------------------------------------------------- 1 | --- 2 | to: src/<%= folder %>/<%= name.replace(/\./g, "/") %>.purs 3 | --- 4 | module Lunarbox.<%= folder %>.<%= name %> (component) where 5 | 6 | import Prelude 7 | import Control.Monad.Reader (class MonadAsk) 8 | import Effect.Class (class MonadEffect) 9 | import Halogen (Component, HalogenM, defaultEval, mkComponent, mkEval) 10 | import Halogen.HTML as HH 11 | import Lunarbox.Config (Config) 12 | 13 | type State 14 | = {} 15 | 16 | data Action 17 | = SomeAction 18 | 19 | type ChildSlots 20 | = () 21 | 22 | type Input = Unit 23 | 24 | component :: forall m q o. MonadEffect m => MonadAsk Config m => Component HH.HTML q Input o m 25 | component = 26 | mkComponent 27 | { initialState: const {} 28 | , render 29 | , eval: 30 | mkEval 31 | $ defaultEval 32 | { handleAction = handleAction 33 | } 34 | } 35 | where 36 | handleAction :: Action -> HalogenM State Action ChildSlots o m Unit 37 | handleAction = case _ of 38 | SomeAction -> pure unit 39 | 40 | render _ = HH.text "unimplemented" 41 | -------------------------------------------------------------------------------- /public/styles/pages/editor/panel.scss: -------------------------------------------------------------------------------- 1 | @import "../../theme.scss"; 2 | 3 | .panel { 4 | height: 100vh; 5 | max-height: 100vh; 6 | 7 | display: flex; 8 | flex-direction: column; 9 | 10 | color: $on-dark; 11 | background: $primary-dark; 12 | 13 | width: 0; 14 | visibility: hidden; 15 | } 16 | 17 | .panel__content { 18 | height: 100%; 19 | flex-grow: 1; 20 | 21 | margin-top: 1rem; 22 | margin-bottom: 1rem; 23 | 24 | overflow-x: hidden; 25 | overflow-y: auto; 26 | } 27 | 28 | .panel__footer { 29 | display: block; 30 | } 31 | 32 | .panel.panel--open { 33 | width: 30rem; 34 | visibility: visible; 35 | overflow: hidden; 36 | } 37 | 38 | .panel__header { 39 | display: flex; 40 | 41 | flex-direction: column; 42 | } 43 | 44 | .panel__title-container { 45 | display: flex; 46 | 47 | justify-content: flex-start; 48 | align-items: center; 49 | } 50 | 51 | .panel__title { 52 | padding: 1rem; 53 | margin: 1rem; 54 | font-size: 2rem; 55 | flex-grow: 1; 56 | } 57 | 58 | .panel__action { 59 | margin: 1rem; 60 | font-size: 2rem; 61 | cursor: pointer; 62 | } 63 | -------------------------------------------------------------------------------- /public/styles/components/dropdown.scss: -------------------------------------------------------------------------------- 1 | @import "../theme.scss"; 2 | 3 | .dropdown { 4 | color: $on-primary; 5 | position: relative; 6 | } 7 | 8 | .dropdown__typeahead-input { 9 | background: $very-dark; 10 | } 11 | 12 | .dropdown__typeahead-input, 13 | .dropdown__trigger-button { 14 | outline: none; 15 | border: none; 16 | width: 100%; 17 | color: inherit; 18 | } 19 | 20 | .dropdown__typeahead-input, 21 | .dropdown__trigger-button { 22 | padding: 0.5rem; 23 | } 24 | 25 | .dropdown .dropdown__trigger-button { 26 | color: inherit; 27 | background: $primary; 28 | box-shadow: 3px 3px 3px 3px $very-dark; 29 | } 30 | 31 | .dropdown.dropdown--is-active .dropdown__menu { 32 | display: flex; 33 | flex-direction: column; 34 | 35 | position: absolute; 36 | background: $primary; 37 | z-index: 10; 38 | 39 | max-height: 300px; 40 | overflow-y: auto; 41 | width: 100%; 42 | } 43 | 44 | .dropdown__item { 45 | padding: 0.5rem; 46 | background: $primary; 47 | 48 | transition: filter $transition-time; 49 | } 50 | 51 | .dropdown__item:hover { 52 | filter: brightness(1.3); 53 | } 54 | -------------------------------------------------------------------------------- /spago.dhall: -------------------------------------------------------------------------------- 1 | { name = "lunarbox" 2 | , dependencies = 3 | [ "aff" 4 | , "aff-bus" 5 | , "aff-promise" 6 | , "affjax" 7 | , "argonaut" 8 | , "argonaut-generic" 9 | , "arrays" 10 | , "colehaus-graphs" 11 | , "colors" 12 | , "console" 13 | , "css" 14 | , "data-default" 15 | , "debug" 16 | , "effect" 17 | , "filterable" 18 | , "fuzzy" 19 | , "generics-rep" 20 | , "halogen" 21 | , "halogen-css" 22 | , "halogen-formless" 23 | , "halogen-hooks" 24 | , "halogen-select" 25 | , "halogen-vdom" 26 | , "html-parser-halogen" 27 | , "lists" 28 | , "math" 29 | , "maybe" 30 | , "memoize" 31 | , "numbers" 32 | , "ordered-collections" 33 | , "profunctor-lenses" 34 | , "proxy" 35 | , "psci-support" 36 | , "random" 37 | , "record" 38 | , "remotedata" 39 | , "routing" 40 | , "routing-duplex" 41 | , "sized-vectors" 42 | , "spec" 43 | , "stringutils" 44 | , "tuples" 45 | , "typelevel" 46 | , "typelevel-prelude" 47 | , "unsafe-coerce" 48 | , "validation" 49 | ] 50 | , packages = ./packages.dhall 51 | , sources = [ "src/**/*.purs", "test/**/*.purs" ] 52 | } 53 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Runtime/ValueMap.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Runtime.ValueMap 2 | ( ValueMap(..) 3 | ) where 4 | 5 | import Prelude 6 | import Data.Argonaut (class DecodeJson, class EncodeJson) 7 | import Data.Default (class Default) 8 | import Data.Map as Map 9 | import Data.Newtype (class Newtype) 10 | import Lunarbox.Data.Dataflow.Runtime.TermEnvironment (Term) 11 | 12 | -- A map holding the runtime values of different locations 13 | newtype ValueMap l 14 | = ValueMap (Map.Map l (Term l)) 15 | 16 | derive instance eqValueMap :: Eq l => Eq (ValueMap l) 17 | 18 | derive instance newtypeValueMap :: Newtype (ValueMap l) _ 19 | 20 | instance semigroupValueMap :: Ord l => Semigroup (ValueMap l) where 21 | append (ValueMap m) (ValueMap m') = ValueMap $ append m m' 22 | 23 | derive newtype instance monoidValueMap :: Ord l => Monoid (ValueMap l) 24 | 25 | derive newtype instance encodeJsonValueMap :: (EncodeJson l, Ord l) => EncodeJson (ValueMap l) 26 | 27 | derive newtype instance decodeJsonValueMap :: (DecodeJson l, Ord l) => DecodeJson (ValueMap l) 28 | 29 | instance defaultValueMap :: Default (ValueMap l) where 30 | def = ValueMap $ Map.empty 31 | -------------------------------------------------------------------------------- /public/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | Lunarbox 5 | 6 | 7 | 8 | 9 | 13 | 14 | 15 | 19 | 20 | 21 | 22 | 23 | 27 | 28 | 29 | 30 | 31 | 32 | 33 | 34 | 35 | 36 | 37 | -------------------------------------------------------------------------------- /src/Component/Switch.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Switch 2 | ( Input 3 | , switchHeight 4 | , switchWidth 5 | , switch 6 | ) where 7 | 8 | import Prelude 9 | import Control.MonadZero (guard) 10 | import Data.Maybe (Maybe) 11 | import Halogen.HTML (ClassName(..), HTML) 12 | import Halogen.HTML as HH 13 | import Halogen.HTML.Events (onChecked) 14 | import Halogen.HTML.Properties as HP 15 | import Lunarbox.Component.Utils (className) 16 | 17 | -- Sizes of the switch. Usefull for using inside a foreidObject 18 | switchHeight :: Number 19 | switchHeight = 28.0 20 | 21 | switchWidth :: Number 22 | switchWidth = 54.0 23 | 24 | type Input 25 | = { checked :: Boolean 26 | , round :: Boolean 27 | } 28 | 29 | -- Simple switch element used for the boolean node 30 | switch :: forall h a. Input -> (Boolean -> Maybe a) -> HTML h a 31 | switch { checked, round } handleCheck = 32 | HH.label [ className "switch" ] 33 | [ HH.input 34 | [ HP.type_ HP.InputCheckbox 35 | , HP.checked checked 36 | , onChecked handleCheck 37 | ] 38 | , HH.span [ HP.classes $ ClassName <$> [ "switch-slider" ] <> ("round" <$ guard round) ] [] 39 | ] 40 | -------------------------------------------------------------------------------- /src/Control/Monad/Dataflow/Solve/SolveConstraintSet.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Control.Monad.Dataflow.Solve.SolveConstraintSet 2 | ( solve 3 | ) where 4 | 5 | import Prelude 6 | import Control.Monad.Reader (local) 7 | import Data.Lens (set) 8 | import Data.List ((:)) 9 | import Lunarbox.Control.Monad.Dataflow.Solve (Solve, _location) 10 | import Lunarbox.Control.Monad.Dataflow.Solve.Unify (unify) 11 | import Lunarbox.Data.Dataflow.Class.Substituable (Substitution, apply) 12 | import Lunarbox.Data.Dataflow.Constraint (Constraint(..), ConstraintSet(..)) 13 | 14 | -- internal version solve which takes an Unifier 15 | solve' :: forall l. Substitution -> ConstraintSet l -> Solve l Substitution 16 | solve' substitution (ConstraintSet ((Constraint { typeLeft, typeRight, source }) : constraints)) = do 17 | substitution' <- local (set _location source) $ unify typeRight typeLeft 18 | solve' (substitution' <> substitution) $ ConstraintSet $ apply substitution' constraints 19 | 20 | solve' substitution _ = pure substitution 21 | 22 | -- This takes some constraints and solves them into a final substitution 23 | solve :: forall l. ConstraintSet l -> Solve l Substitution 24 | solve = solve' mempty 25 | -------------------------------------------------------------------------------- /public/styles/pages/login.scss: -------------------------------------------------------------------------------- 1 | @use "../utils/utils"; 2 | 3 | @import "../theme.scss"; 4 | 5 | #form-page .right { 6 | @include utils.center; 7 | } 8 | 9 | #form-container { 10 | display: flex; 11 | flex-direction: column; 12 | justify-content: space-evenly; 13 | 14 | min-width: 50vw; 15 | max-width: 80vw; 16 | 17 | #title-row { 18 | display: flex; 19 | #title { 20 | color: $on-primary; 21 | font-size: 3rem; 22 | margin-bottom: 1rem; 23 | flex-grow: 1; 24 | } 25 | 26 | #message { 27 | display: flex; 28 | align-items: flex-end; 29 | 30 | font-size: 1.5rem; 31 | height: 3rem; 32 | * { 33 | margin-left: 1rem; 34 | } 35 | 36 | #message-normal { 37 | color: $on-dark-pale; 38 | filter: brightness(0.7); 39 | } 40 | 41 | #message-action { 42 | color: $secondary; 43 | transition: filter $transition-time; 44 | 45 | cursor: pointer; 46 | 47 | &:hover { 48 | filter: brightness(1.4); 49 | } 50 | } 51 | } 52 | } 53 | } 54 | 55 | #form-container { 56 | form fieldset { 57 | border: none; 58 | } 59 | } 60 | -------------------------------------------------------------------------------- /src/Capability/Resource/Tutorial.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Capability.Resource.Tutorial where 2 | 3 | import Prelude 4 | import Data.Either (Either) 5 | import Halogen (HalogenM, lift) 6 | import Lunarbox.Data.ProjectId (ProjectId) 7 | import Lunarbox.Data.Tutorial (Tutorial, TutorialId) 8 | 9 | -- | Capability for managing tutorials 10 | class 11 | Monad m <= ManageTutorials m where 12 | createTutorial :: { base :: ProjectId, solution :: ProjectId } -> m (Either String TutorialId) 13 | deleteTutorial :: TutorialId -> m (Either String Unit) 14 | saveTutorial :: TutorialId -> Tutorial -> m (Either String Unit) 15 | getTutorial :: TutorialId -> m (Either String Tutorial) 16 | completeTutorial :: TutorialId -> m (Either String Unit) 17 | 18 | -- | This instance lets us avoid having to use `lift` when we use these functions in a component. 19 | instance manageTutorialsHalogenM :: ManageTutorials m => ManageTutorials (HalogenM st act slots msg m) where 20 | createTutorial = lift <<< createTutorial 21 | deleteTutorial = lift <<< deleteTutorial 22 | saveTutorial = (lift <<< _) <<< saveTutorial 23 | getTutorial = lift <<< getTutorial 24 | completeTutorial = lift <<< completeTutorial 25 | -------------------------------------------------------------------------------- /public/styles/pages/editor/problems.scss: -------------------------------------------------------------------------------- 1 | @import "../../theme.scss"; 2 | 3 | .problems__empty { 4 | text-align: center; 5 | color: darken($color: $on-primary, $amount: 4); 6 | } 7 | 8 | .problems__container { 9 | display: flex; 10 | flex-direction: column; 11 | } 12 | 13 | .problems__card-header { 14 | display: flex; 15 | justify-content: space-between; 16 | } 17 | 18 | .problems__card-location { 19 | color: #73c0f3; 20 | background: none; 21 | 22 | text-decoration: underline; 23 | text-align: right; 24 | 25 | outline: none; 26 | border: none; 27 | 28 | font-size: 0.8rem; 29 | 30 | transition: filter $transition-time; 31 | 32 | &:hover { 33 | filter: brightness(1.5); 34 | cursor: pointer; 35 | } 36 | } 37 | 38 | .problems__card { 39 | width: 100%; 40 | padding: 1rem; 41 | 42 | display: flex; 43 | flex-direction: column; 44 | } 45 | 46 | .problems__card--error { 47 | background: rgba($error-bg, 0.5); 48 | color: $error-text; 49 | } 50 | 51 | .problems__card--warning { 52 | background: rgba($warning-bg, 0.5); 53 | color: $warning-text; 54 | } 55 | 56 | .problems__card-message { 57 | grid-row-start: 2; 58 | grid-column: 1 / 3; 59 | } 60 | -------------------------------------------------------------------------------- /.github/workflows/release.yml: -------------------------------------------------------------------------------- 1 | name: Build and deploy 🚀 2 | 3 | on: 4 | push: 5 | branches: [master] 6 | jobs: 7 | deploy: 8 | runs-on: ubuntu-latest 9 | 10 | strategy: 11 | matrix: 12 | node-version: [12.x] 13 | 14 | steps: 15 | - uses: actions/checkout@v2 16 | - name: Use Node.js ${{ matrix.node-version }} 17 | uses: actions/setup-node@v1 18 | with: 19 | node-version: ${{ matrix.node-version }} 20 | - name: Get yarn cache directory path 21 | id: yarn-cache-dir-path 22 | run: echo "::set-output name=dir::$(yarn cache dir)" 23 | - uses: actions/cache@v1 24 | id: yarn-cache # use this to check for `cache-hit` (`steps.yarn-cache.outputs.cache-hit != 'true'`) 25 | with: 26 | path: ${{ steps.yarn-cache-dir-path.outputs.dir }} 27 | key: ${{ runner.os }}-yarn-${{ hashFiles('**/yarn.lock') }} 28 | restore-keys: | 29 | ${{ runner.os }}-yarn- 30 | - name: Install dependencies 31 | run: yarn --prefer-offline 32 | - name: Release 33 | env: 34 | GITHUB_TOKEN: ${{ secrets.GITHUB_TOKEN }} 35 | run: yarn semantic-release 36 | -------------------------------------------------------------------------------- /public/styles/components/input.scss: -------------------------------------------------------------------------------- 1 | .form__field.form__field--text { 2 | background: $primary-dark; 3 | color: $on-dark-pale; 4 | 5 | width: 100%; 6 | padding: 1rem; 7 | box-sizing: border-box; 8 | 9 | outline: none; 10 | border: none; 11 | 12 | transition: filter $transition-time; 13 | 14 | &:hover { 15 | filter: brightness(1.3); 16 | } 17 | 18 | &:focus { 19 | filter: brightness(1.5); 20 | } 21 | } 22 | 23 | .form__group { 24 | padding-bottom: 0; 25 | } 26 | 27 | .form__message { 28 | margin: 1rem; 29 | } 30 | 31 | .form__message.form__message--error { 32 | color: $error; 33 | } 34 | 35 | .form__message.form__message--no-error { 36 | color: $secondary; 37 | } 38 | 39 | .submit__container { 40 | display: flex; 41 | justify-content: flex-end; 42 | } 43 | 44 | .submit__form { 45 | background: $primary-dark; 46 | color: $on-primary; 47 | 48 | font-weight: bold; 49 | filter: brightness(1.8); 50 | transition: filter $transition-time; 51 | 52 | padding: 0.8rem; 53 | width: 7rem; 54 | 55 | outline: none; 56 | border: none; 57 | box-shadow: 3px 3px 4px 2px darken($very-dark, 5); 58 | 59 | &:hover { 60 | filter: brightness(2.4); 61 | } 62 | } 63 | -------------------------------------------------------------------------------- /src/Page/FormPage.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Page.FormPage (formPage) where 2 | 3 | import Prelude 4 | import Data.Maybe (Maybe) 5 | import Halogen.HTML (HTML) 6 | import Halogen.HTML as HH 7 | import Halogen.HTML.Events (onClick) 8 | import Halogen.HTML.Properties as HP 9 | import Lunarbox.Component.Utils (container) 10 | import Lunarbox.Component.WithLogo (withLogo) 11 | 12 | type Input h a 13 | = { title :: String 14 | , message :: String 15 | , action :: String 16 | , onAction :: Maybe a 17 | , content :: HTML h a 18 | } 19 | 20 | formPage :: forall h a. Input h a -> HTML h a 21 | formPage { title, content, action, message, onAction } = 22 | container "form-page" 23 | [ withLogo 24 | $ container "form-container" 25 | [ container "title-row" 26 | [ container "title" [ HH.text title ] 27 | , container "message" 28 | [ container "message-normal" [ HH.text message ] 29 | , HH.div 30 | [ HP.id_ "message-action" 31 | , onClick $ const onAction 32 | ] 33 | [ HH.text action ] 34 | ] 35 | ] 36 | , content 37 | ] 38 | ] 39 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Native/Prelude.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Native.Prelude 2 | ( configs 3 | , loadPrelude 4 | ) where 5 | 6 | import Prelude 7 | 8 | import Lunarbox.Data.Dataflow.Native.Array (arrayNodes) 9 | import Lunarbox.Data.Dataflow.Native.ControlFlow (controlFlowNodes) 10 | import Lunarbox.Data.Dataflow.Native.Function (functionNodes) 11 | import Lunarbox.Data.Dataflow.Native.Literal (literalNodes) 12 | import Lunarbox.Data.Dataflow.Native.Logic (logicNodes) 13 | import Lunarbox.Data.Dataflow.Native.Math (mathNodes) 14 | import Lunarbox.Data.Dataflow.Native.NativeConfig (NativeConfig, loadNativeConfigs) 15 | import Lunarbox.Data.Dataflow.Native.Pair (pairNodes) 16 | import Lunarbox.Data.Dataflow.Native.Predicate (predicateNodes) 17 | import Lunarbox.Data.Dataflow.Native.String (stringNodes) 18 | import Lunarbox.Data.Editor.State (State) 19 | 20 | -- Array wita s mll the built in nodes 21 | configs :: Array (NativeConfig) 22 | configs = 23 | mathNodes 24 | <> functionNodes 25 | <> logicNodes 26 | <> stringNodes 27 | <> literalNodes 28 | <> controlFlowNodes 29 | <> arrayNodes 30 | <> predicateNodes 31 | <> pairNodes 32 | 33 | -- Load all the built in nodes 34 | loadPrelude :: State -> State 35 | loadPrelude = loadNativeConfigs configs 36 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Native/NativeConfig.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Native.NativeConfig where 2 | 3 | import Prelude 4 | import Data.Foldable (class Foldable, foldr) 5 | import Data.Lens (set) 6 | import Data.Maybe (Maybe(..)) 7 | import Lunarbox.Data.Dataflow.Expression (NativeExpression) 8 | import Lunarbox.Data.Editor.DataflowFunction (DataflowFunction(..)) 9 | import Lunarbox.Data.Editor.FunctionData (FunctionData) 10 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 11 | import Lunarbox.Data.Editor.State (State, _atFunctionData, _function) 12 | 13 | newtype NativeConfig 14 | = NativeConfig 15 | { functionData :: FunctionData 16 | , expression :: NativeExpression 17 | , name :: FunctionName 18 | } 19 | 20 | loadNativeConfig :: NativeConfig -> State -> State 21 | loadNativeConfig (NativeConfig { functionData, expression, name }) = loadFunction <<< loadFunctionData 22 | where 23 | loadFunction = 24 | set (_function name) 25 | $ Just 26 | $ (NativeFunction expression) 27 | 28 | loadFunctionData = 29 | set (_atFunctionData name) 30 | $ Just 31 | $ functionData 32 | 33 | -- I'm pretty proud of this one lol 34 | loadNativeConfigs :: forall f. Foldable f => f NativeConfig -> State -> State 35 | loadNativeConfigs = flip $ foldr loadNativeConfig 36 | -------------------------------------------------------------------------------- /public/styles/pages/editTutorial.scss: -------------------------------------------------------------------------------- 1 | @use "../utils/utils"; 2 | @import "../theme.scss"; 3 | 4 | .tutorial-editor { 5 | @include utils.center; 6 | 7 | background: $very-dark; 8 | height: 100%; 9 | } 10 | 11 | .tutorial-editor__main { 12 | background: $primary-dark; 13 | border-top: 3px solid $secondary; 14 | 15 | padding: 2rem; 16 | box-shadow: 4px 0 5px 3px black; 17 | 18 | height: 100%; 19 | width: 800px; 20 | } 21 | 22 | .tutorial-editor__title { 23 | margin-right: auto; 24 | } 25 | 26 | .tutorial-editor__header { 27 | display: flex; 28 | align-items: center; 29 | color: $on-primary; 30 | } 31 | 32 | .tutorial-editor__header-icon { 33 | cursor: pointer; 34 | 35 | outline: none; 36 | border: none; 37 | 38 | color: inherit; 39 | background: none; 40 | 41 | transition: filter $transition-time, transform $transition-time; 42 | filter: brightness(0.8); 43 | } 44 | 45 | .tutorial-editor__header-icon:hover { 46 | filter: brightness(1.3); 47 | transform: scale(1.2); 48 | } 49 | 50 | .tutorial-editor .form__field.form__field--text { 51 | background: $very-dark; 52 | 53 | box-shadow: 4px 4px 4px 2px rgba(darken($very-dark, 7), 0.6); 54 | } 55 | 56 | @media only screen and (max-width: 1200px) { 57 | .tutorial-editor__main { 58 | width: 100vw; 59 | } 60 | } 61 | -------------------------------------------------------------------------------- /.github/workflows/test.yml: -------------------------------------------------------------------------------- 1 | name: Test ⛳ 2 | 3 | on: 4 | push: 5 | branches: [develop] 6 | pull_request: 7 | branches: [develop, master] 8 | 9 | jobs: 10 | test: 11 | runs-on: ubuntu-latest 12 | 13 | strategy: 14 | matrix: 15 | node-version: [12.x] 16 | 17 | steps: 18 | - uses: actions/checkout@v2 19 | - name: Use Node.js ${{ matrix.node-version }} 20 | uses: actions/setup-node@v1 21 | with: 22 | node-version: ${{ matrix.node-version }} 23 | 24 | - name: Get yarn cache directory path 25 | id: yarn-cache-dir-path 26 | run: echo "::set-output name=dir::$(yarn cache dir)" 27 | 28 | - uses: actions/cache@v1 29 | id: yarn-cache # use this to check for `cache-hit` (`steps.yarn-cache.outputs.cache-hit != 'true'`) 30 | with: 31 | path: ${{ steps.yarn-cache-dir-path.outputs.dir }} 32 | key: ${{ runner.os }}-yarn-${{ hashFiles('**/yarn.lock') }} 33 | restore-keys: | 34 | ${{ runner.os }}-yarn- 35 | - name: Install dependencies 36 | run: yarn --prefer-offline 37 | - name: Install purescript 38 | run: yarn global add purescript spago 39 | - name: Build project 40 | run: yarn build 41 | - name: Test project 42 | run: yarn test 43 | -------------------------------------------------------------------------------- /public/styles/components/switch.scss: -------------------------------------------------------------------------------- 1 | @import "../theme.scss"; 2 | 3 | $border-width: 2px; 4 | $spacing: 4px; 5 | $switch-height: 28px; 6 | $switch-width: 54px; 7 | $handler-size: $switch-height - 2 * ($spacing + $border-width); 8 | 9 | .switch { 10 | position: relative; 11 | display: inline-block; 12 | width: $switch-width; 13 | height: $switch-height; 14 | 15 | input { 16 | opacity: 0; 17 | width: 0; 18 | height: 0; 19 | } 20 | } 21 | 22 | .switch-slider { 23 | position: absolute; 24 | cursor: pointer; 25 | top: 0; 26 | left: 0; 27 | right: 0; 28 | bottom: 0; 29 | border: $border-width solid $on-primary; 30 | transition: $transition-time; 31 | 32 | &:before { 33 | position: absolute; 34 | content: ""; 35 | height: $handler-size; 36 | width: $handler-size; 37 | left: $spacing; 38 | bottom: $spacing; 39 | background-color: $on-primary; 40 | transition: $transition-time; 41 | } 42 | } 43 | 44 | input:checked + .switch-slider { 45 | border-color: $secondary; 46 | } 47 | 48 | input:focus + .switch-slider { 49 | box-shadow: 0 0 1px $secondary; 50 | } 51 | 52 | input:checked + .switch-slider:before { 53 | transform: translateX(26px); 54 | 55 | background-color: $secondary; 56 | } 57 | 58 | /* Rounded sliders */ 59 | .switch-slider.round { 60 | border-radius: $switch-height; 61 | 62 | &:before { 63 | border-radius: 50%; 64 | } 65 | } 66 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Native/Literal.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Native.Literal 2 | ( literalNodes 3 | , boolean 4 | , number 5 | , string 6 | ) where 7 | 8 | import Lunarbox.Data.Dataflow.Native.NativeConfig (NativeConfig(..)) 9 | import Lunarbox.Data.Dataflow.Runtime.Class.Describable (toNativeExpression) 10 | import Lunarbox.Data.Editor.FunctionData (internal) 11 | import Lunarbox.Data.Editor.FunctionName (FunctionName(..)) 12 | 13 | -- All the native literal nodes 14 | literalNodes :: Array (NativeConfig) 15 | literalNodes = [ boolean, number, string ] 16 | 17 | boolean :: NativeConfig 18 | boolean = 19 | NativeConfig 20 | { name: FunctionName "boolean" 21 | , expression: toNativeExpression false 22 | , functionData: internal [] { name: "Boolean", description: "A boolean which has the same value as the visual switch" } 23 | } 24 | 25 | number :: NativeConfig 26 | number = 27 | NativeConfig 28 | { name: FunctionName "number" 29 | , expression: toNativeExpression 0 30 | , functionData: internal [] { name: "Number", description: "A number which has the same value as the input box" } 31 | } 32 | 33 | string :: NativeConfig 34 | string = 35 | NativeConfig 36 | { name: FunctionName "string" 37 | , expression: toNativeExpression "lunarbox" 38 | , functionData: internal [] { name: "String", description: "A string which has the same value as the input textbox" } 39 | } 40 | -------------------------------------------------------------------------------- /src/Capability/Resource/Project.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Capability.Resource.Project 2 | ( class ManageProjects 3 | , getProjects 4 | , getProject 5 | , createProject 6 | , saveProject 7 | , deleteProject 8 | , cloneProject 9 | ) where 10 | 11 | import Prelude 12 | import Data.Argonaut (Json) 13 | import Data.Either (Either) 14 | import Halogen (HalogenM, lift) 15 | import Lunarbox.Data.Editor.State (State) 16 | import Lunarbox.Data.ProjectId (ProjectId) 17 | import Lunarbox.Data.ProjectList (ProjectList) 18 | 19 | -- | Capability for managing projects 20 | class 21 | Monad m <= ManageProjects m where 22 | getProjects :: m (Either String ProjectList) 23 | getProject :: ProjectId -> m (Either String State) 24 | createProject :: State -> m (Either String ProjectId) 25 | saveProject :: ProjectId -> Json -> m (Either String Unit) 26 | deleteProject :: ProjectId -> m (Either String Unit) 27 | cloneProject :: ProjectId -> m (Either String ProjectId) 28 | 29 | -- | This instance lets us avoid having to use `lift` when we use these functions in a component. 30 | instance manageUserHalogenM :: ManageProjects m => ManageProjects (HalogenM st act slots msg m) where 31 | getProjects = lift getProjects 32 | getProject = lift <<< getProject 33 | createProject = lift <<< createProject 34 | deleteProject = lift <<< deleteProject 35 | cloneProject = lift <<< cloneProject 36 | saveProject = (lift <<< _) <<< saveProject 37 | -------------------------------------------------------------------------------- /src/Data/ProjectList.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.ProjectList 2 | ( ProjectData 3 | , ProjectList 4 | , ProjectOverview 5 | , TutorialOverview 6 | , _userProjects 7 | , _exampleProjects 8 | ) where 9 | 10 | import Data.Lens (Lens') 11 | import Data.Lens.Record (prop) 12 | import Data.Symbol (SProxy(..)) 13 | import Lunarbox.Data.ProjectId (ProjectId) 14 | import Lunarbox.Data.Tutorial (TutorialId) 15 | 16 | type ProjectData r 17 | = ( name :: String 18 | , metadata :: 19 | { functionCount :: Int 20 | , nodeCount :: Int 21 | } 22 | | r 23 | ) 24 | 25 | -- | Data needed to render the projects in the list 26 | type ProjectOverview 27 | = ProjectData ( id :: ProjectId ) 28 | 29 | -- | Data needed to render the tutorial in the list 30 | type TutorialOverview 31 | = { name :: String 32 | , id :: TutorialId 33 | , completed :: Boolean 34 | , own :: Boolean 35 | } 36 | 37 | -- | Stuff we get from the server to render on the projects page 38 | type ProjectList 39 | = { exampleProjects :: Array { | ProjectOverview } 40 | , userProjects :: Array { | ProjectOverview } 41 | , tutorials :: Array TutorialOverview 42 | } 43 | 44 | -- Lenses 45 | _exampleProjects :: Lens' ProjectList (Array { | ProjectOverview }) 46 | _exampleProjects = prop (SProxy :: _ "exampleProjects") 47 | 48 | _userProjects :: Lens' ProjectList (Array { | ProjectOverview }) 49 | _userProjects = prop (SProxy :: _ "userProjects") 50 | -------------------------------------------------------------------------------- /public/styles/pages/editor/tree.scss: -------------------------------------------------------------------------------- 1 | @import "../../theme.scss"; 2 | 3 | .explorer { 4 | display: flex; 5 | flex-direction: column; 6 | 7 | overflow-x: hidden; 8 | overflow-y: auto; 9 | width: 100%; 10 | height: 80vh; 11 | max-height: 100%; 12 | } 13 | 14 | .explorer__function, 15 | .explorer__input-container { 16 | display: flex; 17 | align-items: center; 18 | 19 | font-size: 1.5rem; 20 | height: 2.5rem; 21 | 22 | padding-left: 1rem; 23 | background: $primary-dark; 24 | 25 | cursor: pointer; 26 | user-select: none; 27 | 28 | transition: filter $transition-time; 29 | } 30 | 31 | .explorer__function:hover { 32 | filter: brightness(1.2); 33 | } 34 | 35 | .explorer__function.explorer__function--selected { 36 | filter: brightness(1.4); 37 | } 38 | 39 | .explorer__function { 40 | padding-top: 0.5rem; 41 | padding-bottom: 0.5rem; 42 | } 43 | 44 | .explorer__function .material-icons, 45 | .explorer__input-container .material-icons { 46 | margin-right: 1.5rem; 47 | } 48 | 49 | .explorer__input-container .material-icons { 50 | margin-right: 1rem; 51 | } 52 | 53 | .explorer .tooltip__content { 54 | background-color: #912f3f; 55 | color: #fff; 56 | 57 | font-size: 1rem; 58 | } 59 | 60 | .explorer__input { 61 | background: $dark-input-bg; 62 | color: white; 63 | 64 | border: none; 65 | outline: none; 66 | 67 | height: 2.5rem; 68 | width: 100%; 69 | display: block; 70 | 71 | padding-left: 0.5rem; 72 | } 73 | -------------------------------------------------------------------------------- /src/Data/TutorialConfig.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.TutorialConfig where 2 | 3 | import Prelude 4 | import Data.Argonaut (decodeJson, jsonParser) 5 | import Data.Either (Either(..), note) 6 | import Data.Map as Map 7 | import Data.Maybe (Maybe) 8 | import Data.Traversable (for) 9 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 10 | import Lunarbox.Data.Gist (Gist(..), GistFiles(..)) 11 | 12 | -- | A step will be displayed as a modal in the editor while doing the tutorial 13 | type TutorialStep 14 | = { title :: String 15 | , content :: String 16 | } 17 | 18 | -- | Config made by an admin about what steps a tutorial has 19 | type TutorialConfig 20 | = { steps :: Array TutorialStep 21 | , allowedNodes :: Maybe (Array FunctionName) 22 | } 23 | 24 | -- | Basically grouped step data together from the github gist config 25 | type TutorialSteps 26 | = { config :: TutorialConfig 27 | , steps :: Array TutorialStep 28 | } 29 | 30 | -- | Get the tutorial steps from a github gist 31 | getTutorialSteps :: Gist -> Either String TutorialSteps 32 | getTutorialSteps (Gist { files: GistFiles files }) = do 33 | file <- note "Missing main.json file!" $ Map.lookup "main.json" files 34 | config :: TutorialConfig <- decodeJson =<< jsonParser file.content 35 | steps <- 36 | for config.steps \{ content, title } -> do 37 | slide <- note ("Missing slide: " <> content) $ Map.lookup content files 38 | pure 39 | { content: slide.content 40 | , title 41 | } 42 | Right { config, steps } 43 | -------------------------------------------------------------------------------- /src/Data/Editor/Node/NodeDescriptor.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.Node.NodeDescriptor 2 | ( describe 3 | , onlyEditable 4 | , NodeDescriptor 5 | ) where 6 | 7 | import Prelude 8 | import Data.Lens (is) 9 | import Data.Map (Map) 10 | import Data.Map as Map 11 | import Data.Maybe (Maybe(..)) 12 | import Lunarbox.Data.Class.GraphRep (toGraph) 13 | import Lunarbox.Data.Editor.DataflowFunction (_VisualFunction) 14 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 15 | import Lunarbox.Data.Editor.Project (Project(..)) 16 | import Lunarbox.Data.Graph as G 17 | 18 | type NodeDescriptor 19 | = { isUsable :: Boolean 20 | , isEditable :: Boolean 21 | , canBeDeleted :: Boolean 22 | } 23 | 24 | describe :: FunctionName -> Project -> Map FunctionName NodeDescriptor 25 | describe currentFunction project@(Project { functions, main }) = 26 | flip (Map.mapMaybeWithKey) functions \name function -> 27 | let 28 | isCurrent = currentFunction == name 29 | 30 | -- TODO: make this actually check the NodeData 31 | isExternal = false 32 | 33 | isVisual = is _VisualFunction function 34 | 35 | isEditable = 36 | not isCurrent 37 | && not isExternal 38 | && isVisual 39 | 40 | wouldCycle = G.wouldCreateLongCycle name currentFunction $ toGraph project 41 | 42 | isUsable = isCurrent || not wouldCycle 43 | 44 | canBeDeleted = isVisual && main /= name 45 | in 46 | Just { isUsable, isEditable, canBeDeleted } 47 | 48 | onlyEditable :: FunctionName -> Project -> Map FunctionName NodeDescriptor 49 | onlyEditable c p = Map.filter _.isEditable $ describe c p 50 | -------------------------------------------------------------------------------- /src/typescript/preview.ts: -------------------------------------------------------------------------------- 1 | import { NodeState } from "./types/Node" 2 | import { CanvasElement } from "./types/Hiccup" 3 | import { nodeOutputRadius, nodeRadius, arcStrokeWidth } from "./constants" 4 | import { dottedInput } from "./render" 5 | import { draw } from "@thi.ng/hiccup-canvas" 6 | 7 | /** 8 | * Draw the preview of a node. 9 | * 10 | * @param ctx The ctx to draw to. 11 | * @param colorMap The colors to use for the node. 12 | */ 13 | export const renderPreview = (ctx: CanvasRenderingContext2D) => ( 14 | colorMap: Required 15 | ) => () => { 16 | const { width, height } = ctx.canvas 17 | 18 | const shapes: Array = [ 19 | ["circle", { fill: colorMap.output }, [0, 0], nodeOutputRadius.normal] 20 | ] 21 | 22 | if (colorMap.inputs.length) { 23 | const inputLength = (2 * Math.PI) / colorMap.inputs.length 24 | 25 | for (let index = 0; index < colorMap.inputs.length; index++) { 26 | const stroke = colorMap.inputs[index] 27 | const start = index * inputLength 28 | 29 | shapes.push([ 30 | "arc", 31 | { weight: arcStrokeWidth.normal, stroke }, 32 | [0, 0], 33 | nodeRadius, 34 | start, 35 | start + inputLength 36 | ]) 37 | } 38 | } else { 39 | shapes.push(dottedInput([0, 0]).toHiccup()) 40 | } 41 | 42 | const requiredSize = nodeRadius * 2 + 10 43 | 44 | ctx.clearRect(0, 0, width, height) 45 | 46 | ctx.save() 47 | ctx.translate(width / 2, height / 2) 48 | 49 | ctx.scale(width / requiredSize, height / requiredSize) 50 | 51 | draw(ctx, shapes) 52 | 53 | ctx.restore() 54 | } 55 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Runtime/Class/Typeable.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Runtime.Class.Typeable where 2 | 3 | import Prelude 4 | 5 | import Data.Symbol (class IsSymbol, SProxy(..), reflectSymbol) 6 | import Data.Tuple (Tuple) 7 | import Lunarbox.Data.Dataflow.Type (TVarName(..), Type(..), typeArray, typeBool, typeFunction, typeNumber, typePair, typeString) 8 | import Type.Proxy (Proxy(..)) 9 | 10 | class Typeable (a :: Type) where 11 | typeof :: Proxy a -> Type 12 | 13 | instance typeableNumber :: Typeable Number where 14 | typeof _ = typeNumber 15 | 16 | instance typeableInt :: Typeable Int where 17 | typeof _ = typeNumber 18 | 19 | instance typeableString :: Typeable String where 20 | typeof _ = typeString 21 | 22 | instance typeableBool :: Typeable Boolean where 23 | typeof _ = typeBool 24 | 25 | instance typeableArray :: Typeable a => Typeable (Array a) where 26 | typeof _ = typeArray (typeof (Proxy :: Proxy a)) 27 | 28 | instance typePair :: (Typeable a, Typeable b) => Typeable (Tuple a b) where 29 | typeof _ = typePair (typeof _a) (typeof _b) 30 | where 31 | _a :: Proxy a 32 | _a = Proxy 33 | 34 | _b :: Proxy b 35 | _b = Proxy 36 | 37 | instance typeableSymbol :: IsSymbol sym => Typeable (SProxy sym) where 38 | typeof _ = TVariable true $ TVarName $ reflectSymbol (SProxy :: SProxy sym) 39 | 40 | instance typeableArrow :: (Typeable a, Typeable b) => Typeable (a -> b) where 41 | typeof _ = typeFunction (typeof (Proxy :: Proxy a)) (typeof (Proxy :: Proxy b)) 42 | 43 | -- | Get the type of a purescript value 44 | getType :: forall a. Typeable a => a -> Type 45 | getType _ = typeof (Proxy :: Proxy a) 46 | -------------------------------------------------------------------------------- /src/Component/Tabs.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Tabs where 2 | 3 | import Prelude 4 | import Control.MonadZero (guard) 5 | import Data.Foldable (find) 6 | import Data.Maybe (Maybe, maybe) 7 | import Halogen.HTML as HH 8 | import Halogen.HTML.Events (onClick) 9 | import Halogen.HTML.Properties as HP 10 | import Lunarbox.Component.Utils (className, maybeElement) 11 | 12 | type Input h a t 13 | = { tabs :: 14 | Array 15 | { name :: t 16 | , content :: h 17 | } 18 | , currentTab :: t 19 | , headerStart :: Maybe h 20 | , headerEnd :: Maybe h 21 | , setTab :: t -> Maybe a 22 | } 23 | 24 | -- | Standard reusable tabs component. The state needs to be handled outside this. 25 | component :: forall h a t. Show t => Eq t => Input (HH.HTML h a) a t -> HH.HTML h a 26 | component { tabs, currentTab, headerStart, headerEnd, setTab } = 27 | HH.div [ className "tabs" ] 28 | [ HH.header [ className "tabs__header" ] header 29 | , HH.main [ className "tabs__content" ] [ maybeElement maybeContent \{ content } -> content ] 30 | ] 31 | where 32 | tabHtml { name } = 33 | HH.button 34 | [ HP.classes $ HH.ClassName <$> classes 35 | , onClick $ const $ setTab name 36 | ] 37 | [ HH.text (show name) ] 38 | where 39 | classes = [ "tabs__tab" ] <> currentTabClass 40 | 41 | currentTabClass = "tabs__tab--current" <$ guard (name == currentTab) 42 | 43 | header = start <> (tabHtml <$> tabs) <> end 44 | where 45 | mkPiece = maybe [] pure 46 | 47 | start = mkPiece headerStart 48 | 49 | end = mkPiece headerEnd 50 | 51 | maybeContent = find (\{ name } -> name == currentTab) tabs 52 | -------------------------------------------------------------------------------- /public/styles/pages/editor.scss: -------------------------------------------------------------------------------- 1 | @use "../utils/utils"; 2 | @use "../fonts"; 3 | 4 | @import "../theme.scss"; 5 | 6 | // Sub components and stuff 7 | @import "./editor/scene.scss"; 8 | @import "./editor/panel.scss"; 9 | @import "./editor/settings.scss"; 10 | @import "./editor/tree.scss"; 11 | @import "./editor/add.scss"; 12 | @import "./editor/problems.scss"; 13 | @import "./editor/edit-node.scss"; 14 | 15 | $icon-font-size: 2rem; 16 | 17 | .editor { 18 | display: flex; 19 | height: 100vh; 20 | overflow-y: hidden; 21 | } 22 | 23 | .editor__activity-bar { 24 | @include utils.center; 25 | 26 | justify-content: start; 27 | 28 | background: $very-dark; 29 | } 30 | 31 | .editor__logo { 32 | width: $icon-font-size; 33 | 34 | margin: auto; 35 | margin-bottom: 1rem; 36 | } 37 | 38 | .editor__activity { 39 | @include utils.center; 40 | 41 | padding: 1rem; 42 | user-select: none; 43 | 44 | cursor: pointer; 45 | 46 | color: $disabled; 47 | filter: brightness(0.7); 48 | 49 | margin-bottom: 1rem; 50 | 51 | transition: filter $transition-time, color $transition-time, 52 | border-left $transition-time; 53 | } 54 | 55 | .editor__activity--warning { 56 | color: $warning-text; 57 | } 58 | 59 | .editor__activity--error { 60 | color: $error-text; 61 | } 62 | 63 | .editor__activity:hover, 64 | .editor__activity.editor__activity--active { 65 | filter: none; 66 | 67 | &:not(.editor__activity--warning):not(.editor__activity--error) { 68 | color: $on-dark; 69 | } 70 | } 71 | 72 | .editor__activity .material-icons { 73 | font-size: $icon-font-size; 74 | } 75 | 76 | .editor__activity--active { 77 | border-left: 0.2rem solid $on-dark; 78 | } 79 | -------------------------------------------------------------------------------- /src/Data/Gist.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Gist where 2 | 3 | import Prelude 4 | import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson) 5 | import Data.Default (class Default) 6 | import Data.Map (Map) 7 | import Data.Map as Map 8 | import Data.Newtype (class Newtype) 9 | import Foreign.Object (Object) 10 | 11 | -- | Data about a particular file in a gist 12 | type GistFile 13 | = { filename :: String 14 | , type :: String 15 | , language :: String 16 | , size :: Int 17 | , truncated :: Boolean 18 | , content :: String 19 | , raw_url :: String 20 | } 21 | 22 | -- | I made a separate newtype so I can deocde this properly 23 | newtype GistFiles 24 | = GistFiles (Map String GistFile) 25 | 26 | instance decodeJsonGistFiles :: DecodeJson GistFiles where 27 | decodeJson json = do 28 | obj :: Object GistFile <- decodeJson json 29 | pure $ GistFiles $ Map.fromFoldableWithIndex obj 30 | 31 | newtype Gist 32 | = Gist 33 | { url :: String 34 | , id :: GistId 35 | , public :: Boolean 36 | , description :: String 37 | , files :: GistFiles 38 | } 39 | 40 | derive newtype instance decodeJsonGist :: DecodeJson Gist 41 | 42 | -- | Id we can use to retrive a particular gist 43 | newtype GistId 44 | = GistId String 45 | 46 | instance showGistId :: Show GistId where 47 | show (GistId a) = a 48 | 49 | derive instance newtypeGistId :: Newtype GistId _ 50 | 51 | derive instance eqGistId :: Eq GistId 52 | 53 | derive newtype instance decodeJsonGistId :: DecodeJson GistId 54 | 55 | derive newtype instance encodeJsonGistId :: EncodeJson GistId 56 | 57 | instance defaultGistId :: Default GistId where 58 | def = GistId "d1e270048b1f276438ee31ca345862aa" 59 | -------------------------------------------------------------------------------- /src/Component/Clone.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Clone (component) where 2 | 3 | import Prelude 4 | import Data.Either (Either(..)) 5 | import Data.Maybe (Maybe(..)) 6 | import Halogen (Component, HalogenM, defaultEval, gets, mkComponent, mkEval, modify_) 7 | import Halogen.HTML as HH 8 | import Lunarbox.Capability.Navigate (class Navigate, navigate) 9 | import Lunarbox.Capability.Resource.Project (class ManageProjects, cloneProject) 10 | import Lunarbox.Component.Error (error) 11 | import Lunarbox.Component.Loading (loading) 12 | import Lunarbox.Data.ProjectId (ProjectId) 13 | import Lunarbox.Data.Route (Route(..)) 14 | import Network.RemoteData (RemoteData(..)) 15 | import Record as Record 16 | 17 | data Action 18 | = Init 19 | 20 | type Input r 21 | = ( targetId :: ProjectId | r ) 22 | 23 | type State 24 | = { | Input ( newId :: RemoteData String ProjectId ) } 25 | 26 | component :: forall m q o. ManageProjects m => Navigate m => Component HH.HTML q { | Input () } o m 27 | component = 28 | mkComponent 29 | { initialState: Record.merge { newId: NotAsked } 30 | , render 31 | , eval: 32 | mkEval 33 | $ defaultEval 34 | { handleAction = handleAction 35 | , initialize = Just Init 36 | } 37 | } 38 | where 39 | handleAction :: Action -> HalogenM State Action () o m Unit 40 | handleAction = case _ of 41 | Init -> do 42 | targetId <- gets _.targetId 43 | response <- cloneProject targetId 44 | case response of 45 | Left message -> modify_ _ { newId = Failure message } 46 | Right newId -> navigate $ Project newId 47 | 48 | render { newId } = case newId of 49 | Failure message -> error message 50 | _ -> loading 51 | -------------------------------------------------------------------------------- /src/Component/Editor/NodeUiManager.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Editor.NodeUiManager 2 | ( Query(..) 3 | , Output(..) 4 | , component 5 | ) where 6 | 7 | import Prelude 8 | import Data.Maybe (Maybe(..)) 9 | import Halogen (Component, HalogenM, defaultEval, get, mkComponent, mkEval, modify_, raise) 10 | import Halogen.HTML as HH 11 | import Lunarbox.Component.Editor.NodeUi (runNodeUi, uiToRuntime) 12 | import Lunarbox.Data.Dataflow.Runtime (RuntimeValue) 13 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 14 | 15 | type State 16 | = { | Input () } 17 | 18 | data Action 19 | = SetValue RuntimeValue 20 | 21 | type ChildSlots 22 | = () 23 | 24 | type Input r 25 | = ( name :: FunctionName, value :: RuntimeValue | r ) 26 | 27 | data Query a 28 | = GetValue (RuntimeValue -> a) 29 | 30 | newtype Output 31 | = NewValue RuntimeValue 32 | 33 | component :: forall m. Component HH.HTML Query { | Input () } Output m 34 | component = 35 | mkComponent 36 | { initialState: identity 37 | , render 38 | , eval: 39 | mkEval 40 | $ defaultEval 41 | { handleAction = handleAction 42 | , handleQuery = handleQuery 43 | } 44 | } 45 | where 46 | handleAction :: Action -> HalogenM State Action ChildSlots Output m Unit 47 | handleAction = case _ of 48 | SetValue val -> do 49 | modify_ _ { value = val } 50 | raise $ NewValue val 51 | 52 | handleQuery :: forall a. Query a -> HalogenM State Action ChildSlots Output m (Maybe a) 53 | handleQuery = case _ of 54 | GetValue return -> get <#> \{ name, value } -> return <$> uiToRuntime name value 55 | 56 | render { name, value } = 57 | runNodeUi 58 | { value, setValue: Just <<< SetValue 59 | } 60 | name 61 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "version": "0.0.0-development", 3 | "scripts": { 4 | "build:purescript": "spago build -x", 5 | "dev": "parcel public/index.html --port 8080", 6 | "prebuild": "rm -rf dist", 7 | "build": "spago build -x && parcel build public/index.html && cp _redirects dist", 8 | "test": "spago test" 9 | }, 10 | "dependencies": { 11 | "@thi.ng/api": "^6.11.3", 12 | "@thi.ng/color": "^1.2.4", 13 | "@thi.ng/dcons": "^2.2.20", 14 | "@thi.ng/geom": "^1.9.7", 15 | "@thi.ng/geom-api": "^1.0.20", 16 | "@thi.ng/hdom-canvas": "^3.0.11", 17 | "@thi.ng/hiccup-canvas": "^1.0.3", 18 | "@thi.ng/math": "^1.7.10", 19 | "@thi.ng/matrices": "^0.6.18", 20 | "@thi.ng/transducers": "^7.0.0", 21 | "@thi.ng/vectors": "^4.4.3", 22 | "marked": "^1.1.1", 23 | "micromodal": "^0.4.6", 24 | "microtip": "^0.2.2", 25 | "normalize.css": "^8.0.1", 26 | "seedrandom": "^3.0.5", 27 | "ts-adt": "^1.0.1", 28 | "tslib": "^1.13.0" 29 | }, 30 | "devDependencies": { 31 | "@semantic-release/changelog": "^5.0.1", 32 | "@semantic-release/git": "^9.0.0", 33 | "@types/micromodal": "^0.3.1", 34 | "@types/seedrandom": "^2.4.28", 35 | "@types/webpack-env": "^1.15.2", 36 | "all-contributors-cli": "^6.15.0", 37 | "cssnano": "^4.1.10", 38 | "htmlnano": "^0.2.5", 39 | "hygen": "^5.0.3", 40 | "nodemon": "^2.0.4", 41 | "parcel-bundler": "^1.12.4", 42 | "sass": "^1.26.11", 43 | "semantic-release": "^17.0.8", 44 | "terser": "^4.7.0", 45 | "typescript": "^3.9.7" 46 | }, 47 | "license": "GPL-3.0", 48 | "repository": { 49 | "type": "git", 50 | "url": "https://github.com/Mateiadrielrafael/lunarbox.git" 51 | }, 52 | "alias": { 53 | "src": "./src" 54 | } 55 | } 56 | -------------------------------------------------------------------------------- /src/Api/Endpoint.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Api.Endpoint 2 | ( Endpoint(..) 3 | , endpointCodec 4 | ) where 5 | 6 | import Prelude 7 | import Data.Generic.Rep (class Generic) 8 | import Data.Generic.Rep.Show (genericShow) 9 | import Lunarbox.Data.ProjectId (ProjectId) 10 | import Lunarbox.Data.Route (projectId, tutorialId) 11 | import Lunarbox.Data.Tutorial (TutorialId) 12 | import Routing.Duplex (RouteDuplex', prefix, root, segment) 13 | import Routing.Duplex.Generic (noArgs, sum) 14 | import Routing.Duplex.Generic.Syntax ((/)) 15 | 16 | -- Possible endpoints we can hit 17 | data Endpoint 18 | = Login 19 | | Logout 20 | | Profile 21 | | Register 22 | | Projects 23 | | Project ProjectId 24 | | Clone ProjectId 25 | | Tutorial TutorialId 26 | | CompleteTutorial TutorialId 27 | | Tutorials 28 | 29 | derive instance eqEndpoint :: Eq Endpoint 30 | 31 | derive instance ordEndpoint :: Ord Endpoint 32 | 33 | derive instance genericEndpoint :: Generic Endpoint _ 34 | 35 | instance showEndpoint :: Show Endpoint where 36 | show = genericShow 37 | 38 | -- This is here so we get compile time errors when we don't handle a route 39 | endpointCodec :: RouteDuplex' Endpoint 40 | endpointCodec = 41 | root $ prefix "api" 42 | $ sum 43 | { "Login": "auth" / "login" / noArgs 44 | , "Register": "users" / noArgs 45 | , "Logout": "auth" / "logout" / noArgs 46 | , "Profile": "users" / noArgs 47 | , "Projects": "projects" / noArgs 48 | , "Project": "projects" / projectId segment 49 | , "Clone": "projects" / "clone" / projectId segment 50 | , "Tutorial": "tutorials" / tutorialId segment 51 | , "CompleteTutorial": "tutorials" / "complete" / tutorialId segment 52 | , "Tutorials": "tutorials" / noArgs 53 | } 54 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Expression/Lint.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Expression.Lint where 2 | 3 | import Prelude 4 | import Data.Maybe (Maybe(..)) 5 | import Lunarbox.Data.Dataflow.Expression (Expression(..), VarName, foldExpression, isReferenced) 6 | import Lunarbox.Data.String (doubleShow, showIndex) 7 | 8 | -- | Basically warnings the user gets for imrpoving code clarity 9 | data LintError l 10 | = UnusedDeclaration l VarName 11 | | UnsaturatedFunction l l 12 | 13 | -- | Extra data we need to format a lint error 14 | type LEFormattingData 15 | = { who :: String, namedWho :: String -> String, nth :: Maybe Int } 16 | 17 | -- | We need some extra data for printing so we cannot just declare a Show instance 18 | printError :: forall l. LEFormattingData -> LintError l -> String 19 | printError { namedWho } (UnusedDeclaration _ name) = namedWho (doubleShow name) <> " is declared and never used" 20 | 21 | printError { who, nth } (UnsaturatedFunction _ _) = 22 | show who <> " doesn't have " 23 | <> case nth of 24 | Nothing -> "all its inputs connected" 25 | Just index -> " its " <> showIndex index <> " input connected" 26 | 27 | -- | Get the location a linting error came from 28 | getLocation :: forall l. LintError l -> l 29 | getLocation (UnusedDeclaration location _) = location 30 | 31 | getLocation (UnsaturatedFunction location _) = location 32 | 33 | -- | Collect linting errors inside an expression 34 | lint :: forall l. Expression l -> Array (LintError l) 35 | lint = foldExpression (const true) go 36 | where 37 | go (Let location name _ body) 38 | | not $ isReferenced name body = 39 | [ UnusedDeclaration location name 40 | ] 41 | 42 | go (FunctionCall location _ (TypedHole argLocation)) = 43 | [ UnsaturatedFunction location argLocation 44 | ] 45 | 46 | go a = [] 47 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Constraint.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Constraint 2 | ( Constraint(..) 3 | , ConstraintSet(..) 4 | , _typeLeft 5 | , _typeRight 6 | , _source 7 | ) where 8 | 9 | import Prelude 10 | import Data.Lens (Lens', iso, over) 11 | import Data.Lens.Record (prop) 12 | import Data.List (List) 13 | import Data.Newtype (class Newtype, unwrap, wrap) 14 | import Data.Set as Set 15 | import Data.Symbol (SProxy(..)) 16 | import Lunarbox.Data.Dataflow.Class.Substituable (class Substituable, apply, ftv) 17 | import Lunarbox.Data.Dataflow.Type (Type) 18 | 19 | newtype Constraint l 20 | = Constraint 21 | { typeLeft :: Type 22 | , typeRight :: Type 23 | , source :: l 24 | } 25 | 26 | derive instance eqConstraint :: Eq l => Eq (Constraint l) 27 | 28 | derive instance newtypeConstraint :: Newtype (Constraint l) _ 29 | 30 | instance substiuableConstraint :: Substituable (Constraint l) where 31 | ftv (Constraint { typeLeft, typeRight }) = ftv typeLeft `Set.union` ftv typeRight 32 | apply substitution = 33 | let 34 | applySubstitution = apply substitution 35 | in 36 | over _typeLeft applySubstitution <<< over _typeRight applySubstitution 37 | 38 | _typeLeft :: forall l. Lens' (Constraint l) Type 39 | _typeLeft = iso unwrap wrap <<< prop (SProxy :: _ "typeLeft") 40 | 41 | _typeRight :: forall l. Lens' (Constraint l) Type 42 | _typeRight = iso unwrap wrap <<< prop (SProxy :: _ "typeRight") 43 | 44 | _source :: forall l. Lens' (Constraint l) l 45 | _source = iso unwrap wrap <<< prop (SProxy :: _ "source") 46 | 47 | newtype ConstraintSet l 48 | = ConstraintSet (List (Constraint l)) 49 | 50 | derive instance eqConstraintSet :: Eq l => Eq (ConstraintSet l) 51 | 52 | derive newtype instance semigroupConstraintSet :: Semigroup (ConstraintSet l) 53 | 54 | derive newtype instance monoidConstraintSet :: Monoid (ConstraintSet l) 55 | -------------------------------------------------------------------------------- /CONTRIBUTING.md: -------------------------------------------------------------------------------- 1 | # Contributing 2 | 3 | Fork this repo, write some code and submit a pull request into the develop branch. 4 | 5 | ## Installing locally 6 | 7 | This guide assumes you have yarn, purescript and spago already installed. 8 | 9 | ### Installing the dependencies 10 | 11 | Clone this repo. Install the dependencies with: 12 | 13 | ```sh 14 | yarn 15 | ``` 16 | 17 | Then you need to do the initial build for all the purescript with: 18 | 19 | ```sh 20 | spago build 21 | ``` 22 | 23 | ### Running the dev server: 24 | 25 | To start the dev server use the `dev` command: 26 | 27 | ```sh 28 | yarn dev 29 | ``` 30 | 31 | ### Building for production 32 | 33 | To generate a production build run: 34 | 35 | ```sh 36 | yarn build 37 | ``` 38 | 39 | ## Code generation 40 | 41 | This project uses [hygen](http://www.hygen.io/) for code generation. 42 | 43 | > If you want to contribute a new generator add it to the `_templates` folder 44 | 45 | ### Creating components / pages 46 | 47 | To create a component you can run: 48 | 49 | ``` 50 | yarn hygen purescript component Foo.Bar 51 | ``` 52 | 53 | This will create an empty halogen component in `src/Component/Foo/Bar.purs` which lives in a module called `Lunarbox.Component.Foo.Bar`. 54 | 55 | > You can add the -p flag at the end to generate a page instead (lives in `src/Page` and has the module name prefixed with `Lunarbox.Page`) 56 | 57 | > You can also use the render-function action when you want to build a render-function which takes some Input and some Actions as it's parameters 58 | 59 | ### Creating modules 60 | 61 | To create a simple purescript module use can use the `module` action from the `purescript` generator: 62 | 63 | ```sh 64 | yarn purescript module Foo.Bar 65 | ``` 66 | 67 | This will create an empty purescript module in `src/Foo/Bar.purs` called `Lunarbox.Foo.Bar` which has a single import to `Prelude`. 68 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Runtime/Class/Describable.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Runtime.Class.Describable where 2 | 3 | import Prelude 4 | import Data.Array as Array 5 | import Lunarbox.Data.Dataflow.Class.Substituable (ftv) 6 | import Lunarbox.Data.Dataflow.Expression (NativeExpression(..)) 7 | import Lunarbox.Data.Dataflow.Runtime.Class.Runnable (class Corunnable, class Runnable, fromRuntime, toRuntime) 8 | import Lunarbox.Data.Dataflow.Runtime.Class.Typeable (class Typeable, getType, typeof) 9 | import Lunarbox.Data.Dataflow.Scheme (Scheme(..)) 10 | import Lunarbox.Data.Dataflow.Type (Type) 11 | import Type.Proxy (Proxy(..)) 12 | 13 | -- | Proxy for giving purs extra info about 14 | -- | how we want to transform someting into 15 | -- | lunarboxes type system. 16 | -- | The first argument is a proof all ts are as 17 | newtype DProxy t a 18 | = DProxy a 19 | 20 | instance runnableDProxy :: Runnable a => Runnable (DProxy t a) where 21 | toRuntime (DProxy a) = toRuntime a 22 | 23 | instance typeableDProxy :: Typeable t => Typeable (DProxy t a) where 24 | typeof _ = typeof (Proxy :: Proxy t) 25 | 26 | instance corunnableDProxy :: Corunnable a => Corunnable (DProxy t a) where 27 | fromRuntime a = DProxy <$> fromRuntime a 28 | 29 | -- | Typecalss for stuff which is both Typeable and Runnable 30 | class (Runnable a, Typeable a) <= Describable a 31 | 32 | instance describableA :: (Runnable a, Typeable a) => Describable a 33 | 34 | -- | Quantify over all free variables in a type 35 | generalizeType :: Type -> Scheme 36 | generalizeType ty = Forall (Array.fromFoldable $ ftv ty) ty 37 | 38 | -- | generate a native expression from a purescript value 39 | toNativeExpression :: forall a. Describable a => a -> NativeExpression 40 | toNativeExpression value = NativeExpression ty runtimeValue 41 | where 42 | ty = generalizeType $ getType value 43 | 44 | runtimeValue = toRuntime value 45 | -------------------------------------------------------------------------------- /src/Data/Profile.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Profile 2 | ( Username(..) 3 | , Email(..) 4 | , ProfileRep 5 | , Profile 6 | , ProfileWithEmail 7 | , _username 8 | ) where 9 | 10 | import Prelude 11 | import Data.Argonaut (class DecodeJson, class EncodeJson) 12 | import Data.Generic.Rep (class Generic) 13 | import Data.Generic.Rep.Show (genericShow) 14 | import Data.Lens (Lens') 15 | import Data.Lens.Record (prop) 16 | import Data.Newtype (class Newtype) 17 | import Data.Symbol (SProxy(..)) 18 | 19 | newtype Email 20 | = Email String 21 | 22 | derive instance newtypeEmail :: Newtype Email _ 23 | 24 | derive instance genericEmail :: Generic Email _ 25 | 26 | derive instance eqEmail :: Eq Email 27 | 28 | derive instance ordEmail :: Ord Email 29 | 30 | derive newtype instance encodeJsonEmail :: EncodeJson Email 31 | 32 | derive newtype instance decodeJsonEmail :: DecodeJson Email 33 | 34 | instance showEmail :: Show Email where 35 | show = genericShow 36 | 37 | newtype Username 38 | = Username String 39 | 40 | derive instance newtypeUsername :: Newtype Username _ 41 | 42 | derive instance genericUsername :: Generic Username _ 43 | 44 | derive instance eqUsername :: Eq Username 45 | 46 | derive instance ordUsername :: Ord Username 47 | 48 | derive newtype instance encodeJsonUsername :: EncodeJson Username 49 | 50 | derive newtype instance decodeJsonUsername :: DecodeJson Username 51 | 52 | instance showUsername :: Show Username where 53 | show = genericShow 54 | 55 | -- The actual type for profiles 56 | type ProfileRep row 57 | = ( username :: Username 58 | , isAdmin :: Boolean 59 | | row 60 | ) 61 | 62 | type Profile 63 | = { | ProfileRep () } 64 | 65 | type ProfileWithEmail 66 | = { | ProfileRep ( email :: Email ) } 67 | 68 | -- Lenses 69 | _username :: forall r. Lens' { username :: Username | r } Username 70 | _username = prop (SProxy :: _ "username") 71 | -------------------------------------------------------------------------------- /src/Data/Editor/Constants.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.Constants where 2 | 3 | import Prelude 4 | import Lunarbox.Data.Editor.Node.NodeId (NodeId(..)) 5 | import Math (Radians, pi) 6 | 7 | -- visual radius for nodes 8 | nodeRadius :: Number 9 | nodeRadius = 50.0 10 | 11 | -- The radius of the little circle in the middle of nodes 12 | outputRadius :: Number 13 | outputRadius = 10.0 14 | 15 | -- How much spage to display between node inputs 16 | arcSpacing :: Radians 17 | arcSpacing = 0.1 18 | 19 | -- What width should the stroke of node inputs have 20 | arcWidth :: Number 21 | arcWidth = 5.0 22 | 23 | -- How much space to keep between 2 input layers 24 | inputLayerOffset :: Number 25 | inputLayerOffset = 10.0 26 | 27 | -- The stroke width of the wires 28 | connectionsWidth :: Number 29 | connectionsWidth = 5.0 30 | 31 | -- THis is required so the preview doesn't catch all the events 32 | scaleConnectionPreview :: Number -> Number 33 | scaleConnectionPreview = (_ / 1.02) 34 | 35 | -- Used for connection previews 36 | mouseId :: NodeId 37 | mouseId = NodeId "mouse" 38 | 39 | -- How much to scroll per event 40 | scrollStep :: Number 41 | scrollStep = 1.0 / 1.2 42 | 43 | -- Clamp the zoom between those values 44 | clampZoom :: Number -> Number 45 | clampZoom = clamp 0.1 10.0 46 | 47 | -- So when you add more than one node at a time the nodes are placed in 48 | -- a logarithmic spiral to prevent overlaps 49 | -- The following 3 constants are the parameters for that spiral: 50 | -- 51 | -- How much space to leave between newly created nodes 52 | nodeOffset :: Radians 53 | nodeOffset = pi / 3.0 54 | 55 | -- How much to increase the radius of the offset 56 | nodeOffsetGrowthRate :: Number 57 | nodeOffsetGrowthRate = 1.1 58 | 59 | -- The starting radius of the offset 60 | nodeOffsetInitialRadius :: Number 61 | nodeOffsetInitialRadius = 100.0 62 | 63 | -- The width of the number and string inputs 64 | inputWIdth :: Number 65 | inputWIdth = 75.0 66 | -------------------------------------------------------------------------------- /src/Data/Dataflow/TypeError.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.TypeError 2 | ( TypeError(..) 3 | , getLocation 4 | , printError 5 | ) where 6 | 7 | import Prelude 8 | import Data.List (List) 9 | import Lunarbox.Data.Dataflow.Expression (VarName) 10 | import Lunarbox.Data.Dataflow.Type (TVarName, Type) 11 | 12 | -- Type for all type errors 13 | -- At the moment there are 4 possible type errors: 14 | -- 1) Trying to use a type t1 when a type t2 is expected => TypeMissmatch 15 | -- 2) Trying to use a function where a type is expected => DifferentLength 16 | -- 3) Using a type which contains itself => RecursiveType 17 | -- 4) Trying to access a variable which isn't in scope => UnboundVariable 18 | -- All the errors hold a "l" argument which represents the location where the error occured 19 | data TypeError l 20 | = TypeMissmatch Type Type l 21 | | DifferentLength (List Type) (List Type) l 22 | | RecursiveType TVarName Type l 23 | | UnboundVariable VarName l 24 | | Stacked (TypeError l) l 25 | 26 | -- | Get the location an error occured at 27 | getLocation :: forall l. TypeError l -> l 28 | getLocation (TypeMissmatch _ _ l) = l 29 | 30 | getLocation (DifferentLength _ _ l) = l 31 | 32 | getLocation (RecursiveType _ _ l) = l 33 | 34 | getLocation (UnboundVariable _ l) = l 35 | 36 | getLocation (Stacked _ l) = l 37 | 38 | -- | Print an error with a custom function for printing the locations. 39 | printError :: forall l. TypeError l -> String 40 | printError (TypeMissmatch t1 t2 _) = "Could not match type " <> show t1 <> " with type " <> show t2 41 | 42 | printError (DifferentLength t1 t2 _) = "Could not match types " <> show t1 <> " with types " <> show t2 <> " because the lengths are different" 43 | 44 | printError (RecursiveType v t _) = "Type " <> show t <> " contains a reference to itself" 45 | 46 | printError (UnboundVariable v _) = "Variable " <> show v <> " is not in scope" 47 | 48 | printError (Stacked inner _) = printError inner 49 | -------------------------------------------------------------------------------- /src/Data/String.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.String where 2 | 3 | import Prelude 4 | import Data.Either (Either, either) 5 | import Data.Foldable (foldr) 6 | import Data.String (joinWith) 7 | import Data.String.Regex (Regex, regex, test) 8 | import Data.String.Regex.Flags (noFlags) 9 | import Data.String.Utils (lines, unsafeRepeat) 10 | import Halogen.HTML as HH 11 | 12 | -- Indent a string by a number of spaces 13 | indent :: Int -> String -> String 14 | indent spaces = joinWith "\n" <<< map (space <> _) <<< lines 15 | where 16 | space = unsafeRepeat spaces " " 17 | 18 | -- Replaces \n with
19 | toHtml :: forall h a. String -> HH.HTML h a 20 | toHtml text = 21 | HH.span_ 22 | $ foldr 23 | (\line -> flip append [ HH.br_, HH.text line ]) 24 | [] 25 | $ lines 26 | text 27 | 28 | -- Put spaces around a string 29 | spaced :: String -> String 30 | spaced s = " " <> s <> " " 31 | 32 | -- Helper to create a validator from either an error or a regex 33 | validatorFromRegex :: forall a. Either a Regex -> String -> Boolean 34 | validatorFromRegex = either (const $ const false) test 35 | 36 | -- CHeck if a string contains at least an uppercase character 37 | hasUppercase :: String -> Boolean 38 | hasUppercase = validatorFromRegex $ regex "[A-Z]" noFlags 39 | 40 | -- Check if a string cnotains at least a lowecase character 41 | hasLowecase :: String -> Boolean 42 | hasLowecase = validatorFromRegex $ regex "[a-z]" noFlags 43 | 44 | -- Check if a string contains at least a digit 45 | containsDigits :: String -> Boolean 46 | containsDigits = validatorFromRegex $ regex ".*[0-9].*" noFlags 47 | 48 | -- | We use this for better error messages 49 | showIndex :: Int -> String 50 | showIndex 0 = "first" 51 | 52 | showIndex 1 = "second" 53 | 54 | showIndex 2 = "third" 55 | 56 | showIndex n = show (n - 1) <> "th" 57 | 58 | -- | Shows something and then quotes it 59 | doubleShow :: forall a. Show a => a -> String 60 | doubleShow = show <<< show 61 | -------------------------------------------------------------------------------- /src/Foreign/Render.js: -------------------------------------------------------------------------------- 1 | "use strict" 2 | 3 | const Native = require("src/typescript/render.ts") 4 | 5 | // The initial cache used from purescript 6 | exports.emptyGeometryCache = Native.emptyGeometryCache 7 | 8 | /** 9 | * Render a scene from purescript 10 | * 11 | * @param ctx The context to render to 12 | */ 13 | exports.renderScene = (ctx) => (cache) => () => Native.renderScene(ctx, cache) 14 | 15 | // To be able to get contexts from purescript 16 | exports.getContext = (canvas) => () => canvas.getContext("2d") 17 | 18 | // Scale a canvas to its bounding box 19 | exports.resizeCanvas = (canvas) => () => { 20 | const { width, height } = canvas.getBoundingClientRect() 21 | 22 | canvas.width = width 23 | canvas.height = height 24 | } 25 | 26 | // Same as the above thing but works with rendering contexts instead 27 | exports.resizeContext = (ctx) => exports.resizeCanvas(ctx.canvas) 28 | 29 | // Reexports with a few changed names 30 | exports.handleMouseMoveImpl = Native.onMouseMove 31 | exports.handleMouseUpImpl = Native.onMouseUp 32 | exports.handleMouseDownImpl = Native.onMouseDown 33 | exports.handleDoubleClickImpl = Native.onDoubleClick 34 | 35 | // We cannot do 36 | // export * from "../typescript/save" 37 | // because purescript cannot understand it yet 38 | const Save = require("src/typescript/save.ts") 39 | const Sync = require("src/typescript/sync.ts") 40 | const Preview = require("src/typescript/preview.ts") 41 | 42 | exports.geometryCacheToJson = Save.geometryCacheToJson 43 | exports.geometryCacheFromJsonImpl = Save.geometryCacheFromJson 44 | 45 | exports.centerNode = Sync.centerNode 46 | exports.centerOutput = Sync.centerOutput 47 | exports.createNode = Sync.createNode 48 | exports.refreshInputArcs = Sync.refreshInputArcs 49 | exports.setUnconnectableInputs = Sync.setUnconnectableInputs 50 | exports.setUnconnectableOutputs = Sync.setUnconnectableOutputs 51 | exports.deleteNode = Sync.deleteNode 52 | 53 | exports.renderPreview = Preview.renderPreview 54 | -------------------------------------------------------------------------------- /src/Data/Editor/Save.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.Save 2 | ( stateToJson 3 | , jsonToState 4 | ) where 5 | 6 | import Prelude 7 | import Data.Argonaut (Json, decodeJson, encodeJson, (.:)) 8 | import Data.Either (Either) 9 | import Effect.Unsafe (unsafePerformEffect) 10 | import Lunarbox.Data.Editor.State (State, StatePermanentData, emptyState, nodeCount, visualFunctionCount) 11 | import Lunarbox.Data.ProjectList (ProjectData) 12 | import Record as Record 13 | 14 | type Save 15 | = { 16 | | ProjectData 17 | ( project :: { | StatePermanentData () } 18 | , isExample :: Boolean 19 | , visible :: Boolean 20 | ) 21 | } 22 | 23 | -- Encoding and decoding 24 | stateToJson :: State -> Json 25 | stateToJson state@{ project 26 | , nextId 27 | , geometries 28 | , runtimeOverwrites 29 | , isExample 30 | , name 31 | , isVisible 32 | , currentFunction 33 | } = encodeJson save 34 | where 35 | save :: Save 36 | save = 37 | { name 38 | , isExample 39 | , visible: isVisible 40 | , metadata: 41 | { nodeCount: nodeCount state 42 | , functionCount: visualFunctionCount state 43 | } 44 | , project: 45 | { project 46 | , nextId 47 | , geometries 48 | , runtimeOverwrites 49 | , currentFunction 50 | } 51 | } 52 | 53 | jsonToState :: Json -> Either String State 54 | jsonToState json = do 55 | obj <- decodeJson json 56 | name :: String <- obj .: "name" 57 | isExample :: Boolean <- obj .: "isExample" 58 | isVisible :: Boolean <- obj .: "visible" 59 | saveData :: { | StatePermanentData () } <- obj .: "project" 60 | let 61 | recivedData = Record.merge { name, isExample, isVisible } saveData 62 | 63 | -- TODO: this is pretty low priority but maybe I could get rid of the call to 64 | -- unsafePerformEffect by making the whole function return an effect 65 | baseState :: State 66 | baseState = Record.merge recivedData $ unsafePerformEffect emptyState 67 | pure baseState 68 | -------------------------------------------------------------------------------- /public/styles/index.scss: -------------------------------------------------------------------------------- 1 | @use "./fonts"; 2 | 3 | // Libraries 4 | @import "normalize.css"; 5 | @import "microtip/microtip.css"; 6 | 7 | // Components 8 | @import "./components/switch.scss"; 9 | @import "./components/node-input.scss"; 10 | @import "./components/with-logo.scss"; 11 | @import "./components/loading.scss"; 12 | @import "./components/error.scss"; 13 | @import "./components/modal.scss"; 14 | @import "./components/tabs.scss"; 15 | @import "./components/dropdown.scss"; 16 | @import "./components/input.scss"; 17 | 18 | // Pages 19 | @import "./pages/home.scss"; 20 | @import "./pages/editor.scss"; 21 | @import "./pages/login.scss"; 22 | @import "./pages/projects.scss"; 23 | @import "./pages/editTutorial.scss"; 24 | @import "./pages/tutorial.scss"; 25 | 26 | * { 27 | // we don't want the user to drag stuff 28 | -webkit-user-drag: none; 29 | } 30 | 31 | // Prevent default select behavior on images and icons 32 | img, 33 | .material-icons, 34 | .unselectable { 35 | user-select: none; 36 | } 37 | 38 | * { 39 | box-sizing: border-box; 40 | } 41 | 42 | // Helper for text elements which should show ... after they overflow their container 43 | .no-overflow { 44 | text-overflow: ellipsis; 45 | white-space: nowrap; 46 | overflow: hidden; 47 | } 48 | 49 | :root { 50 | // default font on everything 51 | font-family: fonts.$montserrat; 52 | } 53 | 54 | // Remove arrows from number inputs 55 | 56 | // Chrome, Safari, Edge, Opera 57 | input::-webkit-outer-spin-button, 58 | input::-webkit-inner-spin-button { 59 | -webkit-appearance: none; 60 | margin: 0; 61 | } 62 | 63 | // Firefox 64 | input[type="number"] { 65 | -moz-appearance: textfield; 66 | } 67 | 68 | // Custom scrollbar 69 | * { 70 | scrollbar-color: $primary-bright; 71 | scrollbar-width: 1rem; 72 | 73 | &::-webkit-scrollbar { 74 | width: 1rem; 75 | } 76 | 77 | &::-webkit-scrollbar-track { 78 | background: $very-dark; 79 | } 80 | 81 | &::-webkit-scrollbar-thumb { 82 | background-color: $primary-bright; 83 | } 84 | } 85 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Class/Substituable.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Class.Substituable where 2 | 3 | import Prelude 4 | import Data.Foldable (foldMap, foldr) 5 | import Data.List (List) 6 | import Data.Map as Map 7 | import Data.Maybe (fromMaybe) 8 | import Data.Set as Set 9 | import Lunarbox.Data.Dataflow.Scheme (Scheme(..)) 10 | import Lunarbox.Data.Dataflow.Type (TVarName, Type(..)) 11 | import Lunarbox.Data.Dataflow.TypeEnv (TypeEnv(..)) 12 | 13 | newtype Substitution 14 | = Substitution (Map.Map TVarName Type) 15 | 16 | derive instance eqSubstitution :: Eq Substitution 17 | 18 | instance semigroupSubstitution :: Semigroup Substitution where 19 | append s1@(Substitution m1) (Substitution m2) = 20 | let 21 | m12 = (apply s1) <$> m2 22 | in 23 | Substitution $ (m12 `Map.union` m1) 24 | 25 | derive newtype instance monoidSubstitution :: Monoid Substitution 26 | 27 | class Substituable a where 28 | apply :: Substitution -> a -> a 29 | ftv :: a -> Set.Set TVarName 30 | 31 | instance typeSubst :: Substituable Type where 32 | apply substitution t@(TConstant name vars) = TConstant name $ apply substitution <$> vars 33 | apply (Substitution s) t@(TVariable _ a) = (Map.lookup a s) # fromMaybe t 34 | ftv (TConstant name vars) = foldMap ftv vars 35 | ftv (TVariable generalize a) 36 | | generalize = Set.singleton a 37 | | otherwise = Set.empty 38 | 39 | instance schemeSubst :: Substituable Scheme where 40 | apply (Substitution substitution) (Forall quantifiers t) = Forall quantifiers $ apply newScheme t 41 | where 42 | newScheme = Substitution $ foldr Map.delete substitution quantifiers 43 | ftv (Forall as t) = ftv t `Set.difference` (Set.fromFoldable as) 44 | 45 | instance arrSubst :: (Substituable a) => Substituable (List a) where 46 | apply = map <<< apply 47 | ftv = foldr (Set.union <<< ftv) Set.empty 48 | 49 | instance envSusbt :: Substituable TypeEnv where 50 | apply s (TypeEnv env) = env <#> (apply s) # TypeEnv 51 | ftv (TypeEnv env) = ftv $ Map.values env 52 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Native/ControlFlow.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Native.ControlFlow 2 | ( controlFlowNodes 3 | ) where 4 | 5 | import Data.Symbol (SProxy) 6 | import Lunarbox.Data.Dataflow.Native.NativeConfig (NativeConfig(..)) 7 | import Lunarbox.Data.Dataflow.Runtime (RuntimeValue) 8 | import Lunarbox.Data.Dataflow.Runtime.Class.Describable (DProxy(..), toNativeExpression) 9 | import Lunarbox.Data.Dataflow.Scheme (Scheme(..)) 10 | import Lunarbox.Data.Dataflow.Type (TVarName(..), Type(..), typeBool, typeFunction) 11 | import Lunarbox.Data.Editor.FunctionData (internal) 12 | import Lunarbox.Data.Editor.FunctionName (FunctionName(..)) 13 | import Prelude (const, flip, ($)) 14 | 15 | -- All the native control flow nodes 16 | controlFlowNodes :: Array (NativeConfig) 17 | controlFlowNodes = [ if' ] 18 | 19 | typeIf :: Scheme 20 | typeIf = Forall [ return ] $ typeFunction typeBool $ typeFunction typeReturn $ typeFunction typeReturn typeReturn 21 | where 22 | return = TVarName "a" 23 | 24 | typeReturn = TVariable true return 25 | 26 | if' :: NativeConfig 27 | if' = 28 | NativeConfig 29 | { name: FunctionName "if" 30 | , expression: toNativeExpression proxyIf 31 | , functionData: 32 | internal 33 | [ { name: "condition", description: "A boolean which decides what branch to evaluate to" } 34 | , { name: "then" 35 | , description: "A branch which will be chosem if the condition is true" 36 | } 37 | , { name: "else" 38 | , description: "A branch which will be chosen if the condition is false" 39 | } 40 | ] 41 | { name: "result" 42 | , description: "Evaluates to the 'then' argument if the condition is true, else this evaludates to the 'else' argument" 43 | } 44 | } 45 | where 46 | proxyIf :: DProxy (Boolean -> SProxy "a" -> SProxy "a" -> SProxy "a") _ 47 | proxyIf = DProxy evalIf 48 | 49 | evalIf :: Boolean -> RuntimeValue -> _ 50 | evalIf true = const 51 | 52 | evalIf false = flip const 53 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Native/Logic.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Native.Logic 2 | ( logicNodes 3 | ) where 4 | 5 | import Prelude 6 | import Lunarbox.Data.Dataflow.Native.NativeConfig (NativeConfig(..)) 7 | import Lunarbox.Data.Dataflow.Runtime.Class.Describable (toNativeExpression) 8 | import Lunarbox.Data.Editor.FunctionData (PinDoc, internal) 9 | import Lunarbox.Data.Editor.FunctionName (FunctionName(..)) 10 | 11 | -- All the native logic gatesish nodes 12 | logicNodes :: Array (NativeConfig) 13 | logicNodes = [ not', or, and, xor ] 14 | 15 | -- Arguments for 2-inputs logic gates 16 | binaryLogicFunctionArgs :: Array PinDoc 17 | binaryLogicFunctionArgs = [ { name: "first input", description: "Any boolean" }, { name: "second input", description: "Any boolean" } ] 18 | 19 | not' :: NativeConfig 20 | not' = 21 | NativeConfig 22 | { name: FunctionName "not" 23 | , expression: toNativeExpression (not :: Boolean -> _) 24 | , functionData: internal [ { name: "input", description: "Any boolean" } ] { name: "!input", description: "If the input is true returns false, else returns true" } 25 | } 26 | 27 | and :: NativeConfig 28 | and = 29 | NativeConfig 30 | { name: FunctionName "and" 31 | , expression: toNativeExpression ((&&) :: Boolean -> _) 32 | , functionData: internal binaryLogicFunctionArgs { name: "a && b", description: "Returns true if both of the inputs are true" } 33 | } 34 | 35 | or :: NativeConfig 36 | or = 37 | NativeConfig 38 | { name: FunctionName "or" 39 | , expression: toNativeExpression ((||) :: Boolean -> _) 40 | , functionData: internal binaryLogicFunctionArgs { name: "a || b", description: "Returns true if at least one of the inputs is true" } 41 | } 42 | 43 | xor :: NativeConfig 44 | xor = 45 | NativeConfig 46 | { name: FunctionName "xor" 47 | , expression: toNativeExpression ((/=) :: Boolean -> _) 48 | , functionData: internal binaryLogicFunctionArgs { name: "a ^ b", description: "Returns true if one and only one of the inputs is true" } 49 | } 50 | -------------------------------------------------------------------------------- /src/Data/Tutorial.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Tutorial where 2 | 3 | import Prelude 4 | import Data.Argonaut (class DecodeJson, class EncodeJson) 5 | import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson) 6 | import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson) 7 | import Data.Generic.Rep (class Generic) 8 | import Data.Tuple (Tuple(..)) 9 | import Lunarbox.Data.Gist (GistId) 10 | import Lunarbox.Data.ProjectId (ProjectId) 11 | import Lunarbox.Data.Tab (Tab) 12 | 13 | -- | Elements we can hide in the editor 14 | -- | I'll add more soon 15 | data EditorElement 16 | = Tab Tab 17 | 18 | derive instance genericEditorElement :: Generic EditorElement _ 19 | 20 | instance encodeJsonEditorElement :: EncodeJson EditorElement where 21 | encodeJson = genericEncodeJson 22 | 23 | instance decodeJsonEditorElement :: DecodeJson EditorElement where 24 | decodeJson = genericDecodeJson 25 | 26 | -- | Id used to identify tutorials 27 | newtype TutorialId 28 | = TutorialId Int 29 | 30 | derive instance eqTutorialId :: Eq TutorialId 31 | 32 | derive instance ordTutorialId :: Ord TutorialId 33 | 34 | derive newtype instance showTutorialId :: Show TutorialId 35 | 36 | derive newtype instance encodeJsonTutorialId :: EncodeJson TutorialId 37 | 38 | derive newtype instance decodeJsonTutorialId :: DecodeJson TutorialId 39 | 40 | -- | Type edited by the user visually 41 | type TutorialSpec 42 | = { name :: String 43 | , base :: UserProject 44 | , solution :: UserProject 45 | , content :: GistId 46 | } 47 | 48 | -- | The actual data structure for the tutorials 49 | type Tutorial 50 | = { name :: String 51 | , base :: ProjectId 52 | , solution :: ProjectId 53 | , content :: GistId 54 | } 55 | 56 | newtype UserProject 57 | = UserProject (Tuple String ProjectId) 58 | 59 | derive instance eqUserProject :: Eq UserProject 60 | 61 | instance showUserProject :: Show UserProject where 62 | show (UserProject (Tuple name _)) = name 63 | 64 | instance semigroupUserProject :: Semigroup UserProject where 65 | append a b = b 66 | -------------------------------------------------------------------------------- /src/Control/Monad/Dataflow/Solve/SolveExpression.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Control.Monad.Dataflow.Solve.SolveExpression 2 | ( solveExpression 3 | , printTypeMap 4 | ) where 5 | 6 | import Prelude 7 | import Data.Array (foldr) 8 | import Data.Array as Array 9 | import Data.Generic.Rep (class Generic) 10 | import Data.Generic.Rep.Show (class GenericShow, genericShow) 11 | import Data.Map as Map 12 | import Data.Tuple (Tuple(..)) 13 | import Lunarbox.Capability.Editor.Type (prettify) 14 | import Lunarbox.Control.Monad.Dataflow.Infer (InferEnv(..), InferOutput(..), runInfer) 15 | import Lunarbox.Control.Monad.Dataflow.Infer.InferExpression (infer) 16 | import Lunarbox.Control.Monad.Dataflow.Solve (SolveContext(..), SolveState(..), runSolve) 17 | import Lunarbox.Control.Monad.Dataflow.Solve.SolveConstraintSet (solve) 18 | import Lunarbox.Data.Dataflow.Class.Substituable (apply) 19 | import Lunarbox.Data.Dataflow.Expression (Expression, getLocation) 20 | import Lunarbox.Data.Dataflow.Type (Type) 21 | 22 | -- Takes an expression and returns a typeMap 23 | solveExpression :: forall l. Ord l => Show l => Expression l -> Tuple (Map.Map l Type) (SolveState l) 24 | solveExpression expression = Tuple (apply substitution <$> typeMap) (SolveState { errors } <> otherState) 25 | where 26 | location = getLocation expression 27 | 28 | inferEnv = 29 | InferEnv 30 | { typeEnv: mempty 31 | , location 32 | } 33 | 34 | solveContext = SolveContext { location } 35 | 36 | (Tuple _ (InferOutput { typeMap, constraints, errors })) = runInfer inferEnv $ infer expression 37 | 38 | (Tuple substitution otherState) = runSolve solveContext $ solve constraints 39 | 40 | -- helper to print a typemap 41 | printTypeMap :: forall l r. Show l => Generic l r => GenericShow r => Ord l => Map.Map l Type -> String 42 | printTypeMap = 43 | foldr (\(Tuple location type') result -> result <> "\n" <> genericShow location <> " = " <> show (prettify $ type')) "" 44 | <<< Array.sortBy (\(Tuple _ a) (Tuple _ b) -> compare (show a) $ show b) 45 | <<< Map.toUnfoldable 46 | -------------------------------------------------------------------------------- /src/Data/Editor/Node/NodeData.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.Node.NodeData 2 | ( NodeData(..) 3 | , _NodeDataPosition 4 | , _NodeDataSelected 5 | , _NodeDataZPosition 6 | , _NodeDataComment 7 | ) where 8 | 9 | import Prelude 10 | import Data.Argonaut (class DecodeJson, class EncodeJson) 11 | import Data.Default (class Default) 12 | import Data.Generic.Rep (class Generic) 13 | import Data.Generic.Rep.Show (genericShow) 14 | import Data.Lens (Lens') 15 | import Data.Lens.Record (prop) 16 | import Data.Maybe (Maybe(..)) 17 | import Data.Newtype (class Newtype) 18 | import Data.Symbol (SProxy(..)) 19 | import Lunarbox.Data.Lens (newtypeIso) 20 | import Lunarbox.Data.Vector (Vec2) 21 | 22 | newtype NodeData 23 | = NodeData { position :: Vec2 Number, selected :: Boolean, zPosition :: Int, comment :: Maybe String } 24 | 25 | derive instance newtypeNodeData :: Newtype NodeData _ 26 | 27 | derive instance eqNodeData :: Eq NodeData 28 | 29 | derive instance genericNodeData :: Generic NodeData _ 30 | 31 | derive newtype instance encodeJsonNodeData :: EncodeJson NodeData 32 | 33 | derive newtype instance decodeJsonNodeData :: DecodeJson NodeData 34 | 35 | instance showNodeData :: Show NodeData where 36 | show = genericShow 37 | 38 | instance ordNodeData :: Ord NodeData where 39 | compare (NodeData { zPosition }) (NodeData ({ zPosition: zPosition' })) = compare zPosition zPosition' 40 | 41 | instance defaultNodeData :: Default NodeData where 42 | def = NodeData { position: zero, selected: false, zPosition: 0, comment: Nothing } 43 | 44 | -- Lenses 45 | _NodeDataPosition :: Lens' NodeData (Vec2 Number) 46 | _NodeDataPosition = newtypeIso <<< prop (SProxy :: SProxy "position") 47 | 48 | _NodeDataSelected :: Lens' NodeData Boolean 49 | _NodeDataSelected = newtypeIso <<< prop (SProxy :: SProxy "selected") 50 | 51 | _NodeDataZPosition :: Lens' NodeData Int 52 | _NodeDataZPosition = newtypeIso <<< prop (SProxy :: _ "zPosition") 53 | 54 | _NodeDataComment :: Lens' NodeData (Maybe String) 55 | _NodeDataComment = newtypeIso <<< prop (SProxy :: _ "comment") 56 | -------------------------------------------------------------------------------- /src/Component/Editor/HighlightedType.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Editor.HighlightedType 2 | ( highlightedType 3 | , highlightTypeToHTML 4 | ) where 5 | 6 | import Prelude 7 | import Color (Color, rgb) 8 | import Halogen.HTML as HH 9 | import Lunarbox.Capability.Editor.Type (typeToColor) 10 | import Lunarbox.Component.HighlightedText (bold) 11 | import Lunarbox.Component.HighlightedText as HT 12 | import Lunarbox.Data.Char (arrow) 13 | import Lunarbox.Data.Dataflow.Type (Type(..)) 14 | import Lunarbox.Data.String (spaced) 15 | import Lunarbox.Math.SeededRandom (seededInt) 16 | 17 | -- A type which is syntax highlighted 18 | highlightedType :: 19 | forall h a. 20 | (Array (HH.HTML h a) -> HH.HTML h a) -> 21 | (HH.HTML h a -> HH.HTML h a) -> 22 | (Color -> HH.HTML h a -> HH.HTML h a) -> 23 | Type -> HH.HTML h a 24 | highlightedType container bold highlight = 25 | let 26 | -- We need to take a type apram instead of just using partail apliaction 27 | -- to prevent infinite recursion 28 | continue type' = highlightedType container bold highlight type' 29 | in 30 | case _ of 31 | TConstant "Function" [ from, to ] -> 32 | container 33 | [ if isArrow then container [ HH.text "(", result, HH.text ")" ] else result 34 | , bold $ HH.text $ spaced arrow 35 | , continue to 36 | ] 37 | where 38 | isArrow = case from of 39 | TConstant "Function" [ _, _ ] -> true 40 | _ -> false 41 | 42 | result = continue from 43 | TConstant "Array" [ inner ] -> 44 | container 45 | [ bold $ HH.text "[" 46 | , continue inner 47 | , bold $ HH.text "]" 48 | ] 49 | TVariable _ name' -> highlight (rgb shade shade shade) $ HH.text $ show name' 50 | where 51 | shade = seededInt (show name') 100 255 52 | other -> highlight color $ HH.text $ show other 53 | where 54 | color = typeToColor other 55 | 56 | highlightTypeToHTML :: forall h a. Type -> HH.HTML h a 57 | highlightTypeToHTML = highlightedType HH.span_ bold HT.highlight 58 | -------------------------------------------------------------------------------- /public/styles/pages/tutorial.scss: -------------------------------------------------------------------------------- 1 | @use "../utils/utils"; 2 | @import "../theme.scss"; 3 | 4 | .tutorial__buttons { 5 | @include utils.center; 6 | 7 | z-index: 3; 8 | 9 | position: absolute; 10 | 11 | right: 1rem; 12 | bottom: 1rem; 13 | } 14 | 15 | .tutorial__button { 16 | @include utils.base-input; 17 | @include utils.center; 18 | 19 | border-radius: 50%; 20 | 21 | height: 3.5rem; 22 | width: 3.5rem; 23 | 24 | margin: 0.5rem; 25 | padding: 0; 26 | 27 | cursor: pointer; 28 | transition: filter $transition-time, transform $transition-time; 29 | 30 | font-size: 2rem; 31 | font-weight: bolder; 32 | 33 | background: darken($blue, 0); 34 | color: white; 35 | } 36 | 37 | .tutorial__button.tutorial__button--run { 38 | background: darken($error-text, 3); 39 | } 40 | 41 | .tutorial__button:hover { 42 | filter: brightness(1.4); 43 | transform: scale(1.1); 44 | } 45 | 46 | .tutorial__slide.tutorial__slide--active { 47 | z-index: 30; 48 | } 49 | 50 | .tutorial__result { 51 | padding: 1rem; 52 | margin-top: 1.3rem; 53 | 54 | background: $primary-dark; 55 | // background: $error-bg; 56 | border-left: 3px solid $secondary; 57 | 58 | max-height: 50vh; 59 | overflow-y: auto; 60 | } 61 | 62 | .tutorial__result-summary { 63 | outline: none; 64 | cursor: pointer; 65 | } 66 | 67 | .tutorial__result-error { 68 | margin-left: 3rem; 69 | text-align: justify; 70 | color: $error-text; 71 | } 72 | 73 | .tutorial__result-type { 74 | margin-left: 2rem; 75 | } 76 | 77 | // Those are overrides for the html generated by marked 78 | .tutorial__slide img { 79 | max-width: 100%; 80 | } 81 | 82 | .tutorial__slide a { 83 | color: darken($bright, 20); 84 | } 85 | 86 | .tutorial__slide code { 87 | width: 100%; 88 | display: block; 89 | 90 | background: $primary-dark; 91 | padding: 0.5rem; 92 | } 93 | 94 | .tutorial__slide blockquote { 95 | background: $primary-dark; 96 | border-left: 3px solid $secondary; 97 | padding: 0.3rem; 98 | padding-left: 1rem; 99 | margin: 0; 100 | } 101 | -------------------------------------------------------------------------------- /.all-contributorsrc: -------------------------------------------------------------------------------- 1 | { 2 | "projectName": "lunarbox", 3 | "projectOwner": "Mateiadrielrafael", 4 | "repoType": "github", 5 | "repoHost": "https://github.com", 6 | "files": [ 7 | "README.md" 8 | ], 9 | "imageSize": 100, 10 | "commit": true, 11 | "commitConvention": "angular", 12 | "badgeTemplate": "[![All Contributors](https://img.shields.io/badge/all_contributors-<%= contributors.length %>-orange.svg?style=for-the-badge)](#contributors)", 13 | "contributors": [ 14 | { 15 | "login": "Mateiadrielrafael", 16 | "name": "Matei Adriel", 17 | "avatar_url": "https://avatars0.githubusercontent.com/u/39400800?v=4", 18 | "profile": "https://github.com/Mateiadrielrafael", 19 | "contributions": [ 20 | "code", 21 | "design", 22 | "infra" 23 | ] 24 | }, 25 | { 26 | "login": "xWafl", 27 | "name": "xWafl", 28 | "avatar_url": "https://avatars2.githubusercontent.com/u/35458851?v=4", 29 | "profile": "http://xwafl.github.io/portfolio", 30 | "contributions": [ 31 | "design", 32 | "ideas", 33 | "doc" 34 | ] 35 | }, 36 | { 37 | "login": "Vyctor661", 38 | "name": "Sandu Victor", 39 | "avatar_url": "https://avatars0.githubusercontent.com/u/49570123?v=4", 40 | "profile": "https://discordapp.com/users/270972671490129921", 41 | "contributions": [ 42 | "design", 43 | "ideas" 44 | ] 45 | }, 46 | { 47 | "login": "BlueGhostGH", 48 | "name": "Dragomir George", 49 | "avatar_url": "https://avatars0.githubusercontent.com/u/17652623?v=4", 50 | "profile": "https://github.com/BlueGhostGH", 51 | "contributions": [ 52 | "code", 53 | "doc", 54 | "tool" 55 | ] 56 | }, 57 | { 58 | "login": "pantharshit00", 59 | "name": "Harshit Pant", 60 | "avatar_url": "https://avatars3.githubusercontent.com/u/22195362?v=4", 61 | "profile": "https://harshitpant.com", 62 | "contributions": [ 63 | "data" 64 | ] 65 | } 66 | ], 67 | "contributorsPerLine": 7, 68 | "skipCi": true 69 | } 70 | -------------------------------------------------------------------------------- /src/Data/Editor/DataflowFunction.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.DataflowFunction 2 | ( DataflowFunction(..) 3 | , compileDataflowFunction 4 | , _VisualFunction 5 | , _NativeFunction 6 | ) where 7 | 8 | import Prelude 9 | import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, jsonEmptyObject, (.:), (:=), (~>)) 10 | import Data.Lens (Prism', prism') 11 | import Data.Maybe (Maybe(..)) 12 | import Lunarbox.Data.Dataflow.Expression (Expression(..), NativeExpression) 13 | import Lunarbox.Data.Editor.Class.Depends (class Depends, getDependencies) 14 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 15 | import Lunarbox.Data.Editor.Node.PinLocation (ScopedLocation(..)) 16 | import Lunarbox.Data.Editor.NodeGroup (NodeGroup, compileNodeGroup) 17 | 18 | -- A dataflow function can either be: 19 | -- 1) A native function 20 | -- 2) A graph of nodes 21 | data DataflowFunction 22 | = NativeFunction NativeExpression 23 | | VisualFunction NodeGroup 24 | 25 | instance encodeJsonDataflowFunction :: EncodeJson DataflowFunction where 26 | encodeJson (VisualFunction nodeGroup) = "visual" := true ~> "function" := nodeGroup ~> jsonEmptyObject 27 | encodeJson (NativeFunction expression) = jsonEmptyObject 28 | 29 | instance decodeJsonDataflowFunction :: DecodeJson DataflowFunction where 30 | decodeJson json = do 31 | obj <- decodeJson json 32 | nodeGroup <- obj .: "function" 33 | pure $ VisualFunction nodeGroup 34 | 35 | instance dependencyDataflowFunction :: Depends DataflowFunction FunctionName where 36 | getDependencies (NativeFunction _) = mempty 37 | getDependencies (VisualFunction g) = getDependencies g 38 | 39 | compileDataflowFunction :: DataflowFunction -> Expression ScopedLocation 40 | compileDataflowFunction = case _ of 41 | NativeFunction f -> Native InsideNative f 42 | VisualFunction g -> compileNodeGroup g 43 | 44 | -- Lenses 45 | _VisualFunction :: Prism' DataflowFunction NodeGroup 46 | _VisualFunction = 47 | prism' VisualFunction case _ of 48 | VisualFunction f -> Just f 49 | _ -> Nothing 50 | 51 | _NativeFunction :: Prism' DataflowFunction NativeExpression 52 | _NativeFunction = 53 | prism' NativeFunction case _ of 54 | NativeFunction f -> Just f 55 | _ -> Nothing 56 | -------------------------------------------------------------------------------- /src/Data/Route.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Route where 2 | 3 | import Prelude 4 | import Data.Either (Either, note) 5 | import Data.Generic.Rep (class Generic) 6 | import Data.Generic.Rep.Show (genericShow) 7 | import Data.Int (fromString) 8 | import Lunarbox.Data.ProjectId (ProjectId(..)) 9 | import Lunarbox.Data.Tutorial (TutorialId(..)) 10 | import Routing.Duplex (RouteDuplex', as, parse, root, segment) 11 | import Routing.Duplex.Generic (noArgs, sum) 12 | import Routing.Duplex.Generic.Syntax ((/)) 13 | import Routing.Duplex.Parser (RouteError) 14 | 15 | data Route 16 | = Home 17 | | Login 18 | | Register 19 | | Projects 20 | | Project ProjectId 21 | | EditTutorial TutorialId 22 | | Tutorial TutorialId 23 | | Clone ProjectId 24 | 25 | derive instance eqRoute :: Eq Route 26 | 27 | derive instance ordRoute :: Ord Route 28 | 29 | derive instance genericRoute :: Generic Route _ 30 | 31 | instance showRoute :: Show Route where 32 | show = genericShow 33 | 34 | -- | Our codec will cause a compile-time error if we fail to handle any of our route cases. 35 | routingCodec :: RouteDuplex' Route 36 | routingCodec = 37 | root 38 | $ sum 39 | { "Home": noArgs 40 | , "Login": "login" / noArgs 41 | , "Register": "register" / noArgs 42 | , "Projects": "projects" / noArgs 43 | , "EditTutorial": "edit" / "tutorial" / tutorialId segment 44 | , "Project": "edit" / "project" / projectId segment 45 | , "Tutorial": "go" / "tutorial" / tutorialId segment 46 | , "Clone": "go" / "project" / projectId segment 47 | } 48 | 49 | -- This combinator transforms a codec over `String` into one that operatos on the `ProjectId` type. 50 | projectId :: RouteDuplex' String -> RouteDuplex' ProjectId 51 | projectId = as show (map ProjectId <<< note "Cannot parse project id" <<< fromString) 52 | 53 | -- This combinator transforms a codec over `String` into one that operatos on the `ProjectId` type. 54 | tutorialId :: RouteDuplex' String -> RouteDuplex' TutorialId 55 | tutorialId = as show (map TutorialId <<< note "Cannot parse tutorial id" <<< fromString) 56 | 57 | -- Prase a string into a Route 58 | parseRoute :: String -> Either RouteError Route 59 | parseRoute = parse routingCodec 60 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Native/String.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Native.String 2 | ( stringNodes 3 | ) where 4 | 5 | import Prelude 6 | import Data.Array as Array 7 | import Data.String as String 8 | import Lunarbox.Data.Dataflow.Native.NativeConfig (NativeConfig(..)) 9 | import Lunarbox.Data.Dataflow.Runtime.Class.Describable (toNativeExpression) 10 | import Lunarbox.Data.Editor.FunctionData (internal) 11 | import Lunarbox.Data.Editor.FunctionName (FunctionName(..)) 12 | 13 | -- List of all the string native nodes 14 | stringNodes :: Array (NativeConfig) 15 | stringNodes = [ stringLength, concatStrings, reverseString, trimString ] 16 | 17 | stringLength :: NativeConfig 18 | stringLength = 19 | NativeConfig 20 | { name: FunctionName "length" 21 | , expression: toNativeExpression String.length 22 | , functionData: internal [ { name: "string", description: "Any string" } ] { name: "length", description: "The number of characters in the given string" } 23 | } 24 | 25 | concatStrings :: NativeConfig 26 | concatStrings = 27 | NativeConfig 28 | { name: FunctionName "concat strings" 29 | , expression: toNativeExpression ((<>) :: String -> _) 30 | , functionData: 31 | internal 32 | [ { name: "first string", description: "Any string" } 33 | , { name: "second strings", description: "Any string" } 34 | ] 35 | { name: "a ++ b", description: "The result of 'glueing' the strings together" } 36 | } 37 | 38 | reverseString :: NativeConfig 39 | reverseString = 40 | NativeConfig 41 | { name: FunctionName "reverse" 42 | , expression: toNativeExpression $ String.fromCodePointArray <<< Array.reverse <<< String.toCodePointArray 43 | , functionData: internal [ { name: "string", description: "Any string" } ] { name: "reversed string", description: "The given string in reverse" } 44 | } 45 | 46 | trimString :: NativeConfig 47 | trimString = 48 | NativeConfig 49 | { name: FunctionName "trim" 50 | , expression: toNativeExpression String.trim 51 | , functionData: 52 | internal [ { name: "string", description: "Any string" } ] 53 | { name: "trimmed string", description: "The given string but without spaces at the end and at the start" 54 | } 55 | } 56 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Runtime/TermEnvironment.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Runtime.TermEnvironment 2 | ( TermEnvironment(..) 3 | , Term(..) 4 | , lookup 5 | , insert 6 | ) where 7 | 8 | import Prelude 9 | import Data.Argonaut (class DecodeJson, class EncodeJson, decodeJson, encodeJson) 10 | import Data.Default (class Default) 11 | import Data.Map as Map 12 | import Data.Maybe (fromMaybe) 13 | import Data.Newtype (class Newtype, unwrap) 14 | import Lunarbox.Data.Dataflow.Expression (Expression) 15 | import Lunarbox.Data.Dataflow.Runtime (RuntimeValue(..)) 16 | 17 | -- | We use this to be able to store closures 18 | data Term l 19 | = Term RuntimeValue 20 | | Closure (TermEnvironment l) (Expression l) 21 | 22 | derive instance eqTerm :: Eq l => Eq (Term l) 23 | 24 | instance defTerm :: Default (Term l) where 25 | def = Term Null 26 | 27 | instance encodeJsonTerm :: EncodeJson l => EncodeJson (Term l) where 28 | encodeJson (Term val) = encodeJson val 29 | encodeJson _ = encodeJson Null 30 | 31 | instance decodeJsonTerm :: DecodeJson l => DecodeJson (Term l) where 32 | decodeJson = map Term <<< decodeJson 33 | 34 | -- Structure used to store the value of different variables 35 | newtype TermEnvironment l 36 | = TermEnvironment (Map.Map String (Term l)) 37 | 38 | derive instance eqTermEnvironment :: Eq l => Eq (TermEnvironment l) 39 | 40 | derive instance newtypeTermEnvironment :: Newtype (TermEnvironment l) _ 41 | 42 | derive newtype instance semigroupTermEnvironment :: Semigroup l => Semigroup (TermEnvironment l) 43 | 44 | derive newtype instance monoidTermEnvironment :: Monoid (TermEnvironment l) 45 | 46 | derive newtype instance encodeJsonTermEnvironment :: EncodeJson l => EncodeJson (TermEnvironment l) 47 | 48 | derive newtype instance decodeJsonTermEnvironment :: DecodeJson l => DecodeJson (TermEnvironment l) 49 | 50 | -- Same as Map.lookup but returns Null in case the value cannot be found 51 | lookup :: forall l. String -> TermEnvironment l -> Term l 52 | lookup key = fromMaybe (Term Null) <<< Map.lookup key <<< unwrap 53 | 54 | -- Wrapper around Map.insert 55 | insert :: forall l. String -> Term l -> TermEnvironment l -> TermEnvironment l 56 | insert key value (TermEnvironment env) = TermEnvironment $ Map.insert key value env 57 | -------------------------------------------------------------------------------- /flake.lock: -------------------------------------------------------------------------------- 1 | { 2 | "nodes": { 3 | "easy-purescript-nix": { 4 | "flake": false, 5 | "locked": { 6 | "lastModified": 1679861376, 7 | "narHash": "sha256-LLqaLPJNiap2U8I77K5XVPGJA/Be30Z8lyGOyYXmBlc=", 8 | "owner": "justinwoo", 9 | "repo": "easy-purescript-nix", 10 | "rev": "0c10ff170461aed0c336f5c21ed0f430c2c3574b", 11 | "type": "github" 12 | }, 13 | "original": { 14 | "owner": "justinwoo", 15 | "repo": "easy-purescript-nix", 16 | "type": "github" 17 | } 18 | }, 19 | "flake-utils": { 20 | "inputs": { 21 | "systems": "systems" 22 | }, 23 | "locked": { 24 | "lastModified": 1681202837, 25 | "narHash": "sha256-H+Rh19JDwRtpVPAWp64F+rlEtxUWBAQW28eAi3SRSzg=", 26 | "owner": "numtide", 27 | "repo": "flake-utils", 28 | "rev": "cfacdce06f30d2b68473a46042957675eebb3401", 29 | "type": "github" 30 | }, 31 | "original": { 32 | "owner": "numtide", 33 | "repo": "flake-utils", 34 | "type": "github" 35 | } 36 | }, 37 | "nixpkgs": { 38 | "locked": { 39 | "lastModified": 1682339087, 40 | "narHash": "sha256-9ivpuAPj1nuNz9AFnkJaee4MrN4eEYLuLMfvbrws4Cc=", 41 | "owner": "nixos", 42 | "repo": "nixpkgs", 43 | "rev": "72ef7239c3a2a25047aae977b2302802b44cbf8c", 44 | "type": "github" 45 | }, 46 | "original": { 47 | "owner": "nixos", 48 | "ref": "release-22.11", 49 | "repo": "nixpkgs", 50 | "type": "github" 51 | } 52 | }, 53 | "root": { 54 | "inputs": { 55 | "easy-purescript-nix": "easy-purescript-nix", 56 | "flake-utils": "flake-utils", 57 | "nixpkgs": "nixpkgs" 58 | } 59 | }, 60 | "systems": { 61 | "locked": { 62 | "lastModified": 1681028828, 63 | "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", 64 | "owner": "nix-systems", 65 | "repo": "default", 66 | "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", 67 | "type": "github" 68 | }, 69 | "original": { 70 | "owner": "nix-systems", 71 | "repo": "default", 72 | "type": "github" 73 | } 74 | } 75 | }, 76 | "root": "root", 77 | "version": 7 78 | } 79 | -------------------------------------------------------------------------------- /src/Component/Editor/NodePreview.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Editor.NodePreview 2 | ( Query(..) 3 | , Output(..) 4 | , component 5 | ) where 6 | 7 | import Prelude 8 | import Data.Maybe (Maybe(..)) 9 | import Effect.Class (class MonadEffect, liftEffect) 10 | import Halogen (Component, HalogenM, RefLabel(..), defaultEval, gets, mkComponent, mkEval, raise) 11 | import Halogen.HTML as HH 12 | import Halogen.HTML.Properties as HP 13 | import Lunarbox.Component.Utils (className) 14 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 15 | import Lunarbox.Foreign.Render (Context2d, ForeignTypeMap, renderPreview, withContext) 16 | import Record as Record 17 | 18 | data Action 19 | = Init 20 | 21 | type ChildSlots 22 | = () 23 | 24 | type Input r 25 | = ( name :: FunctionName | r ) 26 | 27 | type State 28 | = { | Input ( context :: Maybe Context2d ) } 29 | 30 | data Query a 31 | = Rerender ForeignTypeMap a 32 | 33 | data Output 34 | = RequestRerender 35 | 36 | canvasRef :: FunctionName -> RefLabel 37 | canvasRef id = RefLabel $ "canvas-" <> show id 38 | 39 | component :: forall m. MonadEffect m => Component HH.HTML Query { | Input () } Output m 40 | component = 41 | mkComponent 42 | { initialState: Record.merge { context: Nothing } 43 | , render 44 | , eval: 45 | mkEval 46 | $ defaultEval 47 | { handleAction = handleAction 48 | , handleQuery = handleQuery 49 | , initialize = Just Init 50 | } 51 | } 52 | where 53 | handleAction :: Action -> HalogenM State Action ChildSlots Output m Unit 54 | handleAction = case _ of 55 | Init -> 56 | canvasRef <$> gets _.name 57 | >>= \ref -> 58 | withContext ref \_ -> raise RequestRerender 59 | 60 | handleQuery :: forall a. Query a -> HalogenM State Action ChildSlots Output m (Maybe a) 61 | handleQuery = case _ of 62 | Rerender colorMap result -> do 63 | ref <- canvasRef <$> gets _.name 64 | withContext ref \ctx -> liftEffect $ renderPreview ctx colorMap 65 | pure $ Just result 66 | 67 | -- This only renders the canvas, the rest of the rendering is done via some typescript code 68 | render { name } = 69 | HH.canvas 70 | [ HP.width 75 71 | , HP.height 75 72 | , HP.ref $ canvasRef name 73 | , className "node__preview" 74 | ] 75 | -------------------------------------------------------------------------------- /public/styles/components/loading.scss: -------------------------------------------------------------------------------- 1 | @use "../utils/utils"; 2 | @use "../fonts"; 3 | 4 | // source: https://loading.io/css/ 5 | 6 | .lds-roller { 7 | display: inline-block; 8 | position: relative; 9 | width: 80px; 10 | height: 80px; 11 | } 12 | .lds-roller div { 13 | animation: lds-roller 1.2s cubic-bezier(0.5, 0, 0.5, 1) infinite; 14 | transform-origin: 40px 40px; 15 | } 16 | .lds-roller div:after { 17 | content: " "; 18 | display: block; 19 | position: absolute; 20 | width: 7px; 21 | height: 7px; 22 | border-radius: 50%; 23 | background: #fff; 24 | margin: -4px 0 0 -4px; 25 | } 26 | .lds-roller div:nth-child(1) { 27 | animation-delay: -0.036s; 28 | } 29 | .lds-roller div:nth-child(1):after { 30 | top: 63px; 31 | left: 63px; 32 | } 33 | .lds-roller div:nth-child(2) { 34 | animation-delay: -0.072s; 35 | } 36 | .lds-roller div:nth-child(2):after { 37 | top: 68px; 38 | left: 56px; 39 | } 40 | .lds-roller div:nth-child(3) { 41 | animation-delay: -0.108s; 42 | } 43 | .lds-roller div:nth-child(3):after { 44 | top: 71px; 45 | left: 48px; 46 | } 47 | .lds-roller div:nth-child(4) { 48 | animation-delay: -0.144s; 49 | } 50 | .lds-roller div:nth-child(4):after { 51 | top: 72px; 52 | left: 40px; 53 | } 54 | .lds-roller div:nth-child(5) { 55 | animation-delay: -0.18s; 56 | } 57 | .lds-roller div:nth-child(5):after { 58 | top: 71px; 59 | left: 32px; 60 | } 61 | .lds-roller div:nth-child(6) { 62 | animation-delay: -0.216s; 63 | } 64 | .lds-roller div:nth-child(6):after { 65 | top: 68px; 66 | left: 24px; 67 | } 68 | .lds-roller div:nth-child(7) { 69 | animation-delay: -0.252s; 70 | } 71 | .lds-roller div:nth-child(7):after { 72 | top: 63px; 73 | left: 17px; 74 | } 75 | .lds-roller div:nth-child(8) { 76 | animation-delay: -0.288s; 77 | } 78 | .lds-roller div:nth-child(8):after { 79 | top: 56px; 80 | left: 12px; 81 | } 82 | @keyframes lds-roller { 83 | 0% { 84 | transform: rotate(0deg); 85 | } 86 | 100% { 87 | transform: rotate(360deg); 88 | } 89 | } 90 | 91 | // This is some extra merkup by me to center everything 92 | @import "../theme.scss"; 93 | 94 | .loading-container { 95 | @include utils.center; 96 | 97 | height: 100%; 98 | width: 100%; 99 | 100 | background: $primary; 101 | color: $on-primary; 102 | } 103 | -------------------------------------------------------------------------------- /src/Component/Utils.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Component.Utils 2 | ( OpaqueSlot 3 | , StaticHtml 4 | , className 5 | , container 6 | , busEventSource 7 | , intervalEventSource 8 | , whenElem 9 | , maybeElement 10 | ) where 11 | 12 | import Prelude 13 | import Control.Monad.Rec.Class (forever) 14 | import Data.Maybe (Maybe, maybe) 15 | import Effect.Aff (Milliseconds, delay, error, forkAff, killFiber) 16 | import Effect.Aff.Bus as Bus 17 | import Effect.Aff.Class (class MonadAff, liftAff) 18 | import Halogen (ClassName(..), Slot) 19 | import Halogen.HTML (HTML, IProp) 20 | import Halogen.HTML as HH 21 | import Halogen.HTML.Properties (class_, id_) 22 | import Halogen.Query.EventSource as ES 23 | 24 | -- | When a component has no queries or messages, it has no public interface and can be 25 | -- | considered an "opaque" component. The only way for a parent to interact with the 26 | -- | component is by sending input. 27 | type OpaqueSlot slot 28 | = forall query. Slot query Void slot 29 | 30 | type StaticHtml a b c 31 | = a -> HTML b c 32 | 33 | className :: forall r i. String -> IProp ( class ∷ String | r ) i 34 | className = class_ <<< ClassName 35 | 36 | container :: forall r i. String -> Array (HTML r i) -> HTML r i 37 | container id content = HH.div [ id_ id ] content 38 | 39 | -- Create an event source for the global bsu 40 | busEventSource :: forall m r act. MonadAff m => Bus.BusR' r act -> ES.EventSource m act 41 | busEventSource bus = 42 | ES.affEventSource \emitter -> do 43 | fiber <- forkAff $ forever $ ES.emit emitter =<< Bus.read bus 44 | pure (ES.Finalizer (killFiber (error "Event source closed") fiber)) 45 | 46 | -- | Used so we can run an action at a certain interval 47 | intervalEventSource :: forall m. MonadAff m => Milliseconds -> ES.EventSource m Unit 48 | intervalEventSource time = 49 | ES.affEventSource \emitter -> do 50 | fiber <- 51 | forkAff 52 | $ forever do 53 | liftAff $ delay time 54 | ES.emit emitter unit 55 | pure (ES.Finalizer (killFiber (error "Event source closed") fiber)) 56 | 57 | -- Conditional rendering helper 58 | whenElem :: forall p i. Boolean -> (Unit -> HTML p i) -> HTML p i 59 | whenElem condition f = if condition then f unit else HH.text "" 60 | 61 | -- Unwrap some html from a maybe 62 | maybeElement :: forall p i a. Maybe a -> (a -> HTML p i) -> HTML p i 63 | maybeElement = flip $ maybe $ HH.text "" 64 | -------------------------------------------------------------------------------- /src/Control/Monad/Dataflow/Solve/Unify.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Control.Monad.Dataflow.Solve.Unify 2 | ( unify 3 | , unifyMany 4 | , canUnify 5 | ) where 6 | 7 | import Prelude 8 | import Data.Array as Array 9 | import Data.List (List(..), (:)) 10 | import Data.Map as Map 11 | import Data.Newtype (unwrap) 12 | import Data.Set as Set 13 | import Data.Tuple (snd) 14 | import Lunarbox.Control.Monad.Dataflow.Solve (Solve, SolveContext(..), runSolve, throwTypeError) 15 | import Lunarbox.Data.Dataflow.Class.Substituable (class Substituable, Substitution(..), apply, ftv) 16 | import Lunarbox.Data.Dataflow.Type (TVarName, Type(..)) 17 | import Lunarbox.Data.Dataflow.TypeError (TypeError(..)) 18 | 19 | -- check if a type is recursive 20 | isRecursive :: forall a. Substituable a => TVarName -> a -> Boolean 21 | isRecursive subst t = subst `Set.member` ftv t 22 | 23 | -- Bind a variable to something else in a substitution 24 | bindVariable :: forall l. TVarName -> Type -> Solve l Substitution 25 | bindVariable a t 26 | | t == TVariable false a || t == TVariable true a = pure mempty 27 | | isRecursive a t = throwTypeError $ RecursiveType a t 28 | | otherwise = pure $ Substitution $ Map.singleton a t 29 | 30 | unify :: forall l. Type -> Type -> Solve l Substitution 31 | unify t t' 32 | | t == t' = pure mempty 33 | 34 | unify t@(TVariable false _) (TVariable true v) = bindVariable v t 35 | 36 | unify (TVariable true v) t@(TVariable false _) = bindVariable v t 37 | 38 | unify t (TVariable false v) = bindVariable v t 39 | 40 | unify (TVariable _ v) t = bindVariable v t 41 | 42 | unify t (TVariable _ v) = bindVariable v t 43 | 44 | unify (TConstant name vars) (TConstant name' vars') 45 | | name == name' = unifyMany (Array.toUnfoldable vars) (Array.toUnfoldable vars') 46 | 47 | unify t1 t2 = throwTypeError $ TypeMissmatch t1 t2 48 | 49 | unifyMany :: forall l. List Type -> List Type -> Solve l Substitution 50 | unifyMany Nil Nil = pure mempty 51 | 52 | unifyMany (t : ts) (t' : ts') = do 53 | substitution <- unify t t' 54 | substitution' <- unifyMany (apply substitution $ ts) (apply substitution $ ts') 55 | pure (substitution' <> substitution) 56 | 57 | unifyMany types types' = throwTypeError $ DifferentLength types types' 58 | 59 | -- Check if it's possible to unify 2 types without erroring out 60 | canUnify :: Type -> Type -> Boolean 61 | canUnify type' = ((==) 0) <<< Array.length <<< _.errors <<< unwrap <<< snd <<< runSolve (SolveContext { location: unit }) <<< unify type' 62 | -------------------------------------------------------------------------------- /src/typescript/save.ts: -------------------------------------------------------------------------------- 1 | import type { GeometryCache, NodeId } from "./types/Node" 2 | import type { Mat23Like } from "@thi.ng/matrices" 3 | import type { Vec2Like } from "@thi.ng/vectors" 4 | import { emptyGeometryCache, createNodeGeometry } from "./render" 5 | import { DCons } from "@thi.ng/dcons" 6 | 7 | // The following section is for stuff related to saving / loading caches from / to json 8 | interface SavedData { 9 | camera: Mat23Like 10 | nodes: Array<{ 11 | id: NodeId 12 | position: Vec2Like 13 | hasOutput: boolean 14 | inputCount: number 15 | name: string | null 16 | }> 17 | } 18 | 19 | // Those are here so we can do purescript interop properly 20 | type Either = 21 | | (E & { readonly left: unique symbol }) 22 | | (A & { readonly right: unique symbol }) 23 | 24 | interface EitherConfig { 25 | left: (err: E) => Either 26 | right: (val: A) => Either 27 | } 28 | 29 | /** 30 | * THe opposite of geometryCacheToJson 31 | * 32 | * @param json The json to generate the cache from 33 | */ 34 | export const geometryCacheFromJson = ( 35 | config: EitherConfig 36 | ) => ({ camera, nodes }: SavedData): Either => { 37 | try { 38 | return config.right({ 39 | ...emptyGeometryCache(), 40 | selectedNodes: new Set(), 41 | camera: camera, 42 | zOrder: new DCons(nodes.map(({ id }) => id)), 43 | nodes: new Map( 44 | nodes.map(({ id, position, inputCount, hasOutput, name }) => [ 45 | id, 46 | createNodeGeometry( 47 | position, 48 | inputCount, 49 | // @ts-ignore I use a number as a boolean here which is ok in this context 50 | hasOutput, 51 | name 52 | ) 53 | ]) 54 | ) 55 | }) 56 | } catch (err) { 57 | return config.right(err.message) 58 | } 59 | } 60 | 61 | /** 62 | * Encode a geometry cache as json 63 | * 64 | * @param cache The cache to generate json from 65 | */ 66 | export const geometryCacheToJson = (cache: GeometryCache): SavedData => { 67 | const saved: SavedData = { 68 | camera: cache.camera, 69 | nodes: [...cache.zOrder].map((id) => { 70 | const node = cache.nodes.get(id)! 71 | 72 | return { 73 | id, 74 | position: node.position as Vec2Like, 75 | inputCount: node.inputs[0].attribs!.selectable ? node.inputs.length : 0, 76 | hasOutput: node.output !== null, 77 | name: node.name === null ? null : node.name.value 78 | } 79 | }) 80 | } 81 | 82 | return saved 83 | } 84 | -------------------------------------------------------------------------------- /src/Main.purs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Prelude 4 | 5 | import Data.Either (Either(..)) 6 | import Data.Maybe (Maybe(..)) 7 | import Effect (Effect) 8 | import Effect.Aff (Aff, launchAff_) 9 | import Effect.Aff.Bus as Bus 10 | import Effect.Class (liftEffect) 11 | import Effect.Class.Console (log) 12 | import Effect.Ref as Ref 13 | import Halogen (Component, hoist, tell) 14 | import Halogen.Aff (awaitBody, runHalogenAff) 15 | import Halogen.HTML (HTML) 16 | import Halogen.VDom.Driver (runUI) 17 | import Lunarbox.Api.Request (BaseUrl(..), profile) 18 | import Lunarbox.AppM (runAppM) 19 | import Lunarbox.Component.Router as Router 20 | import Lunarbox.Config (Config(..)) 21 | import Lunarbox.Control.Monad.Effect (printString) 22 | import Lunarbox.Data.Route (parseRoute) 23 | import Routing.PushState (makeInterface, matchesWith) 24 | 25 | main :: Boolean -> String -> Effect Unit 26 | main production apiUrl = 27 | runHalogenAff do 28 | -- Url to make requests to 29 | let 30 | baseUrl :: BaseUrl 31 | baseUrl = BaseUrl apiUrl production 32 | 33 | -- Ref for the current user 34 | currentUser <- liftEffect $ Ref.new Nothing 35 | -- Bus to store the current user profile 36 | userBus <- liftEffect $ Bus.make 37 | -- Request the current suer 38 | responseWithError <- profile baseUrl 39 | case responseWithError of 40 | Left err -> do 41 | printString err 42 | liftEffect $ Ref.write Nothing currentUser 43 | Right user -> do 44 | printString $ "Logged in as " <> show user.username 45 | liftEffect $ Ref.write (Just user) currentUser 46 | -- create a routing interface 47 | nav <- liftEffect makeInterface 48 | -- wait for the body to be created 49 | body <- awaitBody 50 | -- Readonly config readable from anywhere in the app 51 | let 52 | env :: Config 53 | env = 54 | Config 55 | { devOptions: Just { cancelInputsOnBlur: true } 56 | , baseUrl 57 | , pushStateInterface: nav 58 | , allowedNodes: Nothing 59 | , user: 60 | { currentUser 61 | , userBus 62 | } 63 | } 64 | 65 | rootComponent :: Component HTML Router.Query {} Void Aff 66 | rootComponent = hoist (runAppM env) Router.component 67 | halogenIO <- runUI rootComponent {} body 68 | let 69 | onRouteChange = \old new -> 70 | when (old /= Just new) do 71 | launchAff_ $ halogenIO.query $ tell $ Router.Navigate new 72 | void $ liftEffect $ matchesWith parseRoute onRouteChange nav 73 | -------------------------------------------------------------------------------- /src/Control/Monad/Dataflow/Solve.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Control.Monad.Dataflow.Solve 2 | ( Solve(..) 3 | , SolveContext(..) 4 | , SolveState(..) 5 | , _location 6 | , runSolve 7 | , throwTypeError 8 | ) where 9 | 10 | import Prelude 11 | import Control.Monad.Reader (class MonadAsk, class MonadReader, ReaderT, asks, runReaderT) 12 | import Control.Monad.Writer (class MonadTell, class MonadWriter, Writer, runWriter, tell) 13 | import Data.Lens (Lens', view) 14 | import Data.Lens.Record (prop) 15 | import Data.Newtype (class Newtype) 16 | import Data.Symbol (SProxy(..)) 17 | import Data.Tuple (Tuple) 18 | import Lunarbox.Data.Dataflow.TypeError (TypeError) 19 | import Lunarbox.Data.Lens (newtypeIso) 20 | 21 | -- The solver context is the env all solving occurs in. 22 | -- It stores the location the solving occurs at. 23 | newtype SolveContext l 24 | = SolveContext 25 | { location :: l 26 | } 27 | 28 | derive instance newtypeSolveContent :: Newtype (SolveContext l) _ 29 | 30 | _location :: forall l. Lens' (SolveContext l) l 31 | _location = newtypeIso <<< prop (SProxy :: _ "location") 32 | 33 | -- This state keeps track of all the errors 34 | newtype SolveState l 35 | = SolveState 36 | { errors :: Array (TypeError l) 37 | } 38 | 39 | derive instance newtypeSolveState :: Newtype (SolveState l) _ 40 | 41 | derive newtype instance semigroupSolveState :: Semigroup (SolveState l) 42 | 43 | derive newtype instance monoiSolveState :: Monoid (SolveState l) 44 | 45 | -- Monad used to solve type constraints 46 | newtype Solve l a 47 | = Solve (ReaderT (SolveContext l) (Writer (SolveState l)) a) 48 | 49 | -- Takes a Solve monad and returns Either a TyperError or the inner value 50 | runSolve :: forall l a. SolveContext l -> Solve l a -> Tuple a (SolveState l) 51 | runSolve ctx (Solve m) = runWriter $ runReaderT m ctx 52 | 53 | throwTypeError :: forall l a. Monoid a => (l -> TypeError l) -> Solve l a 54 | throwTypeError getError = mempty <$ m 55 | where 56 | m = (asks $ view _location) >>= (tell <<< SolveState <<< { errors: _ } <<< pure <<< getError) 57 | 58 | -- Typeclasses 59 | derive instance newtypeSolve :: Newtype (Solve l a) _ 60 | 61 | derive newtype instance functorSolve :: Functor (Solve l) 62 | 63 | derive newtype instance applySolve :: Apply (Solve l) 64 | 65 | derive newtype instance applicativeSolve :: Applicative (Solve l) 66 | 67 | derive newtype instance bindSolve :: Bind (Solve l) 68 | 69 | derive newtype instance monadSolve :: Monad (Solve l) 70 | 71 | derive newtype instance monadTellSolve :: MonadTell (SolveState l) (Solve l) 72 | 73 | derive newtype instance monadWriterSolve :: MonadWriter (SolveState l) (Solve l) 74 | 75 | derive newtype instance monadAskSolve :: MonadAsk (SolveContext l) (Solve l) 76 | 77 | derive newtype instance monadReaderSolve :: MonadReader (SolveContext l) (Solve l) 78 | -------------------------------------------------------------------------------- /src/Data/Editor/NodeGroup.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.NodeGroup 2 | ( NodeGroup(..) 3 | , compileNodeGroup 4 | , _NodeGroupInputs 5 | , _NodeGroupOutput 6 | , _NodeGroupNodes 7 | ) where 8 | 9 | import Prelude 10 | import Data.Argonaut (class DecodeJson, class EncodeJson) 11 | import Data.Lens (Lens', view) 12 | import Data.Lens.Record (prop) 13 | import Data.List (List, foldMap, foldr, (:), (\\)) 14 | import Data.Map (Map) 15 | import Data.Newtype (class Newtype, unwrap) 16 | import Data.Set as Set 17 | import Data.Symbol (SProxy(..)) 18 | import Lunarbox.Data.Class.GraphRep (toGraph) 19 | import Lunarbox.Data.Dataflow.Expression (Expression(..), VarName(..), functionDeclaration) 20 | import Lunarbox.Data.Editor.Class.Depends (class Depends) 21 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 22 | import Lunarbox.Data.Editor.Node (Node(..), compileNode) 23 | import Lunarbox.Data.Editor.Node.NodeId (NodeId) 24 | import Lunarbox.Data.Editor.Node.PinLocation (ScopedLocation(..)) 25 | import Lunarbox.Data.Graph (topologicalSort) 26 | import Lunarbox.Data.Lens (newtypeIso) 27 | 28 | -- Represents a graph of nodes 29 | newtype NodeGroup 30 | = NodeGroup 31 | { inputs :: List NodeId 32 | , nodes :: Map NodeId Node 33 | , output :: NodeId 34 | } 35 | 36 | derive instance newtypeNodeGroup :: Newtype NodeGroup _ 37 | 38 | derive newtype instance showNodeGroup :: Show NodeGroup 39 | 40 | derive newtype instance encodeJsonNodeGroup :: EncodeJson NodeGroup 41 | 42 | derive newtype instance decodeJsonNodeGroup :: DecodeJson NodeGroup 43 | 44 | instance dependencyNodeGroup :: Depends NodeGroup FunctionName where 45 | getDependencies = 46 | view _NodeGroupNodes 47 | >>> foldMap case _ of 48 | -- Only complex nodes reference other functions so those are the only ones we take into consideration 49 | ComplexNode { function } -> Set.singleton function 50 | _ -> mempty 51 | 52 | compileNodeGroup :: NodeGroup -> Expression ScopedLocation 53 | compileNodeGroup group@(NodeGroup { nodes, output, inputs }) = 54 | let 55 | graph = toGraph nodes 56 | 57 | ordered = topologicalSort graph 58 | 59 | bodyNodes = (ordered \\ (output : inputs)) <> pure output 60 | 61 | return = 62 | foldr 63 | (compileNode graph) 64 | (TypedHole PlaceholderPosition) 65 | bodyNodes 66 | in 67 | functionDeclaration FunctionDeclaration return $ VarName <$> unwrap <$> inputs 68 | 69 | -- Prism 70 | _NodeGroupInputs :: Lens' NodeGroup (List NodeId) 71 | _NodeGroupInputs = newtypeIso <<< prop (SProxy :: _ "inputs") 72 | 73 | _NodeGroupNodes :: Lens' NodeGroup (Map NodeId Node) 74 | _NodeGroupNodes = newtypeIso <<< prop (SProxy :: _ "nodes") 75 | 76 | _NodeGroupOutput :: Lens' NodeGroup NodeId 77 | _NodeGroupOutput = newtypeIso <<< prop (SProxy :: _ "output") 78 | -------------------------------------------------------------------------------- /public/styles/pages/projects.scss: -------------------------------------------------------------------------------- 1 | @use "../utils/utils"; 2 | @use "../fonts"; 3 | 4 | @import "../theme.scss"; 5 | 6 | .projects .left { 7 | filter: contrast(105%) brightness(0.9); 8 | } 9 | 10 | .projects .left img { 11 | width: 100%; 12 | } 13 | 14 | .projects__container { 15 | background: $very-dark; 16 | 17 | padding: 1rem; 18 | box-sizing: border-box; 19 | height: 100vh; 20 | } 21 | 22 | .projects__list { 23 | display: flex; 24 | flex-direction: column; 25 | 26 | height: calc(100vh - 8rem); 27 | overflow-y: auto; 28 | overflow-x: hidden; 29 | } 30 | 31 | .projects__back { 32 | @include utils.center; 33 | 34 | padding: 1rem; 35 | padding-left: 2rem; 36 | padding-right: 2rem; 37 | 38 | cursor: pointer; 39 | color: $on-primary; 40 | 41 | filter: brightness(0.8); 42 | transition: filter $transition-time; 43 | } 44 | 45 | .projects__back:hover { 46 | filter: brightness(1.3); 47 | } 48 | 49 | .projects__search-bar { 50 | border: none; 51 | outline: none; 52 | 53 | background: $primary-dark; 54 | color: $on-dark-pale; 55 | transition: filter $transition-time; 56 | 57 | padding: 0.5rem; 58 | margin: auto; 59 | margin-right: 0; 60 | 61 | &:hover { 62 | filter: brightness(1.7); 63 | } 64 | } 65 | 66 | // Stuff related to individual items in the projects list 67 | .project { 68 | display: flex; 69 | user-select: none; 70 | cursor: pointer; 71 | 72 | margin: 0.4rem; 73 | 74 | padding: 1rem; 75 | box-sizing: border-box; 76 | 77 | color: $on-primary; 78 | box-shadow: 3px 3px 5px 3px $very-dark; 79 | 80 | transition: transform $transition-time; 81 | 82 | &:hover { 83 | transform: scale(0.98); 84 | } 85 | } 86 | 87 | .project__name { 88 | flex-grow: 1; 89 | text-transform: capitalize; 90 | font-size: 1.4rem; 91 | } 92 | 93 | .project__data { 94 | display: flex; 95 | } 96 | 97 | .project__data-item, 98 | .project__data-item { 99 | display: flex; 100 | align-items: center; 101 | margin-right: 1rem; 102 | 103 | .material-icons { 104 | margin-right: 0.2rem; 105 | font-size: 1rem; 106 | } 107 | } 108 | 109 | .project__data-icon { 110 | margin-right: 1rem; 111 | } 112 | 113 | .project__data-icon--clickable { 114 | @include utils.base-input; 115 | 116 | color: inherit; 117 | transition: transform $transition-time; 118 | } 119 | 120 | .project__data-icon--clickable:hover .material-icons { 121 | transform: scale(1.2); 122 | } 123 | 124 | .project--new { 125 | @include utils.center; 126 | background: $primary; 127 | 128 | transition: filter $transition-time; 129 | } 130 | 131 | .project--new:hover { 132 | filter: brightness(1.2); 133 | } 134 | 135 | .project--new .material-icons { 136 | font-size: 2.3rem; 137 | } 138 | -------------------------------------------------------------------------------- /src/Data/Dataflow/Native/Predicate.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Dataflow.Native.Predicate (predicateNodes) where 2 | 3 | import Prelude 4 | import Data.Tuple (Tuple(..)) 5 | import Lunarbox.Data.Dataflow.Expression (NativeExpression(..)) 6 | import Lunarbox.Data.Dataflow.Native.NativeConfig (NativeConfig(..)) 7 | import Lunarbox.Data.Dataflow.Runtime (RuntimeValue(..), binaryFunction) 8 | import Lunarbox.Data.Dataflow.Scheme (Scheme(..)) 9 | import Lunarbox.Data.Dataflow.Type (createTypeVariable, typeBool, typeFunction) 10 | import Lunarbox.Data.Editor.FunctionData (PinDoc, internal) 11 | import Lunarbox.Data.Editor.FunctionName (FunctionName(..)) 12 | 13 | -- All the nodes which test stuff returning booleans 14 | predicateNodes :: Array (NativeConfig) 15 | predicateNodes = [ equal, smallerThan, greaterThan, greaterOrEqual, smallerOrEqual ] 16 | 17 | -- Type for a function which akes 2 values of the same type and returns a boolean 18 | typeBinaryCompare :: Scheme 19 | typeBinaryCompare = Forall [ a ] $ typeFunction typeA $ typeFunction typeA typeBool 20 | where 21 | Tuple a typeA = createTypeVariable "t0" 22 | 23 | -- Helper to generate a config for a predicate of type typeBinaryCompare 24 | createBinaryCompare :: String -> PinDoc -> (RuntimeValue -> RuntimeValue -> Boolean) -> NativeConfig 25 | createBinaryCompare name output predicate = 26 | NativeConfig 27 | { name: FunctionName name 28 | , expression: NativeExpression typeBinaryCompare $ binaryFunction ((Bool <<< _) <<< predicate) 29 | , functionData: internal [ { name: "first value", description: "Any value" }, { name: "second value", description: "Any value" } ] output 30 | } 31 | 32 | -- The actual predicates 33 | equal :: NativeConfig 34 | equal = createBinaryCompare "are equal" { name: "a == b", description: "Return true only if both values are equal" } (==) 35 | 36 | smallerThan :: NativeConfig 37 | smallerThan = 38 | createBinaryCompare "smaller than" 39 | { name: "a < b" 40 | , description: "Compares both values and returns true if the first one is greater than the second" 41 | } 42 | (<) 43 | 44 | greaterThan :: NativeConfig 45 | greaterThan = 46 | createBinaryCompare "greater than" 47 | { name: "a > b" 48 | , description: "Compares both values and returns true if the first one is greater than the second" 49 | } 50 | (>) 51 | 52 | greaterOrEqual :: NativeConfig 53 | greaterOrEqual = 54 | createBinaryCompare "greater or equal" 55 | { name: "a >= b" 56 | , description: "Compares both values and returns true if the first one is greater or equal than the second" 57 | } 58 | (>=) 59 | 60 | smallerOrEqual :: NativeConfig 61 | smallerOrEqual = 62 | createBinaryCompare "smaller or equal" 63 | { name: "a <= b" 64 | , description: "Compares both values and returns true if the first one is smaller or equal than the second" 65 | } 66 | (<=) 67 | -------------------------------------------------------------------------------- /src/Form/Field.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Form.Field where 2 | 3 | import Prelude 4 | import DOM.HTML.Indexed (HTMLinput) 5 | import Data.Maybe (Maybe(..)) 6 | import Data.Newtype (class Newtype) 7 | import Data.Symbol (class IsSymbol) 8 | import Data.Variant (SProxy, Variant) 9 | import Formless as F 10 | import Halogen.HTML as HH 11 | import Halogen.HTML.Events (onClick, onValueInput) 12 | import Halogen.HTML.Properties as HP 13 | import Lunarbox.Component.Utils (className) 14 | import Lunarbox.Form.Validation as V 15 | import Type.Row as Row 16 | 17 | -- Reusable submit button 18 | submit :: forall form act slots m. String -> F.ComponentHTML form act slots m 19 | submit buttonText = 20 | HH.div [ className "submit__container" ] 21 | [ HH.button 22 | [ className "submit__form" 23 | , onClick $ const $ Just F.submit 24 | -- , onClick $ const Nothing 25 | ] 26 | [ HH.text buttonText ] 27 | ] 28 | 29 | -- | Wrapper for any kind of form field 30 | customFormField :: 31 | forall form act slots m sym fields inputs from to t0 t1. 32 | IsSymbol sym => 33 | Newtype (form Record F.FormField) { | fields } => 34 | Newtype (form Variant F.InputFunction) (Variant inputs) => 35 | Row.Cons sym (F.FormField V.FormError from to) t0 fields => 36 | Row.Cons sym (F.InputFunction V.FormError from to) t1 inputs => 37 | SProxy sym -> 38 | form Record F.FormField -> 39 | F.ComponentHTML form act slots m -> 40 | F.ComponentHTML form act slots m 41 | customFormField proxy form content = 42 | HH.div [ className "form__group" ] 43 | [ content 44 | , case (F.getError proxy form) of 45 | Just err -> 46 | HH.div 47 | [ className "form__message--error form__message" ] 48 | [ HH.text $ show err ] 49 | Nothing -> HH.div [ className "form__message--no-error form__message" ] [ HH.text "✔ Everything good" ] 50 | ] 51 | 52 | -- Modified version of https://github.com/thomashoneyman/purescript-halogen-realworld/blob/master/src/Form/Field.purs 53 | input :: 54 | forall form act slots m sym fields inputs out t0 t1. 55 | IsSymbol sym => 56 | Newtype (form Record F.FormField) { | fields } => 57 | Newtype (form Variant F.InputFunction) (Variant inputs) => 58 | Row.Cons sym (F.FormField V.FormError String out) t0 fields => 59 | Row.Cons sym (F.InputFunction V.FormError String out) t1 inputs => 60 | SProxy sym -> 61 | form Record F.FormField -> 62 | Array (HH.IProp HTMLinput (F.Action form act)) -> 63 | F.ComponentHTML form act slots m 64 | input fieldSymbol form props = customFormField fieldSymbol form html 65 | where 66 | html = 67 | HH.input 68 | $ append 69 | [ className "form__field form__field--text" 70 | , HP.value $ F.getInput fieldSymbol form 71 | , onValueInput $ Just <<< F.setValidate fieldSymbol 72 | ] 73 | props 74 | -------------------------------------------------------------------------------- /src/Api/Utils.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Api.Utils 2 | ( authenticate 3 | , mkRequest 4 | , withBaseUrl 5 | , logErrors 6 | , mkRawRequest 7 | ) where 8 | 9 | import Prelude 10 | import Control.Monad.Reader (class MonadAsk, asks) 11 | import Data.Argonaut (class DecodeJson, Json, decodeJson) 12 | import Data.Either (Either(..)) 13 | import Data.Lens (view) 14 | import Data.Maybe (Maybe(..)) 15 | import Effect.Aff.Bus as Bus 16 | import Effect.Aff.Class (class MonadAff, liftAff) 17 | import Effect.Class (class MonadEffect, liftEffect) 18 | import Effect.Ref as Ref 19 | import Lunarbox.Api.Request (BaseUrl, RequestOptions, requestJson) 20 | import Lunarbox.Config (Config, _baseUrl, _user) 21 | import Lunarbox.Control.Monad.Effect (print, printString) 22 | import Lunarbox.Data.Profile (Profile) 23 | 24 | -- Log the error from an Either 25 | logErrors :: forall b m. MonadEffect m => Either String b -> m (Either String b) 26 | logErrors input = case input of 27 | Right result -> pure input 28 | Left error -> printString error *> pure input 29 | 30 | -- Helper to make a request with the baseUrl from the reader monad 31 | mkRequest :: 32 | forall m b. 33 | DecodeJson b => 34 | MonadAff m => 35 | MonadAsk Config m => 36 | RequestOptions -> 37 | m (Either String b) 38 | mkRequest options = do 39 | baseUrl <- asks $ view _baseUrl 40 | response <- requestJson baseUrl options 41 | logErrors $ response >>= decodeJson 42 | 43 | -- Same as mkRequest but doesnt parse the json 44 | mkRawRequest :: 45 | forall m. 46 | MonadAff m => 47 | MonadAsk Config m => 48 | RequestOptions -> 49 | m (Either String Json) 50 | mkRawRequest options = do 51 | baseUrl <- asks $ view _baseUrl 52 | response <- requestJson baseUrl options 53 | logErrors response 54 | 55 | -- Perform a function with the current url from the global config 56 | withBaseUrl :: 57 | forall m b. 58 | DecodeJson b => 59 | MonadAff m => 60 | MonadAsk Config m => 61 | (BaseUrl -> m (Either String b)) -> 62 | m (Either String b) 63 | withBaseUrl req = do 64 | baseUrl <- asks $ view _baseUrl 65 | response <- req baseUrl 66 | logErrors response 67 | 68 | -- Helper to creating functions which request something which return a profile 69 | authenticate :: 70 | forall m a. 71 | MonadAff m => 72 | MonadAsk Config m => 73 | (BaseUrl -> a -> m (Either String Profile)) -> 74 | a -> 75 | m (Either String Profile) 76 | authenticate req fields = do 77 | { currentUser, userBus } <- asks $ view _user 78 | baseUrl <- asks $ view _baseUrl 79 | req baseUrl fields 80 | >>= case _ of 81 | Left error -> printString error *> pure (Left error) 82 | Right profile -> do 83 | print profile 84 | liftEffect $ Ref.write (Just profile) currentUser 85 | -- any time we write to the current user ref, we should also broadcast the change 86 | liftAff $ Bus.write (Just profile) userBus 87 | pure (Right profile) 88 | -------------------------------------------------------------------------------- /src/Config.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Config where 2 | 3 | import Prelude 4 | import Control.Monad.Reader (class MonadAsk, class MonadReader, asks, local) 5 | import Data.Lens (Lens', set) 6 | import Data.Lens.Iso.Newtype (_Newtype) 7 | import Data.Lens.Record (prop) 8 | import Data.Maybe (Maybe(..)) 9 | import Data.Newtype (class Newtype, unwrap) 10 | import Data.Symbol (SProxy(..)) 11 | import Effect (Effect) 12 | import Effect.Aff.Bus (BusRW) 13 | import Effect.Ref (Ref) 14 | import Foreign (Foreign) 15 | import Lunarbox.Api.Request (BaseUrl) 16 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 17 | import Lunarbox.Data.Profile (Profile) 18 | import Routing.PushState (PushStateInterface, LocationState) 19 | 20 | type DevOptions 21 | = Maybe 22 | -- It is usually useful to be able to not cancel -- inputs when bluring off of them for debugging purpouses 23 | -- I needed this so I could take screenshots without the input unfocusing itself 24 | { cancelInputsOnBlur :: Boolean 25 | } 26 | 27 | type UserEnv 28 | = { currentUser :: Ref (Maybe Profile) 29 | , userBus :: BusRW (Maybe Profile) 30 | } 31 | 32 | newtype Config 33 | = Config 34 | { devOptions :: DevOptions 35 | , baseUrl :: BaseUrl 36 | , user :: UserEnv 37 | , pushStateInterface :: PushStateInterface 38 | -- | Specifies what nodes are usable atm 39 | -- TODO: maybe make this not be global? 40 | , allowedNodes :: Maybe (Array FunctionName) 41 | } 42 | 43 | derive instance newtypeConfig :: Newtype Config _ 44 | 45 | shouldCancelOnBlur :: forall m. Monad m => MonadAsk Config m => m Boolean 46 | shouldCancelOnBlur = do 47 | { devOptions } <- asks unwrap 48 | case devOptions of 49 | Just { cancelInputsOnBlur } -> pure cancelInputsOnBlur 50 | Nothing -> pure true 51 | 52 | -- | Run a monadic computation inside a context with a different base url 53 | withBaseUrl :: forall m a. MonadReader Config m => BaseUrl -> m a -> m a 54 | withBaseUrl = local <<< set _baseUrl 55 | 56 | -- Lenses 57 | _user :: Lens' Config UserEnv 58 | _user = _Newtype <<< prop (SProxy :: _ "user") 59 | 60 | _currentUser :: Lens' Config (Ref (Maybe Profile)) 61 | _currentUser = _user <<< prop (SProxy :: _ "currentUser") 62 | 63 | _userBus :: Lens' Config (BusRW (Maybe Profile)) 64 | _userBus = _user <<< prop (SProxy :: _ "userBus") 65 | 66 | _baseUrl :: Lens' Config BaseUrl 67 | _baseUrl = _Newtype <<< prop (SProxy :: _ "baseUrl") 68 | 69 | _allowedNodes :: Lens' Config (Maybe (Array FunctionName)) 70 | _allowedNodes = _Newtype <<< prop (SProxy :: _ "allowedNodes") 71 | 72 | _pushStateInterface :: Lens' Config PushStateInterface 73 | _pushStateInterface = _Newtype <<< prop (SProxy :: _ "pushStateInterface") 74 | 75 | _changeRoute :: Lens' Config (Foreign -> String -> Effect Unit) 76 | _changeRoute = _pushStateInterface <<< prop (SProxy :: _ "pushState") 77 | 78 | _locationState :: Lens' Config (Effect LocationState) 79 | _locationState = _pushStateInterface <<< prop (SProxy :: _ "locationState") 80 | -------------------------------------------------------------------------------- /src/Component/Editor/EditNode.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.EditNode 2 | ( component 3 | , Input 4 | , ChildSlots 5 | ) where 6 | 7 | import Prelude 8 | import Data.Array as Array 9 | import Data.Maybe (Maybe) 10 | import Data.Symbol (SProxy(..)) 11 | import Halogen (Slot, ComponentHTML) 12 | import Halogen.HTML as HH 13 | import Lunarbox.Component.Editor.HighlightedType (highlightTypeToHTML) 14 | import Lunarbox.Component.Editor.NodeUi (hasUi) 15 | import Lunarbox.Component.Editor.NodeUiManager as NodeUiManager 16 | import Lunarbox.Component.Utils (className, maybeElement, whenElem) 17 | import Lunarbox.Data.Dataflow.Runtime (RuntimeValue) 18 | import Lunarbox.Data.Dataflow.Type (Type) 19 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 20 | import Lunarbox.Data.Editor.Node.NodeId (NodeId) 21 | 22 | type ChildSlots r 23 | = ( nodeUi :: Slot NodeUiManager.Query NodeUiManager.Output NodeId 24 | | r 25 | ) 26 | 27 | type Input a 28 | = { description :: Maybe String 29 | , type' :: Maybe Type 30 | , inputs :: 31 | Array 32 | { name :: String 33 | , type' :: Type 34 | , description :: String 35 | } 36 | , function :: FunctionName 37 | , id :: NodeId 38 | , value :: RuntimeValue 39 | , setValue :: RuntimeValue -> Maybe a 40 | } 41 | 42 | -- | The content of the node editing modal 43 | component :: forall a m r. Input a -> ComponentHTML a (ChildSlots r) m 44 | component { description, type', inputs, id, function, value, setValue } = 45 | HH.div [ className "edit-node" ] 46 | [ maybeElement type' \type'' -> 47 | HH.section [ className "edit-node__type" ] 48 | [ HH.text ":: " 49 | , highlightTypeToHTML type'' 50 | ] 51 | , maybeElement description \text -> 52 | HH.section [ className "edit-node__description" ] 53 | [ HH.text text 54 | ] 55 | , whenElem 56 | (not (Array.null inputs)) \_ -> 57 | HH.section [ className "edit-node__inputs" ] 58 | [ HH.h3 [ className "edit-node__inputs-header" ] [ HH.text "Inputs:" ] 59 | , HH.div [ className "edit-node__inputs-list" ] 60 | $ mkInput 61 | <$> inputs 62 | ] 63 | , whenElem (hasUi function) \_ -> 64 | HH.section [ className "edit-node__value" ] 65 | [ HH.div [ className "edit-node__value-lavel" ] [ HH.text "Value:" ] 66 | , HH.slot (SProxy :: SProxy "nodeUi") id 67 | NodeUiManager.component 68 | { name: function, value } 69 | handleNewValues 70 | ] 71 | ] 72 | where 73 | handleNewValues = case _ of 74 | NodeUiManager.NewValue val -> setValue val 75 | 76 | mkInput input = 77 | HH.details [ className "edit-node__input" ] 78 | [ HH.summary [ className "edit-node__input-name" ] 79 | [ HH.text input.name, HH.text " :: ", highlightTypeToHTML input.type' 80 | ] 81 | , HH.div [ className "edit-node__input-description" ] [ HH.text input.description ] 82 | ] 83 | -------------------------------------------------------------------------------- /src/Component/HOC/Connect.purs: -------------------------------------------------------------------------------- 1 | -- This is a little bit modified version of https://github.com/thomashoneyman/purescript-halogen-realworld/blob/master/src/Component/Utils.purs 2 | -- If you're a judge from ie you should probably look somewhere else :D 3 | module Lunarbox.Component.HOC.Connect where 4 | 5 | import Prelude 6 | import Control.Monad.Reader (class MonadAsk, asks) 7 | import Data.Lens (view) 8 | import Data.Maybe (Maybe(..)) 9 | import Data.Symbol (SProxy(..)) 10 | import Effect.Aff.Class (class MonadAff) 11 | import Effect.Ref as Ref 12 | import Halogen (liftEffect) 13 | import Halogen as H 14 | import Halogen.HTML as HH 15 | import Lunarbox.Component.Utils (busEventSource) 16 | import Lunarbox.Config (Config, _user) 17 | import Lunarbox.Data.Profile (Profile) 18 | import Prim.Row as Row 19 | import Record as Record 20 | 21 | data Action input output 22 | = Initialize 23 | | HandleUserBus (Maybe Profile) 24 | | Receive input 25 | | Emit output 26 | 27 | type WithCurrentUser r 28 | = ( currentUser :: Maybe Profile | r ) 29 | 30 | type ChildSlots query output 31 | = ( inner :: H.Slot query output Unit ) 32 | 33 | _inner = SProxy :: SProxy "inner" 34 | 35 | -- | This component can re-use the query type and output type of its child 36 | -- | component because it has no queries or outputs of its own. That makes 37 | -- | it a transparent wrapper around the inner component. 38 | component :: 39 | forall query input output m. 40 | MonadAff m => 41 | MonadAsk Config m => 42 | Row.Lacks "currentUser" input => 43 | H.Component HH.HTML query { | WithCurrentUser input } output m -> 44 | H.Component HH.HTML query { | input } output m 45 | component innerComponent = 46 | H.mkComponent 47 | -- here, we'll insert the current user into the wrapped component's input 48 | -- minus the current user 49 | { initialState: Record.insert (SProxy :: _ "currentUser") Nothing 50 | , render 51 | , eval: 52 | H.mkEval 53 | $ H.defaultEval 54 | { handleAction = handleAction 55 | , handleQuery = handleQuery 56 | , initialize = Just Initialize 57 | , receive = Just <<< Receive 58 | } 59 | } 60 | where 61 | handleAction = case _ of 62 | Initialize -> do 63 | { currentUser, userBus } <- asks $ view _user 64 | _ <- H.subscribe (HandleUserBus <$> busEventSource userBus) 65 | mbProfile <- liftEffect $ Ref.read currentUser 66 | H.modify_ _ { currentUser = mbProfile } 67 | HandleUserBus mbProfile -> H.modify_ _ { currentUser = mbProfile } 68 | Receive input -> do 69 | { currentUser } <- H.get 70 | H.put $ Record.insert (SProxy :: _ "currentUser") currentUser input 71 | Emit output -> H.raise output 72 | 73 | -- We'll simply defer all queries to the existing H.query function, sending 74 | -- to the correct slot. 75 | handleQuery :: forall a. query a -> H.HalogenM _ _ _ _ _ (Maybe a) 76 | handleQuery = H.query _inner unit 77 | 78 | -- We'll simply render the inner component as-is, except with the augmented 79 | -- input containing the current user. 80 | render state = HH.slot _inner unit innerComponent state (Just <<< Emit) 81 | -------------------------------------------------------------------------------- /public/styles/pages/editor/add.scss: -------------------------------------------------------------------------------- 1 | @use "../../utils/utils"; 2 | @import "../../theme.scss"; 3 | 4 | // Stuff related to the footer for adding the inputs. 5 | .node-panel__create-input-button { 6 | background: $primary; 7 | color: white; 8 | 9 | border: none; 10 | outline: none; 11 | 12 | width: 100%; 13 | font-size: 1.5rem; 14 | 15 | padding: 0.6rem; 16 | margin-bottom: 1rem; 17 | 18 | transition: filter $transition-time; 19 | 20 | &:hover { 21 | filter: brightness(1.4); 22 | } 23 | } 24 | 25 | // The actual node data 26 | .nodes { 27 | display: flex; 28 | flex-direction: column; 29 | } 30 | 31 | .node { 32 | display: flex; 33 | align-items: center; 34 | 35 | padding: 0.5rem; 36 | margin-bottom: 1rem; 37 | 38 | transition: filter $transition-time; 39 | 40 | &:hover { 41 | filter: brightness(1.6); 42 | } 43 | } 44 | 45 | .node__data { 46 | display: block; 47 | 48 | flex-grow: 1; 49 | height: 100%; 50 | 51 | margin-left: 1rem; 52 | margin-right: 1rem; 53 | } 54 | 55 | .node__buttons { 56 | display: flex; 57 | flex-direction: column; 58 | 59 | height: 100%; 60 | margin-left: 1rem; 61 | justify-content: space-evenly; 62 | } 63 | 64 | .node__text { 65 | display: flex; 66 | justify-content: space-evenly; 67 | 68 | flex-grow: 1; 69 | flex-direction: column; 70 | 71 | text-overflow: ellipsis; 72 | 73 | & > * { 74 | cursor: default; 75 | user-select: none; 76 | } 77 | } 78 | 79 | .node__type { 80 | font-size: 0.85rem; 81 | } 82 | 83 | .node__data-header { 84 | display: flex; 85 | align-items: center; 86 | } 87 | 88 | .node__data-header .material-icons { 89 | margin-left: 0.5rem; 90 | font-size: 1.3rem; 91 | 92 | cursor: pointer; 93 | filter: none; 94 | 95 | color: rgb(175, 173, 173); 96 | transition: filter $transition-time, scale $transition-time; 97 | 98 | &:hover { 99 | filter: brightness(1.7); 100 | transform: scale(1.2); 101 | } 102 | } 103 | 104 | .node__name { 105 | font-size: 1.4rem; 106 | flex-grow: 1; 107 | 108 | text-transform: capitalize; 109 | } 110 | 111 | // The currying stuff 112 | .node__currying { 113 | display: flex; 114 | align-items: center; 115 | 116 | margin-top: 0.5rem; 117 | font-size: 0.85rem; 118 | 119 | width: 100%; 120 | } 121 | 122 | .node__currying-input { 123 | flex-grow: 1; 124 | width: 100%; 125 | 126 | border: none; 127 | outline: none; 128 | 129 | background: transparent; 130 | color: $on-primary; 131 | 132 | margin-left: 1rem; 133 | border-bottom: 3px solid $on-dark-pale; 134 | } 135 | 136 | // Stuff related to the search input 137 | .node-search { 138 | display: flex; 139 | align-items: center; 140 | 141 | padding: 1rem; 142 | padding-top: 0; 143 | padding-bottom: 0; 144 | 145 | background: $very-dark; 146 | } 147 | 148 | .node-search__input { 149 | @include utils.base-input; 150 | flex-grow: 1; 151 | 152 | margin: 0.6rem; 153 | margin-right: 1rem; 154 | margin-left: 0; 155 | width: 100%; 156 | 157 | font-size: 1.3rem; 158 | 159 | color: $on-primary; 160 | } 161 | -------------------------------------------------------------------------------- /src/Data/Editor/FunctionData.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.FunctionData 2 | ( FunctionData(..) 3 | , PinDoc 4 | , getFunctionData 5 | , internal 6 | , outputData 7 | , displayPinDoc 8 | , _FunctionDataInputs 9 | , _FunctionDataOutput 10 | , _FunctionDataExternal 11 | , _PinName 12 | , _PinDescription 13 | ) where 14 | 15 | import Prelude 16 | import Data.Argonaut (class DecodeJson, class EncodeJson) 17 | import Data.Default (class Default, def) 18 | import Data.Generic.Rep (class Generic) 19 | import Data.Generic.Rep.Show (genericShow) 20 | import Data.Lens (Lens', set) 21 | import Data.Lens.Record (prop) 22 | import Data.Newtype (class Newtype) 23 | import Data.Symbol (SProxy(..)) 24 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 25 | import Lunarbox.Data.Editor.Node (Node(..)) 26 | import Lunarbox.Data.Lens (newtypeIso) 27 | 28 | type PinDoc 29 | = { name :: String 30 | , description :: String 31 | } 32 | 33 | -- Very basic function to print a pindoc out 34 | displayPinDoc :: PinDoc -> String 35 | displayPinDoc { name, description } = "Name: " <> name <> "\nDescription: " <> description 36 | 37 | newtype FunctionData 38 | = FunctionData 39 | { external :: Boolean 40 | , inputs :: Array PinDoc 41 | , output :: PinDoc 42 | } 43 | 44 | derive instance genericFunctionData :: Generic FunctionData _ 45 | 46 | derive instance newtypeFunctionData :: Newtype FunctionData _ 47 | 48 | derive newtype instance encodeJsonFunctionData :: EncodeJson FunctionData 49 | 50 | derive newtype instance decodeJsonFunctionData :: DecodeJson FunctionData 51 | 52 | instance showFunctionData :: Show FunctionData where 53 | show = genericShow 54 | 55 | instance defaultFunctionData :: Default FunctionData where 56 | def = 57 | FunctionData 58 | { external: false 59 | , inputs: mempty 60 | , output: { name: "output", description: "the return value of a function" } 61 | } 62 | 63 | -- Helpers 64 | -- Function data for output nodes 65 | outputData :: FunctionData 66 | outputData = internal [ { name: "return value", description: "The return value of a function" } ] { name: "This node doesn't have an output", description: "" } 67 | 68 | getFunctionData :: (FunctionName -> FunctionData) -> Node -> FunctionData 69 | getFunctionData getter = case _ of 70 | ComplexNode { function } -> getter function 71 | -- TODO: find a good way to handle this 72 | OutputNode _ -> outputData 73 | InputNode -> def 74 | 75 | -- Create data for an internal function 76 | internal :: Array PinDoc -> PinDoc -> FunctionData 77 | internal inputs output = set _FunctionDataOutput output $ set _FunctionDataInputs inputs def 78 | 79 | -- Lenses 80 | _FunctionDataExternal :: Lens' FunctionData Boolean 81 | _FunctionDataExternal = newtypeIso <<< prop (SProxy :: _ "external") 82 | 83 | _FunctionDataInputs :: Lens' FunctionData (Array PinDoc) 84 | _FunctionDataInputs = newtypeIso <<< prop (SProxy :: _ "inputs") 85 | 86 | _FunctionDataOutput :: Lens' FunctionData PinDoc 87 | _FunctionDataOutput = newtypeIso <<< prop (SProxy :: _ "output") 88 | 89 | _PinDescription :: Lens' PinDoc String 90 | _PinDescription = prop (SProxy :: _ "description") 91 | 92 | _PinName :: Lens' PinDoc String 93 | _PinName = prop (SProxy :: _ "name") 94 | -------------------------------------------------------------------------------- /public/styles/pages/home.scss: -------------------------------------------------------------------------------- 1 | @use "sass:math"; 2 | @use "../fonts.scss"; 3 | @use "../utils/utils"; 4 | @import "../theme.scss"; 5 | 6 | /* 7 | The cool thing is the tangent is calculated at compile time. 8 | Thx sass, rly cool. 9 | */ 10 | $angle: -7deg; 11 | $tangent: math.tan($angle); 12 | $bg-height: calc(50vh + #{$tangent} * -50vw); 13 | 14 | #home { 15 | @include utils.stack; 16 | 17 | background: $primary; 18 | height: 100%; 19 | z-index: 1; 20 | 21 | #bg { 22 | @include utils.layer; 23 | 24 | background-color: $primary-dark; 25 | transform-origin: top left; 26 | z-index: -1; 27 | 28 | transform: skewY($angle); 29 | height: $bg-height; 30 | } 31 | 32 | #header { 33 | display: flex; 34 | justify-content: center; 35 | align-items: center; 36 | height: $bg-height; 37 | 38 | #logo { 39 | height: calc(#{$bg-height} - 20rem); 40 | } 41 | } 42 | 43 | #title-text { 44 | @include utils.center; 45 | 46 | font-family: fonts.$oxanium; 47 | 48 | #title { 49 | color: $on-dark; 50 | font-size: 4rem; 51 | } 52 | 53 | #description { 54 | color: rgba($on-dark-pale, 0.7); 55 | font-size: 1.2rem; 56 | } 57 | } 58 | 59 | #cta { 60 | @include utils.center; 61 | 62 | height: calc(100% - #{$bg-height}); 63 | font-family: fonts.$oxanium; 64 | 65 | #cta-text { 66 | color: $on-primary; 67 | filter: brightness(0.8); 68 | max-width: 80vw; 69 | text-align: center; 70 | font-family: fonts.$montserrat; 71 | 72 | #free { 73 | font-weight: bold; 74 | filter: brightness(1.7); 75 | } 76 | } 77 | } 78 | } 79 | 80 | #home #action-buttons { 81 | @include utils.center; 82 | 83 | flex-direction: row; 84 | flex-wrap: wrap; 85 | 86 | button { 87 | font-family: fonts.$oxanium; 88 | margin: 1rem; 89 | padding: 1rem; 90 | font-size: 1.5rem; 91 | width: 10rem; 92 | border: none; 93 | outline: none; 94 | border-radius: 0.3rem; 95 | transition: filter $transition-time, box-shadow $transition-time; 96 | } 97 | 98 | button:hover { 99 | box-shadow: 0.3rem 0.3rem 0.3rem 0.1rem rgba(0, 0, 0, 0.4); 100 | filter: brightness(1.2); 101 | } 102 | 103 | button#primary { 104 | color: white; 105 | background: darken($secondary, 25%); 106 | } 107 | 108 | button#secondary { 109 | background: darken($bright, 15%); 110 | } 111 | 112 | button#logout { 113 | background: transparent; 114 | color: $disabled; 115 | 116 | &:hover { 117 | box-shadow: none; 118 | } 119 | } 120 | 121 | &.user { 122 | flex-direction: column; 123 | 124 | button#logout { 125 | margin: 0; 126 | 127 | &:hover { 128 | filter: brightness(1.5); 129 | } 130 | } 131 | } 132 | } 133 | 134 | #cta-text { 135 | font-size: 3rem; 136 | } 137 | 138 | @media only screen and (max-width: 800px) { 139 | #header { 140 | flex-direction: column; 141 | } 142 | 143 | #cta-text { 144 | font-size: 2.5rem; 145 | } 146 | 147 | #home > #header > #logo { 148 | height: auto; 149 | width: 20rem; 150 | } 151 | } 152 | -------------------------------------------------------------------------------- /src/typescript/components/TextWithBackground.ts: -------------------------------------------------------------------------------- 1 | import type { IToHiccup } from "@thi.ng/api" 2 | import type { TextAttribs, TextElement } from "../types/Hiccup" 3 | import { Vec2Like, add2, mulN2 } from "@thi.ng/vectors" 4 | import { Rect } from "@thi.ng/geom" 5 | 6 | export interface TWBAttribs { 7 | padding: Vec2Like 8 | } 9 | 10 | /** 11 | * Text with colored background. 12 | */ 13 | export class TextWithBackground< 14 | T extends Omit = {}, 15 | U extends Omit = {} 16 | > implements IToHiccup { 17 | private dirty = false 18 | private doublePadding: Vec2Like 19 | public bg = new Rect([0, 0], [0, 0], {}) as Rect & { 20 | attribs: Partial & U 21 | } 22 | 23 | public constructor( 24 | public attribs: Partial> & T, 25 | bgAttribs: Partial & U, 26 | private _value = "", 27 | private _font = "", 28 | public pos: Vec2Like = [0, 0] 29 | ) { 30 | this.bg.attribs = bgAttribs 31 | this.doublePadding = mulN2( 32 | [], 33 | this.bg.attribs.padding ?? [0, 0], 34 | 2 35 | ) as Vec2Like 36 | 37 | if (_font !== "" || _value !== "") { 38 | this.dirty = true 39 | } 40 | } 41 | 42 | private get textElement(): TextElement { 43 | const paddingY = this.bg.attribs.padding?.[1] ?? 0 44 | 45 | return [ 46 | "text", 47 | { ...this.attribs, font: this._font }, 48 | [ 49 | this.pos[0], 50 | this.pos[1] + 51 | (this.attribs.baseline === "baseline" 52 | ? -paddingY 53 | : this.attribs.baseline === "hanging" 54 | ? paddingY 55 | : 0) 56 | ], 57 | this.value 58 | ] 59 | } 60 | 61 | public get value() { 62 | return this._value 63 | } 64 | 65 | public get font() { 66 | return this._font 67 | } 68 | 69 | public set value(value: string) { 70 | this._value = value 71 | this.dirty = true 72 | } 73 | 74 | public set font(font: string) { 75 | this._font = font 76 | this.dirty = true 77 | } 78 | 79 | public resize(ctx: CanvasRenderingContext2D) { 80 | if (!this.dirty) return 81 | 82 | ctx.save() 83 | ctx.font = this._font 84 | 85 | const metrics = ctx.measureText(this._value) 86 | 87 | ctx.restore() 88 | 89 | this.bg.size = [ 90 | metrics.width, 91 | metrics.actualBoundingBoxAscent + metrics.actualBoundingBoxDescent 92 | ] 93 | 94 | add2(null, this.bg.size, this.doublePadding) 95 | 96 | this.refresh() 97 | 98 | this.dirty = false 99 | } 100 | 101 | public refresh() { 102 | if (this.attribs.align === "center") { 103 | this.bg.pos[0] = this.pos[0] - this.bg.size[0] / 2 104 | } 105 | 106 | if (this.attribs.baseline === "baseline") { 107 | this.bg.pos[1] = this.pos[1] - this.bg.size[1] 108 | } else if (this.attribs.baseline === "middle") { 109 | this.bg.pos[1] = this.pos[1] - this.bg.size[1] / 2 110 | } else { 111 | this.bg.pos[1] = this.pos[1] 112 | } 113 | } 114 | 115 | public toHiccup() { 116 | const text = this.textElement 117 | 118 | return ["g", {}, this.bg, text] 119 | } 120 | } 121 | -------------------------------------------------------------------------------- /src/Data/Editor/Location.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.Location 2 | ( Location(..) 3 | , _UnknownLocation 4 | , _Function 5 | , _ScopedLocation 6 | ) where 7 | 8 | import Prelude 9 | import Data.Argonaut (class DecodeJson, class EncodeJson) 10 | import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson) 11 | import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson) 12 | import Data.Default (class Default) 13 | import Data.Generic.Rep (class Generic) 14 | import Data.Lens (Lens', Prism', lens, prism') 15 | import Data.Maybe (Maybe(..)) 16 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 17 | import Lunarbox.Data.Editor.Node.PinLocation (ScopedLocation(..)) 18 | import Lunarbox.Data.String (doubleShow) 19 | 20 | -- Location for stuff in Projects 21 | data Location 22 | = AtFunction FunctionName 23 | | InsideFunction FunctionName ScopedLocation 24 | | AtFunctionDeclaration FunctionName 25 | | FixpointOperator FunctionName 26 | | UnknownLocation 27 | 28 | -- Lenses 29 | _UnknownLocation :: Prism' Location Unit 30 | _UnknownLocation = 31 | prism' (const UnknownLocation) case _ of 32 | UnknownLocation -> Just unit 33 | _ -> Nothing 34 | 35 | _Function :: Lens' Location (Maybe FunctionName) 36 | _Function = 37 | lens 38 | ( case _ of 39 | AtFunction name -> Just name 40 | InsideFunction name _ -> Just name 41 | AtFunctionDeclaration name -> Just name 42 | FixpointOperator name -> Just name 43 | _ -> Nothing 44 | ) 45 | ( \function maybeName -> case maybeName of 46 | Just name -> case function of 47 | UnknownLocation -> UnknownLocation 48 | InsideFunction _ next -> InsideFunction name next 49 | AtFunction _ -> AtFunction name 50 | AtFunctionDeclaration _ -> AtFunctionDeclaration name 51 | FixpointOperator _ -> FixpointOperator name 52 | Nothing -> function 53 | ) 54 | 55 | _ScopedLocation :: Lens' Location (Maybe ScopedLocation) 56 | _ScopedLocation = 57 | lens 58 | ( case _ of 59 | InsideFunction _ location -> Just location 60 | _ -> Nothing 61 | ) 62 | ( \other -> case other of 63 | InsideFunction name _ -> case _ of 64 | Just location -> InsideFunction name location 65 | Nothing -> other 66 | _ -> const other 67 | ) 68 | 69 | -- Typeclass instances 70 | derive instance eqLocation :: Eq Location 71 | 72 | derive instance ordLocation :: Ord Location 73 | 74 | derive instance genericLocation :: Generic Location _ 75 | 76 | instance encodeJsonLocation :: EncodeJson Location where 77 | encodeJson = genericEncodeJson 78 | 79 | instance decodeJsonLocation :: DecodeJson Location where 80 | decodeJson = genericDecodeJson 81 | 82 | instance defaultLocation :: Default Location where 83 | def = UnknownLocation 84 | 85 | instance showLocation :: Show Location where 86 | show (AtFunction name) = "inside function" <> doubleShow name 87 | show (InsideFunction name FunctionDeclaration) = "at the declaration of function " <> doubleShow name 88 | show (InsideFunction name (NodeDefinition id)) = "at node " <> doubleShow id <> " in function " <> doubleShow name 89 | show (InsideFunction name location) = show location <> " in function " <> doubleShow name 90 | show UnknownLocation = "at an unknown location" 91 | show (AtFunctionDeclaration name) = "at the declaration of function " <> doubleShow name 92 | show (FixpointOperator name) = "at the recursion handler for " <> doubleShow name 93 | -------------------------------------------------------------------------------- /src/typescript/types/Node.ts: -------------------------------------------------------------------------------- 1 | import type { Mat23Like } from "@thi.ng/matrices" 2 | import type { Circle, Arc, Line, Rect } from "@thi.ng/geom" 3 | import type { Vec, Vec2 } from "@thi.ng/vectors" 4 | import type { DCons } from "@thi.ng/dcons" 5 | import type { MouseTarget } from "../target" 6 | import type { ADT } from "ts-adt" 7 | import { TextElement } from "./Hiccup" 8 | import { TextWithBackground } from "../components/TextWithBackground" 9 | 10 | /** 11 | * Interface for everything which keeps track of a node. 12 | */ 13 | export interface IHasNode { 14 | node: N 15 | id: NodeId 16 | } 17 | 18 | /** 19 | * Data we need to get to be able to update the way a node looks. 20 | */ 21 | export interface NodeState { 22 | colorMap: { 23 | inputs: Array 24 | output: string | null 25 | } 26 | value: string | null 27 | inputs: Array 28 | } 29 | 30 | /** 31 | * This is basically just a string with a "brand". 32 | * 33 | * The "brand" prop is there to circumvent 34 | * typescript' lack of nominal typing. 35 | */ 36 | export type NodeId = { readonly brand: unique symbol } & string 37 | 38 | /** 39 | * This keeps track of all the display-related stuff of a node. 40 | * Only used on the typescript side. 41 | */ 42 | export interface NodeGeometry { 43 | background: Circle 44 | output: Circle | null 45 | inputs: (Circle | Arc)[] 46 | connections: Line[] 47 | position: Vec 48 | lastState: NodeState | null 49 | inputOverwrites: Record 50 | valueText: TextWithBackground 51 | name: TextWithBackground | null 52 | } 53 | 54 | /** 55 | * Nodes which we are sure have an output geometry 56 | */ 57 | export type NodeWithOutput = NodeGeometry & { 58 | output: NonNullable 59 | } 60 | 61 | /** 62 | * Different tags for the PartialConnection adt. 63 | */ 64 | export const enum PartialKind { 65 | Nothing, 66 | Input, 67 | Output 68 | } 69 | 70 | /** 71 | * We take this as an argument to some stuff so I made a separate type for it. 72 | */ 73 | export type InputPartialConnection = IHasNode & { 74 | index: number 75 | geom: Arc 76 | unconnectable: Set 77 | } 78 | 79 | /** 80 | * Type for the current inputs we cannot connect to. 81 | */ 82 | export type UnconnectableInputs = Set<{ index: number; id: NodeId }> 83 | 84 | /** 85 | * We can either have nothing selected or a kind of pin (input or output). 86 | */ 87 | export type PartialConnection = ADT<{ 88 | [PartialKind.Input]: InputPartialConnection 89 | [PartialKind.Output]: IHasNode & { 90 | unconnectable: UnconnectableInputs 91 | } 92 | [PartialKind.Nothing]: {} 93 | }> 94 | 95 | /** 96 | * A geometry cache is just the state of the display. 97 | * We mutate this as much as we want since it's only being used directly 98 | * on the typescript side of things. All functions interacting with it 99 | * return Effects so we can call them safely from the purescript side. 100 | */ 101 | export type GeometryCache = { 102 | nodes: Map 103 | camera: Mat23Like 104 | // TODO: make this use a single prop 105 | selectedOutput: NodeWithOutput | null 106 | selectedNode: NodeGeometry | null 107 | selectedInput: Arc | null 108 | selectedConnection: Line | null 109 | selectedNodes: Set 110 | zOrder: DCons 111 | dragging: null | MouseTarget 112 | connection: PartialConnection 113 | connectionPreview: Line 114 | } 115 | -------------------------------------------------------------------------------- /src/Data/Editor/Node/PinLocation.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.Editor.Node.PinLocation 2 | ( Pin(..) 3 | , ScopedLocation(..) 4 | , inputNode 5 | , outputNode 6 | ) where 7 | 8 | import Prelude 9 | import Data.Argonaut (class DecodeJson, class EncodeJson) 10 | import Data.Argonaut.Decode.Generic.Rep (genericDecodeJson) 11 | import Data.Argonaut.Encode.Generic.Rep (genericEncodeJson) 12 | import Data.Generic.Rep (class Generic) 13 | import Lunarbox.Data.Dataflow.Expression (Expression(..)) 14 | import Lunarbox.Data.Editor.FunctionName (FunctionName) 15 | import Lunarbox.Data.Editor.Node.NodeId (NodeId) 16 | import Lunarbox.Data.String (showIndex) 17 | 18 | -- A pin can either be an output or an input 19 | data Pin 20 | = InputPin Int 21 | | OutputPin 22 | 23 | derive instance eqPin :: Eq Pin 24 | 25 | derive instance ordPin :: Ord Pin 26 | 27 | derive instance genericPin :: Generic Pin _ 28 | 29 | instance encodeJsonPin :: EncodeJson Pin where 30 | encodeJson = genericEncodeJson 31 | 32 | instance decodeJsonPin :: DecodeJson Pin where 33 | decodeJson = genericDecodeJson 34 | 35 | instance showPin :: Show Pin where 36 | show OutputPin = "output" 37 | show (InputPin index) = "input-" <> show index 38 | 39 | -- This is either the location of a node or the location of a pin 40 | data ScopedLocation 41 | = NodeLocation NodeId 42 | | UnexistingNode NodeId 43 | | NodeDefinition NodeId 44 | | FunctionDeclaration 45 | | PinLocation NodeId Pin 46 | | FunctionUsage NodeId FunctionName 47 | | AtApplication NodeId Int 48 | | InsideNative 49 | | PlaceholderPosition 50 | 51 | derive instance eqScopedLocation :: Eq ScopedLocation 52 | 53 | derive instance ordScopedLocation :: Ord ScopedLocation 54 | 55 | derive instance genericScopedLocation :: Generic ScopedLocation _ 56 | 57 | instance encodeJsonScopedLocation :: EncodeJson ScopedLocation where 58 | encodeJson = genericEncodeJson 59 | 60 | instance decodeJsonScopedLocation :: DecodeJson ScopedLocation where 61 | decodeJson = genericDecodeJson 62 | 63 | instance showScopedLocation :: Show ScopedLocation where 64 | show PlaceholderPosition = "(This position is a placeholder. If you see this then please open an issue on github)" 65 | show InsideNative = "inside a native function" 66 | show FunctionDeclaration = "at the declaration of a function" 67 | show (AtApplication id index) = "at the " <> showIndex index <> " input of node " <> show id 68 | show (NodeDefinition id) = "at definition of node " <> show id 69 | show (FunctionUsage id name) = "at function reference " <> show name <> " in node " <> show name 70 | show (NodeLocation id) = "at node " <> show id 71 | show (UnexistingNode id) = "at node " <> show id <> " which doesn't exist" 72 | show (PinLocation id OutputPin) = "at the output of node " <> show id 73 | show (PinLocation id (InputPin index)) = "at the " <> showIndex index <> " input of node " <> show id 74 | 75 | -- This is an internal function used to both mark a node and one of it's pins 76 | mark :: Pin -> NodeId -> Expression ScopedLocation -> Expression ScopedLocation 77 | mark pin id = Expression location <<< Expression pinLocation 78 | where 79 | location = NodeLocation id 80 | 81 | pinLocation = PinLocation id pin 82 | 83 | -- Wrap an input node and mark the position of it's output 84 | inputNode :: NodeId -> Expression ScopedLocation -> Expression ScopedLocation 85 | inputNode = mark OutputPin 86 | 87 | -- Wrap an output node and mark the positions of it's input 88 | outputNode :: NodeId -> Expression ScopedLocation -> Expression ScopedLocation 89 | outputNode = mark $ InputPin 0 90 | -------------------------------------------------------------------------------- /src/Data/ValidateSolution.purs: -------------------------------------------------------------------------------- 1 | module Lunarbox.Data.ValidateSolution 2 | ( ExpressionPack 3 | , Solution 4 | , SolutionError(..) 5 | , validateSolution 6 | ) where 7 | 8 | import Prelude 9 | import Data.Either (Either(..)) 10 | import Data.List (List(..), (:)) 11 | import Data.List as List 12 | import Data.Traversable (for) 13 | import Effect (Effect) 14 | import Lunarbox.Control.Monad.Dataflow.Solve.Unify (canUnify) 15 | import Lunarbox.Data.Dataflow.Runtime (RuntimeValue(..)) 16 | import Lunarbox.Data.Dataflow.Type (Type(..), inputs, typeBool, typeNumber, typeString) 17 | import Test.QuickCheck (Result(..), arbitrary, checkResults, coarbitrary, quickCheckPure', randomSeed) 18 | import Test.QuickCheck.Gen (Gen, arrayOf, repeatable) 19 | 20 | type ExpressionPack 21 | = { type' :: Type 22 | , value :: RuntimeValue 23 | } 24 | 25 | type Solution 26 | = { current :: ExpressionPack 27 | , intended :: ExpressionPack 28 | } 29 | 30 | -- | Errors which can appear when comparing an users solution 31 | data SolutionError 32 | = DifferentTypes Type Type 33 | | CheckFailures (List String) 34 | 35 | instance showSolutionError :: Show SolutionError where 36 | show (DifferentTypes a b) = "Cannot match type " <> show b <> " with type " <> show a 37 | -- | TODO: handle this in a more elegant way 38 | show (CheckFailures _) = "[quickcheck failures]" 39 | 40 | -- | Same as arbitrary but only generates stuff of the correct type 41 | typeToArbitrary :: Type -> Gen RuntimeValue 42 | typeToArbitrary ty@(TConstant _ _) 43 | | ty == typeNumber = Number <$> arbitrary 44 | | ty == typeString = String <$> arbitrary 45 | | ty == typeBool = Bool <$> arbitrary 46 | 47 | typeToArbitrary ty@(TConstant "Array" [ inner ]) = NArray <$> arrayOf (typeToArbitrary inner) 48 | 49 | typeToArbitrary ty@(TConstant "Function" [ _, to ]) = Function <$> go 50 | where 51 | go = repeatable \a -> coarbitrary a $ typeToArbitrary to 52 | 53 | typeToArbitrary _ = arbitrary 54 | 55 | -- | Validate that a provided solution has the same behavior as the intended one. 56 | validateSolution :: Solution -> Effect (Either SolutionError Unit) 57 | validateSolution { current, intended } 58 | -- | TODO: do more than just unification 59 | | not $ canUnify current.type' intended.type' = 60 | pure 61 | $ Left 62 | $ DifferentTypes current.type' intended.type' 63 | | otherwise = do 64 | result <- go <$> randomSeed 65 | pure 66 | if List.null result.failures then 67 | Right unit 68 | else 69 | Left $ CheckFailures $ _.message <$> result.failures 70 | where 71 | go seed = checkResults $ quickCheckPure' seed 100 prop 72 | 73 | ins = inputs intended.type' 74 | 75 | prop = do 76 | vals <- for ins typeToArbitrary 77 | let 78 | currentVal = callWithVals vals current.value 79 | 80 | intendedVal = callWithVals vals intended.value 81 | pure case currentVal, intendedVal of 82 | Right a, Right b 83 | | a == b -> Success 84 | | otherwise -> Failed err 85 | where 86 | err = show a <> " =/= " <> show b 87 | Left a, _ -> Failed $ "Cannot vall non-function value " <> show a 88 | _, Left a -> Failed $ "Internal error: " <> show a <> " is not a function" 89 | 90 | -- | Try calling a runtime value with an array of inputs 91 | callWithVals :: List RuntimeValue -> RuntimeValue -> Either RuntimeValue RuntimeValue 92 | callWithVals Nil a = Right a 93 | 94 | callWithVals (head : tail) (Function func) = callWithVals tail (func head) 95 | 96 | callWithVals _ func = Left func 97 | --------------------------------------------------------------------------------