git.fiddlerwoaroof.com
Browse code

(init)

Ed Langley authored on 25/06/2020 17:11:52
Showing 10 changed files
.gitignore
History View file @ a5523e3
1 1 
new file mode 100644
... ... 
@@ -0,0 +1,2 @@
1 
+*~
2 
+*.sw?
files/api.js
History View file @ a5523e3
0 3 
new file mode 100644
... ... 
@@ -0,0 +1,11 @@
1 
+export function selectPackage(dispatchers, pkg) {
2 
+  fetch(`/packages/${pkg}`)
3 
+    .then((v) => v.json())
4 
+    .then((it) => dispatchers.updateSymbols(pkg, it));
5 
+}
6 
+
7 
+export function updatePackages(dispatchers) {
8 
+  fetch("/packages")
9 
+    .then((v) => v.json())
10 
+    .then((it) => dispatchers.updatePackages(it));
11 
+}
files/components.js
History View file @ a5523e3
0 12 
new file mode 100644
... ... 
@@ -0,0 +1,62 @@
1 
+import {
2 
+  html,
3 
+  render,
4 
+} from "https://unpkg.com/lit-html@1.2.1/lit-html.js?module";
5 
+
6 
+const PackageSymbol = ({
7 
+  name,
8 
+  "value-bound": v,
9 
+  "function-bound": f,
10 
+  "macro-bound": m,
11 
+}) =>
12 
+  html`
13 
+    <tr>
14 
+      <td>${name}</td>
15 
+      <td>${v}</td>
16 
+      <td>${f}</td>
17 
+      <td>${m}</td>
18 
+    </tr>
19 
+  `;
20 
+
21 
+const Package = ({ pkg, symbols }) => html`
22 
+  <div>
23 
+    <table id="package">
24 
+      <thead>
25 
+        <th>Symbol Name</th>
26 
+        <th>Value Bound?</th>
27 
+        <th>Function Bound?</th>
28 
+        <th>Macro Bound?</th>
29 
+      </thead>
30 
+      <tbody>
31 
+        ${R.map(
32 
+          (v) => PackageSymbol(v),
33 
+          R.sortBy(
34 
+            R.compose(R.toLower, ({ name }) => name),
35 
+            symbols
36 
+          )
37 
+        )}
38 
+      </tbody>
39 
+    </table>
40 
+  </div>
41 
+`;
42 
+
43 
+export const PackageList = (
44 
+  dispatchers,
45 
+  { packages, currentPackage, symbols }
46 
+) =>
47 
+  html`
48 
+    <main>
49 
+      <ul id="packages">
50 
+        ${R.map(
51 
+          (pkg) =>
52 
+            html`<li>
53 
+              <button @click=${(_) => selectPackage(dispatchers, pkg)}>
54 
+                ${pkg}
55 
+              </button>
56 
+            </li>`,
57 
+          R.sortBy(R.toLower, packages)
58 
+        )}
59 
+      </ul>
60 
+      ${Package({ package: currentPackage, symbols })}
61 
+    </main>
62 
+  `;
files/index.html
History View file @ a5523e3
0 63 
new file mode 100644
... ... 
@@ -0,0 +1,46 @@
1 
+<!DOCTYPE html>
2 
+<html lang="en">
3 
+  <head>
4 
+    <meta charset="UTF-8" />
5 
+    <title>Document</title>
6 
+    <style>
7 
+      * {
8 
+        box-sizing: border-box;
9 
+      }
10 
+      html,
11 
+      body {
12 
+        margin: 0;
13 
+        padding: 0;
14 
+      }
15 
+      ul {
16 
+          margin: 0;
17 
+      }
18 
+      #root {
19 
+        height: 100vh;
20 
+      }
21 
+      main {
22 
+        display: flex;
23 
+        height: 100%;
24 
+      }
25 
+      main > * {
26 
+        width: 50%;
27 
+        max-height: 100%;
28 
+        overflow-y: auto;
29 
+      }
30 
+    </style>
31 
+  </head>
32 
+  <body>
33 
+    <div id="root"></div>
34 
+    <script src="//cdn.jsdelivr.net/npm/ramda@latest/dist/ramda.min.js"></script>
35 
+    <script>
36 
+      // HACK(keanulee): The Redux package assumes `process` exists - mock it here before
37 
+      // the module is loaded.
38 
+      window.process = {
39 
+        env: {
40 
+          NODE_ENV: "production",
41 
+        },
42 
+      };
43 
+    </script>
44 
+    <script src="/public/main.js" type="module"></script>
45 
+  </body>
46 
+</html>
files/jsconfig.json
History View file @ a5523e3
0 47 
new file mode 100644
... ... 
@@ -0,0 +1 @@
1 
+{}
files/main.js
History View file @ a5523e3
0 2 
new file mode 100644
... ... 
@@ -0,0 +1,18 @@
1 
+import {
2 
+  html,
3 
+  render,
4 
+} from "https://unpkg.com/lit-html@1.2.1/lit-html.js?module";
5 
+
6 
+import { store, dispatchers } from "./store.js";
7 
+import { selectPackage, updatePackages } from "./api.js";
8 
+import { PackageList } from "./components.js";
9 
+
10 
+store.subscribe((_) => {
11 
+  render(
12 
+    PackageList(dispatchers, store.getState()),
13 
+    document.querySelector("#root")
14 
+  );
15 
+});
16 
+
17 
+store.dispatch({ type: "@@start" });
18 
+updatePackages(dispatchers);
files/store.js
History View file @ a5523e3
0 19 
new file mode 100644
... ... 
@@ -0,0 +1,42 @@
1 
+import * as Redux from "https://unpkg.com/redux@4.0.5?module";
2 
+
3 
+const initialState = {
4 
+  foo: "asdf",
5 
+  packages: [],
6 
+  currentPackage: "",
7 
+  symbols: [],
8 
+};
9 
+
10 
+function reducer(state = initialState, { type, payload }) {
11 
+  if (type === "UPDATE_PACKAGES") {
12 
+    return { ...state, packages: payload };
13 
+  } else if (type === "UPDATE_SYMBOLS") {
14 
+    return {
15 
+      ...state,
16 
+      symbols: payload.symbols,
17 
+      currentPackage: payload.currentPackage,
18 
+    };
19 
+  }
20 
+  return state;
21 
+}
22 
+
23 
+export const store = Redux.createStore(
24 
+  reducer,
25 
+  window.__REDUX_DEVTOOLS_EXTENSION__ && window.__REDUX_DEVTOOLS_EXTENSION__()
26 
+);
27 
+
28 
+export const dispatchers = {
29 
+  updateFoo(payload) {
30 
+    console.log("foo");
31 
+    store.dispatch({ type: "UPDATE_FOO", payload });
32 
+  },
33 
+  updatePackages(payload) {
34 
+    store.dispatch({ type: "UPDATE_PACKAGES", payload });
35 
+  },
36 
+  updateSymbols(_, { package: currentPackage, symbols }) {
37 
+    store.dispatch({
38 
+      type: "UPDATE_SYMBOLS",
39 
+      payload: { currentPackage, symbols },
40 
+    });
41 
+  },
42 
+};
main.lisp
History View file @ a5523e3
0 43 
new file mode 100644
... ... 
@@ -0,0 +1,79 @@
1 
+(cl:in-package :fwoar.web-lisp)
2 
+
3 
+(defclass web-lisp-app (ningle:<app>)
4 
+  ())
5 
+
6 
+(defun string-return (s)
7 
+  `(200 () (,s)))
8 
+
9 
+(defmacro with-json-string ((s &rest args &key indent) &body body)
10 
+  "Set up a JSON streaming encoder context, then evaluate BODY.
11 
+Return a string with the generated JSON output."
12 
+  (declare (ignore indent))
13 
+  `(with-output-to-string (,s)
14 
+     (with-open-stream (,s (yason:make-json-output-stream s ,@args))
15 
+       ,@body)))
16 
+
17 
+(deftype simple-json-type ()
18 
+  '(or
19 
+    (member yason:true yason:false t)
20 
+    real string null))
21 
+(deftype compound-json-type ()
22 
+  '(or
23 
+    (array *)
24 
+    list
25 
+    hash-table))
26 
+(deftype json-type ()
27 
+  '(or simple-json-type compound-json-type))
28 
+(defun encodable (it)
29 
+  (typep it
30 
+         'json-type))
31 
+
32 
+(defmethod araneus:routes progn ((app web-lisp-app))
33 
+  (setf (ningle:route app "/systems" :method :get)
34 
+        (lambda (params)
35 
+          (declare (ignore params))
36 
+          (string-return
37 
+           (with-json-string (s :indent t)
38 
+             (yason:encode (asdf:registered-systems)
39 
+                           s))))
40 
+
41 
+        (ningle:route app "/packages" :method :get)
42 
+        (lambda (params)
43 
+          (declare (ignore params))
44 
+          (string-return
45 
+           (with-json-string (s :indent t)
46 
+             (yason:encode (mapcar 'package-name
47 
+                                   (list-all-packages))
48 
+                           s))))
49 
+
50 
+        (ningle:route app "/packages/:package-name" :method :get)
51 
+        (lambda (params)
52 
+          (let ((package-name (serapeum:assocdr :package-name params
53 
+                                                :test 'equal)))
54 
+            (string-return
55 
+             (yason:with-output-to-string* (:indent t)
56 
+               (yason:with-object ()
57 
+                 (yason:encode-object-element "package" package-name)
58 
+                 (yason:with-object-element ("symbols")
59 
+                   (yason:with-array ()
60 
+                     (do-external-symbols (sym package-name)
61 
+                       (yason:with-object ()
62 
+                         (yason:encode-object-elements
63 
+                          "name" (symbol-name sym)
64 
+                          "value-bound" (boundp sym)
65 
+                          "function-bound" (fboundp sym)
66 
+                          "macro-bound" (if (macro-function sym)
67 
+                                            'yason:true
68 
+                                            'yason:false)))))))))))
69 
+
70 
+        (ningle:route app "/packages/:package-name/describe/:symbol-name" :method :get)
71 
+        (lambda (params)
72 
+          (let ((package-name (serapeum:assocdr :package-name params
73 
+                                                :test 'equal))
74 
+                (symbol-name (serapeum:assocdr :symbol-name params
75 
+                                               :test 'equal)))
76 
+            (string-return
77 
+             (with-output-to-string (s)
78 
+               (describe (find-symbol symbol-name package-name)
79 
+                         s)))))))
package.lisp
History View file @ a5523e3
0 80 
new file mode 100644
... ... 
@@ -0,0 +1,9 @@
1 
+(cl:in-package :cl-user)
2 
+(defpackage :fwoar.web-lisp.package-user
3 
+  (:use :cl)
4 
+  (:export))
5 
+(in-package :fwoar.package-user)
6 
+
7 
+(defpackage :fwoar.web-lisp
8 
+  (:use :cl)
9 
+  (:export))
web-lisp.asd
History View file @ a5523e3
0 10 
new file mode 100644
... ... 
@@ -0,0 +1,17 @@
1 
+;;; -*- Mode:Lisp; Syntax:ANSI-Common-Lisp; Package: ASDF-USER -*-
2 
+(in-package :asdf-user)
3 
+
4 
+(defsystem :web-lisp
5 
+  :description ""
6 
+  :author "Ed L <edward@elangley.org>"
7 
+  :license "MIT"
8 
+  :depends-on (#:alexandria
9 
+               #:uiop
10 
+               #:serapeum
11 
+               #:clack
12 
+               #:araneus
13 
+               #:yason)
14 
+  :serial t
15 
+  :components ((:file "package")
16 
+               (:file "main")
17 
+               ))