| @ -1 +1,15 @@ | |||
| .stack-work/ | |||
| dist-newstyle | |||
| *.hi-boot | |||
| *.o | |||
| *.o-boot | |||
| *.hi | |||
| src/Presyntax/Lexer.hs | |||
| src/Presyntax/Parser.hs | |||
| *.js | |||
| !web/interaction.js | |||
| *.wasm | |||
| cabal.project.local | |||
| @ -0,0 +1,28 @@ | |||
| FUNCTIONS := $(shell grep -R "foreign" src/ | cut -d' ' -f4) | |||
| HS_FILES := $(shell find src -type f -name '*.hs' -or -name '*.hs-boot') | |||
| CABAL_OPTL := $(foreach function,$(FUNCTIONS),--ghc-option=-optl--export-function=$(function)) -f asterius | |||
| AHCD_OPTL := $(foreach function,$(FUNCTIONS),--export-function=$(function)) | |||
| CABAL := ahc-cabal | |||
| AHCD := ahc-dist | |||
| web/dist/cubical.wasm: web/dist/cubical.js | |||
| cp dist-newstyle/cubical.wasm $@ | |||
| web/dist/cubical.js: dist-newstyle/cubical.js | |||
| cp dist-newstyle/cubical.js $@ | |||
| dist-newstyle/cubical.js: dist-newstyle/cubical src/wrapper.mjs | |||
| mkdir -p dist-newstyle/ahcd-spam | |||
| $(AHCD) $(AHCD_OPTL) --input-exe $< --browser --bundle --input-mjs src/wrapper.mjs | |||
| dist-newstyle/cubical: src/Presyntax/Lexer.hs src/Presyntax/Parser.hs $(HS_FILES) | |||
| $(CABAL) v2-install $(CABAL_OPTL) --installdir dist-newstyle exe:cubical --overwrite-policy=always | |||
| src/Presyntax/Lexer.hs: src/Presyntax/Lexer.x | |||
| alex $< | |||
| src/Presyntax/Parser.hs: src/Presyntax/Parser.y | |||
| happy $< | |||
| @ -10,19 +10,25 @@ maintainer: [email protected] | |||
| copyright: 2021 Abigail Magalhães | |||
| category: Web | |||
| build-type: Simple | |||
| cabal-version: >=2.0 | |||
| cabal-version: 2.0 | |||
| extra-source-files: README.md | |||
| flag asterius | |||
| description: Is this build for the web? | |||
| manual: True | |||
| default: False | |||
| executable cubical | |||
| hs-source-dirs: src | |||
| main-is: Main.hs | |||
| default-language: Haskell2010 | |||
| build-depends: base ^>= 4.14 | |||
| build-depends: base >= 4.13 | |||
| , mtl ^>= 2.2 | |||
| , syb ^>= 0.7 | |||
| , text ^>= 1.2 | |||
| , array ^>= 0.5 | |||
| , aeson >= 1.4 | |||
| , containers ^>= 0.6 | |||
| , bytestring ^>= 0.10 | |||
| @ -46,8 +52,14 @@ executable cubical | |||
| , Elab.WiredIn | |||
| , Elab.Eval.Formula | |||
| build-tool-depends: alex:alex >= 3.2.4 && < 4.0 | |||
| , happy:happy >= 1.19.12 && < 2.0 | |||
| -- Asterius wrapper | |||
| , Web | |||
| ghc-options: -Wall -Wextra -Wno-name-shadowing | |||
| if !flag(asterius) | |||
| build-tool-depends: alex:alex >= 3.2.4 && < 4.0 | |||
| , happy:happy >= 1.19.12 && < 2.0 | |||
| if flag(asterius) | |||
| build-depends: asterius-prelude == 0.0.1 | |||
| ghc-options: -Wall -Wextra -Wno-name-shadowing | |||
| @ -0,0 +1,135 @@ | |||
| {-# LANGUAGE CPP #-} | |||
| module Web where | |||
| import Control.Exception.Base | |||
| import Control.Monad.Reader | |||
| import qualified Data.ByteString.Lazy as Bsl | |||
| import qualified Data.Text.Encoding as T | |||
| import qualified Data.Map.Strict as Map | |||
| import qualified Data.Text as T | |||
| import Elab.Eval (zonkIO, force) | |||
| import Elab.Monad | |||
| import Elab | |||
| import Foreign | |||
| import Presyntax.Presyntax | |||
| import Presyntax.Parser | |||
| import Presyntax.Lexer | |||
| import Syntax.Pretty | |||
| import Syntax | |||
| #ifdef ASTERIUS | |||
| import Asterius.Types | |||
| import Asterius.Aeson | |||
| #endif | |||
| parseFromString :: String -> IO (StablePtr [Statement]) | |||
| parseFromString str = do | |||
| case runAlex (Bsl.fromStrict (T.encodeUtf8 inp)) parseProg of | |||
| Right e -> newStablePtr e | |||
| Left e -> throwIO (ErrorCall e) | |||
| where | |||
| inp = T.pack str | |||
| newEnvironment :: IO (StablePtr ElabEnv) | |||
| newEnvironment = newStablePtr =<< emptyEnv | |||
| typeCheckProgram :: StablePtr ElabEnv -> StablePtr [Statement] -> IO (StablePtr ElabEnv) | |||
| typeCheckProgram envP prog = | |||
| do | |||
| prog <- deRefStablePtr prog | |||
| env <- runElab (go prog) =<< deRefStablePtr envP | |||
| newStablePtr env | |||
| where | |||
| go prog = checkProgram prog ask | |||
| getTypeByName :: String -> StablePtr ElabEnv -> IO (StablePtr Value) | |||
| getTypeByName str env = do | |||
| env <- deRefStablePtr env | |||
| case Map.lookup (T.pack str) (nameMap env) of | |||
| Just nm -> newStablePtr (fst (getEnv env Map.! nm)) | |||
| Nothing -> throwIO (NotInScope (Bound (T.pack str) 0)) | |||
| getValueByName :: String -> StablePtr ElabEnv -> IO (StablePtr Value) | |||
| getValueByName str env = do | |||
| env <- deRefStablePtr env | |||
| case Map.lookup (T.pack str) (nameMap env) of | |||
| Just nm -> newStablePtr (snd (getEnv env Map.! nm)) | |||
| Nothing -> throwIO (NotInScope (Bound (T.pack str) 0)) | |||
| classifyValue :: StablePtr Value -> IO String | |||
| classifyValue val = do | |||
| t <- deRefStablePtr val | |||
| pure $ case force t of | |||
| VNe (HData pathcs _) _ | |||
| | pathcs -> "data.higher" | |||
| | otherwise -> "data" | |||
| VNe (HCon _ _) _ -> "constr" | |||
| _ -> "other" | |||
| classifyValueByName :: String -> StablePtr ElabEnv -> IO String | |||
| classifyValueByName str env = do | |||
| env <- deRefStablePtr env | |||
| case Map.lookup (T.pack str) (nameMap env) of | |||
| Just nm -> | |||
| pure $ case force (snd (getEnv env Map.! nm)) of | |||
| VNe (HData pathcs _) _ | |||
| | pathcs -> "constr.data.higher" | |||
| | otherwise -> "constr.data" | |||
| VNe HPCon{} _ -> "constr.higher" | |||
| VNe HCon{} _ -> "constr" | |||
| _ -> "other" | |||
| Nothing -> throwIO $ NotInScope (Bound (T.pack str) 0) | |||
| findDefinition :: String -> StablePtr ElabEnv -> IO (Maybe (Posn, Posn)) | |||
| findDefinition str env = do | |||
| env <- deRefStablePtr env | |||
| case Map.lookup (T.pack str) (nameMap env) of | |||
| Just nm -> pure $ Map.lookup nm (whereBound env) | |||
| Nothing -> throwIO $ NotInScope (Bound (T.pack str) 0) | |||
| zonkAndShowType :: StablePtr Value -> IO String | |||
| zonkAndShowType val = do | |||
| val <- deRefStablePtr val | |||
| val <- zonkIO val | |||
| let str = show . prettyTm . quote $ val | |||
| pure str | |||
| freeHaskellValue :: StablePtr a -> IO () | |||
| freeHaskellValue = freeStablePtr | |||
| #ifdef ASTERIUS | |||
| parseFromStringJs :: JSString -> IO (StablePtr [Statement]) | |||
| parseFromStringJs = parseFromString . fromJSString | |||
| getTypeByNameJs :: JSString -> StablePtr ElabEnv -> IO (StablePtr Value) | |||
| getTypeByNameJs str env = getTypeByName (fromJSString str) env | |||
| getValueByNameJs :: JSString -> StablePtr ElabEnv -> IO (StablePtr Value) | |||
| getValueByNameJs str env = getValueByName (fromJSString str) env | |||
| zonkAndShowTypeJs :: StablePtr Value -> IO JSString | |||
| zonkAndShowTypeJs = fmap toJSString . zonkAndShowType | |||
| classifyValueByNameJs :: JSString -> StablePtr ElabEnv -> IO JSString | |||
| classifyValueByNameJs str env = toJSString <$> classifyValueByName (fromJSString str) env | |||
| findDefinitionJs :: JSString -> StablePtr ElabEnv -> IO JSVal | |||
| findDefinitionJs str env = jsonToJSVal <$> findDefinition (fromJSString str) env | |||
| foreign export javascript parseFromStringJs :: JSString -> IO (StablePtr [Statement]) | |||
| foreign export javascript getTypeByNameJs :: JSString -> StablePtr ElabEnv -> IO (StablePtr Value) | |||
| foreign export javascript getValueByNameJs :: JSString -> StablePtr ElabEnv -> IO (StablePtr Value) | |||
| foreign export javascript classifyValueByNameJs :: JSString -> StablePtr ElabEnv -> IO JSString | |||
| foreign export javascript newEnvironment :: IO (StablePtr ElabEnv) | |||
| foreign export javascript typeCheckProgram :: StablePtr ElabEnv -> StablePtr [Statement] -> IO (StablePtr ElabEnv) | |||
| foreign export javascript zonkAndShowTypeJs :: StablePtr Value -> IO JSString | |||
| foreign export javascript freeHaskellValue :: StablePtr Value -> IO () | |||
| foreign export javascript findDefinitionJs :: JSString -> StablePtr ElabEnv -> IO JSVal | |||
| #endif | |||
| @ -0,0 +1,8 @@ | |||
| import * as rts from "./rts.mjs"; | |||
| import module from "./cubical.wasm.mjs"; | |||
| import req from "./cubical.req.mjs"; | |||
| document.addEventListener('DOMContentLoaded', async () => { | |||
| window.cubical = await module.then(m => rts.newAsteriusInstance(Object.assign(req, {module: m}))) | |||
| document.dispatchEvent(new Event('cubicalLoaded')); | |||
| }); | |||
| @ -0,0 +1,7 @@ | |||
| /node_modules | |||
| /native_modules | |||
| /dist | |||
| *.tsbuildinfo | |||
| !/webpack.config.js | |||
| @ -0,0 +1,13 @@ | |||
| #!/usr/bin/env bash | |||
| if which ahc-cabal &>/dev/null; then | |||
| pushd .. | |||
| make | |||
| popd | |||
| fi | |||
| cp ../intro.tt dist/ -rv | |||
| cp html/* dist/ -rv | |||
| cp styles/* dist/ -rv | |||
| rsync dist/ ${SYNC_SERVER}:/var/www/demo.inductive.properties -avx | |||
| @ -0,0 +1,17 @@ | |||
| <!doctype html> | |||
| <html lang="en"> | |||
| <head> | |||
| <title>cubical</title> | |||
| <meta http-equiv="Content-Type" content="text/html; charset=UTF-8"> | |||
| <link rel="stylesheet" href="/main.css" /> | |||
| <script type="text/javascript" src="/cubical.js"></script> | |||
| <script type="text/javascript" src="/bundle.js"></script> | |||
| </head> | |||
| <body> | |||
| <pre class="editor-container" style="height: 100vh;" src="/intro.tt"></pre> | |||
| </body> | |||
| </html> | |||
| @ -0,0 +1,27 @@ | |||
| { | |||
| "name": "cubical-frontend", | |||
| "version": "1.0.0", | |||
| "description": "Web frontend for cubical", | |||
| "private": true, | |||
| "scripts": { | |||
| "test": "echo \"Error: no test specified\" && exit 1" | |||
| }, | |||
| "repository": { | |||
| "type": "git", | |||
| "url": "https://git.abby.how/abby/cubical" | |||
| }, | |||
| "author": "Abigail", | |||
| "license": "MIT", | |||
| "dev-dependencies": { | |||
| "typescript": "^4.2.3" | |||
| }, | |||
| "devDependencies": { | |||
| "css-loader": "^5.1.3", | |||
| "file-loader": "^6.2.0", | |||
| "monaco-editor-webpack-plugin": "^3.0.1", | |||
| "style-loader": "^2.0.0", | |||
| "ts-loader": "^8.0.18", | |||
| "typescript": "^4.2.3", | |||
| "webpack-cli": "^4.5.0" | |||
| } | |||
| } | |||
| @ -0,0 +1,71 @@ | |||
| import * as monaco from 'monaco-editor'; | |||
| import { CubicalT, Environment, Value } from '../typings/cubical'; | |||
| import * as haskell from '../typings/cubical'; | |||
| let editorNum: number = 0; | |||
| let cubical: CubicalT; | |||
| export const MODEL_ENVS: Record<string, Environment> = {} | |||
| async function reloadModelEnv(model: monaco.editor.ITextModel, environ: Environment): Promise<void> { | |||
| console.log(`reloading environment for model ${model.id}`) | |||
| let code, typed; | |||
| try { | |||
| code = await cubical.exports.parseFromStringJs(model.getValue()); | |||
| typed = await cubical.exports.typeCheckProgram(environ, code); | |||
| MODEL_ENVS[model.id] = typed; | |||
| } catch (e) { | |||
| if (typeof (e) === 'string') | |||
| console.log(e); | |||
| } | |||
| } | |||
| export class CubicalEditor { | |||
| private model: monaco.editor.ITextModel; | |||
| private editor: monaco.editor.IStandaloneCodeEditor; | |||
| private environment: Environment | undefined; | |||
| private uri: monaco.Uri; | |||
| private element: HTMLElement; | |||
| private didChangeLocked: boolean; | |||
| constructor(el: HTMLElement, code: string, uri: monaco.Uri) { | |||
| this.element = el; | |||
| this.uri = uri; | |||
| this.model = monaco.editor.createModel(code, 'cubical', this.uri); | |||
| this.editor = monaco.editor.create(el, { | |||
| model: this.model, | |||
| tabSize: 2, | |||
| insertSpaces: true, | |||
| }) | |||
| this.didChangeLocked = false; | |||
| } | |||
| async load() { | |||
| cubical = await haskell.waitForLoad; | |||
| this.environment = await cubical.exports.newEnvironment(); | |||
| this.model.onDidChangeContent(async (e) => { | |||
| if (this.didChangeLocked) { | |||
| console.log("going too fast"); | |||
| return; | |||
| } | |||
| this.didChangeLocked = true; | |||
| console.log('doing the work') | |||
| // reloadModelEnv(this.model!, this.environment!); | |||
| setTimeout(() => { | |||
| this.didChangeLocked = false; | |||
| }, 1000); | |||
| }); | |||
| this.editor.layout(); | |||
| reloadModelEnv(this.model, this.environment); | |||
| window.addEventListener('resize', () => this.editor.layout()); | |||
| } | |||
| } | |||
| @ -0,0 +1,98 @@ | |||
| import * as monaco from 'monaco-editor'; | |||
| import { CubicalT, Environment, Value } from '../typings/cubical'; | |||
| import * as haskell from '../typings/cubical'; | |||
| import language from './language'; | |||
| import toast from './toast'; | |||
| import { CubicalEditor, MODEL_ENVS } from './editor'; | |||
| let initCode: string[] = [ | |||
| "{-# PRIMITIVE Type #-}", | |||
| "", | |||
| "data Nat : Type where", | |||
| " zero : Nat", | |||
| " succ : Nat -> Nat", | |||
| "", | |||
| "test : Nat", | |||
| "test = succ zero" | |||
| ] | |||
| declare const cubical: CubicalT; | |||
| const LANGUAGE: string = "cubical"; | |||
| monaco.languages.register({ | |||
| id: LANGUAGE | |||
| }); | |||
| monaco.languages.registerHoverProvider(LANGUAGE, { | |||
| provideHover: async (model: monaco.editor.ITextModel, position: monaco.Position, token: monaco.CancellationToken) => { | |||
| const word = model.getWordAtPosition(position); | |||
| if (!word) return; | |||
| try { | |||
| const env: Environment | null = MODEL_ENVS[model.id]; | |||
| if (!env) return null; | |||
| const ty: Value = await cubical.exports.getTypeByNameJs(word.word, env); | |||
| return { | |||
| contents: [{ | |||
| value: await cubical.exports.zonkAndShowTypeJs(ty) | |||
| }] | |||
| } | |||
| } catch (e) { | |||
| return null; | |||
| } | |||
| } | |||
| }); | |||
| monaco.languages.registerDefinitionProvider(LANGUAGE, { | |||
| provideDefinition: async (model: monaco.editor.ITextModel, position: monaco.Position, token: monaco.CancellationToken) => { | |||
| const word = model.getWordAtPosition(position); | |||
| if (!word) return []; | |||
| try { | |||
| const env: Environment | null = MODEL_ENVS[model.id]; | |||
| if (!env) return []; | |||
| const range: haskell.Range | null = await cubical.exports.findDefinitionJs(word.word, env); | |||
| if (range) { | |||
| return [{ | |||
| range: { | |||
| startColumn: range[0].posnColm, | |||
| endColumn: range[1].posnColm, | |||
| startLineNumber: range[0].posnLine, | |||
| endLineNumber: range[1].posnLine, | |||
| }, | |||
| uri: model.uri, | |||
| }]; | |||
| } else { | |||
| return []; | |||
| } | |||
| } catch (e) { | |||
| console.log(e); | |||
| return []; | |||
| } | |||
| } | |||
| }) | |||
| monaco.languages.setMonarchTokensProvider(LANGUAGE, language); | |||
| document.addEventListener('DOMContentLoaded', async () => { | |||
| let editors: CubicalEditor[] = []; | |||
| let n = 0; | |||
| document.querySelectorAll("pre.editor-container").forEach(async (theEl) => { | |||
| let el = theEl as HTMLPreElement; | |||
| let attr = el.getAttribute("src"); | |||
| let text : string; | |||
| if (attr) { | |||
| text = await fetch(attr).then(x => x.text()); | |||
| } else { | |||
| text = el.innerText; | |||
| } | |||
| el.innerText = ''; | |||
| let editor = new CubicalEditor(el, text, monaco.Uri.parse(attr ?? `editor://${n++}`)); | |||
| await editor.load(); | |||
| }) | |||
| }); | |||
| @ -0,0 +1,30 @@ | |||
| import * as monaco from 'monaco-editor'; | |||
| const language: monaco.languages.IMonarchLanguage = { | |||
| ignoreCase: false, | |||
| brackets: [ | |||
| { open: '(', close: ')', token: 'delimiter.parens' }, | |||
| { open: '[', close: ']', token: 'delimiter.square' }, | |||
| { open: '{', close: '}', token: 'delimiter.curly' }, | |||
| ], | |||
| tokenizer: { | |||
| "normal": [ | |||
| [/\{\-#/, 'comment', '@pragma'], | |||
| [/\[/, 'delimiter.square', '@system'], | |||
| [/\-\-.*$/, 'comment'], | |||
| [/\b(data|where|case|as|in|postulate|let|where)\b/, 'keyword'], | |||
| [/(=|:|\-\>|\\)/, 'keyword'] | |||
| ], | |||
| "pragma": [ | |||
| [/PRIMITIVE/, 'keyword'], | |||
| [/#\-\}/, 'comment', '@pop'] | |||
| ], | |||
| "system": [ | |||
| [/\b(i0|i1)/, 'keyword'], | |||
| [/\]/, 'delimiter.square', '@pop'], | |||
| { include: "normal" } | |||
| ] | |||
| } | |||
| }; | |||
| export default language; | |||
| @ -0,0 +1,15 @@ | |||
| export default function toast(duration: number, message: HTMLElement | string): void { | |||
| let element = document.createElement('div'); | |||
| element.classList.add("toast"); | |||
| if (typeof(message) == 'string') { | |||
| element.innerText = message; | |||
| } else { | |||
| element.appendChild(message); | |||
| } | |||
| document.body.appendChild(element); | |||
| setTimeout(() => { | |||
| element.remove(); | |||
| }, duration * 1000); | |||
| } | |||
| @ -0,0 +1,14 @@ | |||
| html { | |||
| padding: 0; | |||
| margin: 0; | |||
| height: 100vh; | |||
| width: 100vw; | |||
| } | |||
| body { | |||
| height: 100%; | |||
| width: 70%; | |||
| margin: auto; | |||
| overflow-x: hidden; | |||
| } | |||
| @ -0,0 +1,33 @@ | |||
| { | |||
| "compilerOptions": { | |||
| "target": "es6", | |||
| "lib": [ | |||
| "dom", | |||
| "dom.iterable", | |||
| "esnext" | |||
| ], | |||
| "outDir": "./dist/", | |||
| "allowJs": true, | |||
| "skipLibCheck": true, | |||
| "esModuleInterop": true, | |||
| "allowSyntheticDefaultImports": true, | |||
| "strict": true, | |||
| "forceConsistentCasingInFileNames": true, | |||
| "noFallthroughCasesInSwitch": true, | |||
| "downlevelIteration": true, | |||
| "module": "esnext", | |||
| "moduleResolution": "node", | |||
| "resolveJsonModule": true, | |||
| "isolatedModules": true, | |||
| "noImplicitAny": true, | |||
| "jsx": "react-jsx", | |||
| "typeRoots": [ | |||
| "./node_modules/@types", | |||
| "./typings" | |||
| ] | |||
| }, | |||
| "include": [ | |||
| "src", | |||
| "typings" | |||
| ] | |||
| } | |||
| @ -0,0 +1,31 @@ | |||
| export class Program { }; | |||
| export class Environment { }; | |||
| export class Value { }; | |||
| export type Posn = { | |||
| posnLine: number, | |||
| posnColm: number | |||
| }; | |||
| export type Range = [Posn, Posn]; | |||
| export type CubicalT = { | |||
| exports: { | |||
| parseFromStringJs(s: string): Promise<Program>; | |||
| newEnvironment(): Promise<Environment>; | |||
| typeCheckProgram(p: Environment, e: Program): Promise<Environment>; | |||
| zonkAndShowTypeJs(val: Value): Promise<string>; | |||
| getTypeByNameJs(name: string, e: Environment): Promise<Value>; | |||
| getValueByNameJs(name: string, e: Environment): Promise<Value>; | |||
| classifyValueByNameJs(name: string, e: Environment): Promise<string>; | |||
| findDefinitionJs(name: string, e: Environment): Promise<Range | null>; | |||
| } | |||
| }; | |||
| export const waitForLoad : Promise<CubicalT> = new Promise(resolve => | |||
| document.addEventListener('cubicalLoaded', () => { | |||
| resolve((window as unknown as { cubical: CubicalT}).cubical) | |||
| })); | |||
| @ -0,0 +1,36 @@ | |||
| const MonacoWebpackPlugin = require('monaco-editor-webpack-plugin'); | |||
| const path = require('path'); | |||
| module.exports = { | |||
| mode: 'development', | |||
| entry: './src/index.ts', | |||
| module: { | |||
| rules: [ | |||
| { | |||
| test: /\.tsx?$/, | |||
| use: 'ts-loader', | |||
| exclude: /node_modules/, | |||
| }, | |||
| { | |||
| test: /\.css$/, | |||
| use: ['style-loader', 'css-loader'] | |||
| }, | |||
| { | |||
| test: /\.ttf$/, | |||
| use: ['file-loader'] | |||
| } | |||
| ], | |||
| }, | |||
| resolve: { | |||
| extensions: ['.tsx', '.ts', '.js'], | |||
| }, | |||
| output: { | |||
| filename: 'bundle.js', | |||
| path: path.resolve(__dirname, 'dist'), | |||
| }, | |||
| plugins: [ | |||
| new MonacoWebpackPlugin({ | |||
| languages: [], | |||
| }) | |||
| ] | |||
| }; | |||