move haskell-tree-sitter-playground

2026-01-11 21:58:37 +00:00 · 2024-05-16 14:30:00 +02:00 · 2024-05-16 14:30:00 +02:00 · 09e455e17e
commit 09e455e17e
parent 2aac085bb8
9 changed files with 362 additions and 103 deletions
--- a/packages/haskell/.gitignore
+++ b/packages/haskell/.gitignore
@ -25,5 +25,3 @@ dist-ssr

 public/tree-sitter.wasm
 public/tree-sitter-haskell.wasm
-public/tree-sitter-haskell_mine.wasm
-public/tree-sitter-haskell_theirs.wasm
--- a/packages/haskell/README.md
+++ b/packages/haskell/README.md
@ -1,31 +1,11 @@
-# @strudel/haskell
+# @strudel/tidal

 This is an experiment in implementing tree-sitter for parsing haskell.

-So far, I have just set up a vite project that imports and inits `web-tree-sitter`, which works after
-
- <https://github.com/tree-sitter/tree-sitter/issues/2831>
- <https://github.com/tree-sitter/tree-sitter/pull/2830>
-
-Running:
-
 ```sh
-cd haskell && pnpm i
+pnpm i
+cd haskell
 pnpm dev
 ```

-will start the vite dev server, loading tree sitter on `http://localhost:5174/`.
-
-The next step is be to generate `tree-sitter-haskell.wasm` file following <https://www.npmjs.com/package/web-tree-sitter#generate-wasm-language-files>.
-
-I've tried to generate it using <https://www.npmjs.com/package/tree-sitter-haskell> but it failed, due to some versioning conflicts involving node / v8 / node-gyp.
-
-It seems a lot of work has gone into this package in <https://github.com/tree-sitter/tree-sitter-haskell/pull/29>, without a new npm package version being released, which is why I've written this comment: <https://github.com/tree-sitter/tree-sitter-haskell/pull/29#issuecomment-1865951565>.
-
-So either someone authorized releases a new version of the package or we might need to pull the changes and try to build it from the tree-sitter master branch.
-
-## Update 1
-
-I've managed to make it work by using [this tree-sitter-haskell.wasm](https://github.com/tree-sitter/tree-sitter-haskell/blob/master/tree-sitter-haskell.wasm), instead of using the version on npm! Make sure both `tree-sitter.wasm` and `tree-sitter-haskell.wasm` are in the public dir, then run `pnpm dev`. The console should log a tree sitter AST string.
-
-Next step: understand how the ast works to then transform it into JS function calls!
+This 
--- a/packages/haskell/graph.mjs
+++ b/packages/haskell/graph.mjs
@ -0,0 +1,43 @@
+import { Graphviz } from '@hpcc-js/wasm';
+import toDot from 'jgf-dot';
+
+const graphvizLoaded = Graphviz.load();
+
+function walk(node, branch = [0], parent) {
+  let nodes = [];
+  let edges = [];
+  const color = 'white';
+  const current = {
+    id: branch.join('-'),
+    color,
+    fontcolor: color,
+    label: node.type.replace('\\', 'lambda'), // backslash kills graphviz..
+  };
+  nodes.push(current);
+  parent && edges.push({ source: parent.id, target: current.id, color });
+  if (node.children.length) {
+    node.children.forEach((child, j) => {
+      const { nodes: childNodes, edges: childEdges } = walk(child, branch.concat([j]), current);
+      nodes = nodes.concat(childNodes || []);
+      edges = edges.concat(childEdges || []);
+    });
+  }
+  return { nodes, edges };
+}
+
+export async function renderGraph(tree, container) {
+  const { nodes, edges } = walk(tree.rootNode);
+  const graphviz = await graphvizLoaded;
+  let dot = toDot({
+    graph: {
+      nodes,
+      edges,
+    },
+  });
+  dot = dot.split('\n');
+  dot.splice(1, 0, 'bgcolor="transparent"');
+  dot.splice(1, 0, 'color="white"');
+  dot = dot.join('\n');
+  const svg = await graphviz.layout(dot, 'svg', 'dot', {});
+  container.innerHTML = svg;
+}
--- a/packages/haskell/hs2js.mjs
+++ b/packages/haskell/hs2js.mjs
@ -0,0 +1,131 @@
+function runApply(node, scope, ops) {
+  if (node.children.length !== 2)
+    throw new Error(`expected 2 children for node type apply, got ${node.children.length}`);
+  const [fn, arg] = node.children.map((child) => run(child, scope, ops));
+  if (typeof fn !== 'function') {
+    throw new Error(`${node.children[0].text} is not a function`);
+  }
+  // only works if fn is curried!
+  return fn(arg);
+}
+
+function runInfix(left, symbol, right, ops) {
+  const customOp = ops[symbol];
+  if (customOp) {
+    return customOp(left, right);
+  }
+  switch (symbol) {
+    case '+':
+      return left + right;
+    case '-':
+      return left - right;
+    case '*':
+      return left * right;
+    case '/':
+      return left / right;
+    case '$':
+      return left(right);
+    case '&':
+      console.log('right', right);
+      return right(left);
+    case '.':
+      return (x) => left(right(x));
+    default:
+      throw new Error('unexpected infix operator ' + symbol);
+  }
+}
+
+function curry(patterns, body, scope, ops) {
+  const [variable, ...rest] = patterns;
+  return (arg) => {
+    let _scope = { ...scope, [variable.text]: arg };
+    if (patterns.length === 1) {
+      const result = run(body, _scope, ops);
+      return result;
+    }
+    return curry(rest, body, _scope, ops);
+  };
+}
+
+export function run(node, scope, ops = {}) {
+  let runInScope = (node, scp = scope) => run(node, scp, ops);
+  //console.log("node", node.type, node.text);
+  switch (node.type) {
+    case 'ERROR':
+      throw new Error(`invalid syntax: "${node.text}"`);
+    case 'declarations':
+      let result;
+      node.children.forEach((declaration) => {
+        result = runInScope(declaration);
+      });
+      return result;
+    case 'integer':
+      return Number(node.text);
+    case 'float':
+      return Number(node.text);
+    case 'string':
+      const str = node.text.slice(1, -1);
+      return String(str);
+    case 'lambda':
+      const [_, lpatterns, __, lbody] = node.children;
+      return curry(lpatterns.children, lbody, scope, ops);
+    case 'function':
+      const [fvariable, fpatterns, fbody] = node.children;
+      scope[fvariable.text] = curry(fpatterns.children, fbody, scope, ops);
+      return scope[fvariable.text];
+    case 'list': {
+      return node.children
+        .filter((_, i) => i % 2 === 1) // elements are at odd indices
+        .map((node) => runInScope(node));
+    }
+    case 'match':
+      if (node.children[0].text !== '=' || node.children.length !== 2) {
+        throw new Error('match node so far only support simple assignments');
+      }
+      return runInScope(node.children[1]);
+    case 'bind':
+      if (node.children.length !== 2) throw new Error('expected 2 children for node type bind');
+      if (node.children[0].type !== 'variable') throw new Error('expected variable as first child of bind node');
+      if (node.children[1].type !== 'match') throw new Error('expected match as first child of bind node');
+      const [bvariable, bmatch] = node.children;
+      const value = runInScope(bmatch);
+      scope[bvariable.text] = value;
+      return value;
+    case 'variable':
+      return scope[node.text];
+    case 'infix': {
+      const [a, op, b] = node.children;
+      const symbol = op.text;
+      const [left, right] = [runInScope(a), runInScope(b)];
+      return runInfix(left, symbol, right, ops);
+    }
+    case 'apply':
+      return runApply(node, scope, ops);
+    case 'left_section': {
+      const [_, b, op] = node.children;
+      const right = runInScope(b);
+      return (left) => runInfix(left, op.text, right, ops);
+    }
+    case 'right_section': {
+      const [_, op, b] = node.children;
+      const right = runInScope(b);
+      return (left) => runInfix(left, op.text, right, ops);
+    }
+    case 'parens':
+      if (node.children.length !== 3) throw new Error('expected 3 children for node type parens');
+      return runInScope(node.children[1]);
+    default:
+      if (node.children.length === 0) {
+        throw new Error('unhandled leaf type ' + node.type);
+      }
+      if (node.children.length > 1) {
+        throw new Error('unhandled branch type ' + node.type);
+      }
+      return runInScope(node.children[0]);
+  }
+}
+
+export async function evaluate(haskellCode, scope = globalThis, ops) {
+  const ast = await parse(haskellCode);
+  return run(ast.rootNode, scope, ops);
+}
--- a/packages/haskell/index.html
+++ b/packages/haskell/index.html
@ -2,13 +2,28 @@
 <html lang="en">
  <head>
    <meta charset="UTF-8" />
-    <link rel="icon" type="image/svg+xml" href="/vite.svg" />
    <meta name="viewport" content="width=device-width, initial-scale=1.0" />
    <title>Tree sitter test</title>
+    <style>
+      body {
+        background-color: #121213;
+        color: white;
+      }
+      textarea {
+        padding: 10px;
+        color: white;
+        background-color: transparent;
+        outline: none;
+      }
+      a {
+        color: white;
+      }
+    </style>
  </head>
-  <body style="padding: 0; margin: 0">
-    <textarea id="code" style="width: 100%; height: 100px"></textarea>
-    <div id="graph" style="display: flex; width: 100%"></div>
+  <body style="margin: 0; padding: 0">
+    <textarea id="code" style="width: 100%; height: 200px"></textarea>
+    <pre id="result"></pre>
+    <div id="graph" style="display: flex; width: 100%; margin: auto; justify-content: center"></div>
    <script type="module" src="/main.js"></script>
  </body>
 </html>
--- a/packages/haskell/main.js
+++ b/packages/haskell/main.js
@ -1,51 +1,89 @@
-import Parser from 'web-tree-sitter';
-import toDot from 'jgf-dot';
-import { Graphviz } from '@hpcc-js/wasm';
+import { run } from './hs2js.mjs';
+import { renderGraph } from './graph.mjs';
+import { parse } from './parser.mjs';
+import { initStrudel, reify, late } from '@strudel/web';
+initStrudel({
+  prebake: () => samples('github:tidalcycles/dirt-samples'),
+});

-const graphvizLoaded = Graphviz.load();
-const parserLoaded = loadParser();
 const graphContainer = document.getElementById('graph');

 const textarea = document.getElementById('code');
-textarea.value = 'd1 $ s "hh(3,8)"';
-textarea.addEventListener('input', (e) => renderGraph(e.target.value, graphContainer));
-renderGraph(textarea.value, graphContainer);
+if (window.location.hash) {
+  textarea.value = atob(window.location.hash.slice(1));
+} else {
+  textarea.value = 'd1 $ s "jvbass(3,8)"';
+}
+textarea.addEventListener('input', (e) => {
+  window.location.hash = btoa(e.target.value);
+  update();
+});
+update();

-function walk(node, branch = [0], parent) {
-  let nodes = [];
-  let edges = [];
-  const current = { id: branch.join('-'), label: node.type };
-  nodes.push(current);
-  parent && edges.push({ source: parent.id, target: current.id });
-  if (node.children.length) {
-    node.children.forEach((child, j) => {
-      const { nodes: childNodes, edges: childEdges } = walk(child, branch.concat([j]), current);
-      nodes = nodes.concat(childNodes || []);
-      edges = edges.concat(childEdges || []);
+function getInfixOperators() {
+  let operators = {
+    '>': 'set',
+    '#': 'set',
+    '+': 'add',
+    '-': 'sub',
+    '*': 'mul',
+    '/': 'div',
+  };
+  let alignments = {
+    in: (s) => '|' + s,
+    out: (s) => s + '|',
+    mix: (s) => '|' + s + '|',
+  };
+  let ops = {};
+  Object.entries(operators).forEach(([o, name]) => {
+    // operator without alignment
+    ops[o] = (l, r) => reify(l)[name](reify(r));
+    Object.entries(alignments).forEach(([a, getSymbol]) => {
+      // get symbol with alignment
+      let symbol = getSymbol(o);
+      ops[symbol] = (l, r) => reify(l)[name][a](reify(r));
    });
-  }
-  return { nodes, edges };
-}
-
-async function renderGraph(code, container) {
-  const parser = await parserLoaded;
-  const tree = parser.parse(code);
-  const { nodes, edges } = walk(tree.rootNode);
-  const graphviz = await graphvizLoaded;
-  const dot = toDot({
-    graph: {
-      nodes,
-      edges,
-    },
  });
-  const svg = await graphviz.layout(dot, 'svg', 'dot');
-  container.innerHTML = svg;
+  ops['~>'] = (l, r) => reify(l).late(reify(r));
+  ops['<~'] = (l, r) => reify(l).early(reify(r));
+  ops['<$>'] = (l, r) => reify(r).fmap(l).outerJoin(); // is this right?
+  return ops;
 }
+const ops = getInfixOperators();

-async function loadParser() {
-  await Parser.init();
-  const parser = new Parser();
-  const Lang = await Parser.Language.load('tree-sitter-haskell.wasm');
-  parser.setLanguage(Lang);
-  return parser;
+async function update() {
+  let result, tree;
+  try {
+    tree = await parse(textarea.value);
+  } catch (err) {
+    console.warn('parse error');
+    console.error(err);
+  }
+  console.log('parsed tree');
+  console.log(tree.rootNode.toString());
+  try {
+    renderGraph(tree, graphContainer);
+  } catch (err) {
+    console.warn('could not render graph');
+    console.error(err);
+  }
+  try {
+    let patterns = {};
+    window.p = (name, pattern) => {
+      patterns[name] = pattern;
+    };
+    window.d1 = (pat) => window.p(1, pat);
+    window.d2 = (pat) => window.p(2, pat);
+    window.d3 = (pat) => window.p(3, pat);
+    window.rot = late;
+    result = run(tree.rootNode, window, ops);
+    if (Object.values(patterns).length) {
+      stack(...Object.values(patterns)).play();
+    }
+  } catch (err) {
+    console.warn('eval error');
+    console.error(err);
+    result = 'ERROR: ' + err.message;
+  }
+  document.getElementById('result').innerHTML = 'Result: ' + result;
 }
--- a/packages/haskell/package.json
+++ b/packages/haskell/package.json
@ -1,24 +1,42 @@
 {
-  "name": "haskell",
+  "name": "@strudel/tidal",
  "private": true,
-  "version": "0.0.0",
+  "version": "0.0.1",
  "type": "module",
  "scripts": {
    "dev": "vite",
    "build": "vite build",
    "preview": "vite preview",
-    "postinstall": "cp node_modules/web-tree-sitter/tree-sitter.wasm public",
-    "parse": "tree-sitter parse -D ./test.hs"
+    "postinstall": "cp node_modules/web-tree-sitter/tree-sitter.wasm public && npm run build:parser",
+    "build:parser": "tree-sitter build-wasm node_modules/tree-sitter-haskell && mv tree-sitter-haskell.wasm public"
  },
-  "devDependencies": {
-    "tree-sitter": "^0.20.6",
-    "tree-sitter-cli": "^0.20.8",
-    "tree-sitter-javascript": "^0.20.1",
-    "vite": "^5.0.8"
+  "repository": {
+    "type": "git",
+    "url": "git+https://github.com/tidalcycles/strudel.git"
  },
+  "keywords": [
+    "titdalcycles",
+    "strudel",
+    "pattern",
+    "livecoding",
+    "algorave"
+  ],
+  "author": "Felix Roos <flix91@gmail.com>",
+  "license": "AGPL-3.0-or-later",
+  "bugs": {
+    "url": "https://github.com/tidalcycles/strudel/issues"
+  },
+  "homepage": "https://github.com/tidalcycles/strudel#readme",
  "dependencies": {
    "@hpcc-js/wasm": "^2.15.3",
    "jgf-dot": "^1.1.1",
-    "web-tree-sitter": "^0.20.8"
+    "web-tree-sitter": "^0.22.6",
+    "tree-sitter-haskell": "^0.21.0",
+    "@strudel/web": "workspace:*"
+  },
+  "devDependencies": {
+    "tree-sitter": "^0.21.1",
+    "tree-sitter-cli": "^0.20.8",
+    "vite": "^5.0.8"
  }
 }
--- a/packages/haskell/parser.mjs
+++ b/packages/haskell/parser.mjs
@ -0,0 +1,22 @@
+import Parser from 'web-tree-sitter';
+
+const base = import.meta.env.BASE_URL;
+
+async function loadParser() {
+  await Parser.init({
+    locateFile(scriptName, scriptDirectory) {
+      return `${base}${scriptName}`;
+    },
+  });
+  const parser = new Parser();
+  const Lang = await Parser.Language.load(`${base}tree-sitter-haskell.wasm`);
+  parser.setLanguage(Lang);
+  return parser;
+}
+
+let parserLoaded = loadParser();
+export async function parse(code) {
+  const parser = await parserLoaded;
+  // for some reason, the parser doesn't like new lines..
+  return parser.parse(code.replaceAll('\n\n', '~~~~').replaceAll('\n', '').replaceAll('~~~~', '\n'));
+}
--- a/pnpm-lock.yaml
+++ b/pnpm-lock.yaml
@ -256,22 +256,25 @@ importers:
      '@hpcc-js/wasm':
        specifier: ^2.15.3
        version: 2.16.2
+      '@strudel/web':
+        specifier: workspace:*
+        version: link:../web
      jgf-dot:
        specifier: ^1.1.1
        version: 1.1.1
+      tree-sitter-haskell:
+        specifier: ^0.21.0
+        version: 0.21.0(tree-sitter@0.21.1)
      web-tree-sitter:
-        specifier: ^0.20.8
-        version: 0.20.8
+        specifier: ^0.22.6
+        version: 0.22.6
    devDependencies:
      tree-sitter:
-        specifier: ^0.20.6
-        version: 0.20.6
+        specifier: ^0.21.1
+        version: 0.21.1
      tree-sitter-cli:
        specifier: ^0.20.8
        version: 0.20.8
-      tree-sitter-javascript:
-        specifier: ^0.20.1
-        version: 0.20.4
      vite:
        specifier: ^5.0.8
        version: 5.2.2(@types/node@20.10.6)
@ -10660,10 +10663,6 @@ packages:
      thenify-all: 1.6.0
    dev: false

-  /nan@2.19.0:
-    resolution: {integrity: sha512-nO1xXxfh/RWNxfd/XPfbIfFk5vgLsAxUR9y5O0cHMJu/AW9U95JLXqthYHjEp+8gQ5p96K9jUp8nbVOxCdRbtw==}
-    dev: true
-
  /nanoid@3.3.7:
    resolution: {integrity: sha512-eSRppjcPIatRIMC1U6UngP8XFcz8MQWGQdt1MTBQ7NaAmvXDfvNxbvWV3x2y6CdEUciCSsDHDQZbhYaB8QEo2g==}
    engines: {node: ^10 || ^12 || ^13.7 || ^14 || >=15.0.1}
@ -10719,6 +10718,10 @@ packages:
      semver: 7.5.4
    dev: true

+  /node-addon-api@8.0.0:
+    resolution: {integrity: sha512-ipO7rsHEBqa9STO5C5T10fj732ml+5kLN1cAG8/jdHd56ldQeGj3Q7+scUS+VHK/qy1zLEwC4wMK5+yM0btPvw==}
+    engines: {node: ^18 || ^20 || >= 21}
+
  /node-domexception@1.0.0:
    resolution: {integrity: sha512-/jKZoMpw0F8GRwl4/eLROPA3cfcXtLApP0QzLmUT/HuPCZWyB7IY9ZrMeKw2O/nFIqPQB3PVM9aYm0F312AXDQ==}
    engines: {node: '>=10.5.0'}
@ -10762,6 +10765,10 @@ packages:
    engines: {node: '>= 0.6.0'}
    dev: false

+  /node-gyp-build@4.8.1:
+    resolution: {integrity: sha512-OSs33Z9yWr148JZcbZd5WiAXhh/n9z8TxQcdMhIOlpN9AhWpLfvVFO73+m77bBABQMaY9XSvIa+qk0jlI7Gcaw==}
+    hasBin: true
+
  /node-gyp@10.0.1:
    resolution: {integrity: sha512-gg3/bHehQfZivQVfqIyy8wTdSymF9yTyP4CJifK73imyNMU8AIGQE2pUa7dNWfmMeG9cDVF2eehiRMv0LC1iAg==}
    engines: {node: ^16.14.0 || >=18.0.0}
@ -13497,20 +13504,27 @@ packages:
    requiresBuild: true
    dev: true

-  /tree-sitter-javascript@0.20.4:
-    resolution: {integrity: sha512-7IUgGkZQROI7MmX2ErKhE3YP4+rM2qwBy5JeukE7fJQMEYP9nHpxvuQpa+eOX+hE1im2pWVc1yDCfVKKCBtxww==}
+  /tree-sitter-haskell@0.21.0(tree-sitter@0.21.1):
+    resolution: {integrity: sha512-b2RLegPHuYPh7nJ3YKWgkWnFYxmYlQDE8TDJuNH+iuNuBcCMYyaA9JlJlMHfCvf7DmJNPtqqbO9Kh9NXEmbatQ==}
    requiresBuild: true
+    peerDependencies:
+      tree-sitter: ^0.21.0
+      tree_sitter: '*'
+    peerDependenciesMeta:
+      tree_sitter:
+        optional: true
    dependencies:
-      nan: 2.19.0
-    dev: true
+      node-addon-api: 8.0.0
+      node-gyp-build: 4.8.1
+      tree-sitter: 0.21.1
+    dev: false

-  /tree-sitter@0.20.6:
-    resolution: {integrity: sha512-GxJodajVpfgb3UREzzIbtA1hyRnTxVbWVXrbC6sk4xTMH5ERMBJk9HJNq4c8jOJeUaIOmLcwg+t6mez/PDvGqg==}
+  /tree-sitter@0.21.1:
+    resolution: {integrity: sha512-7dxoA6kYvtgWw80265MyqJlkRl4yawIjO7S5MigytjELkX43fV2WsAXzsNfO7sBpPPCF5Gp0+XzHk0DwLCq3xQ==}
    requiresBuild: true
    dependencies:
-      nan: 2.19.0
-      prebuild-install: 7.1.1
-    dev: true
+      node-addon-api: 8.0.0
+      node-gyp-build: 4.8.1

  /trim-lines@3.0.1:
    resolution: {integrity: sha512-kRj8B+YHZCc9kQYdWfJB2/oUl9rA99qbowYYBtr4ui4mZyAQ2JpvVBd/6U2YloATfqBhBTSMhTpgBHtU0Mf3Rg==}
@ -14306,8 +14320,8 @@ packages:
    engines: {node: '>= 8'}
    dev: true

-  /web-tree-sitter@0.20.8:
-    resolution: {integrity: sha512-weOVgZ3aAARgdnb220GqYuh7+rZU0Ka9k9yfKtGAzEYMa6GgiCzW9JjQRJyCJakvibQW+dfjJdihjInKuuCAUQ==}
+  /web-tree-sitter@0.22.6:
+    resolution: {integrity: sha512-hS87TH71Zd6mGAmYCvlgxeGDjqd9GTeqXNqTT+u0Gs51uIozNIaaq/kUAbV/Zf56jb2ZOyG8BxZs2GG9wbLi6Q==}
    dev: false

  /webidl-conversions@3.0.1: