From ffb007aa046cfe8fe99fd410d5a3078a5cd3ae1a Mon Sep 17 00:00:00 2001 From: Tom Hutchinson Date: Mon, 25 May 2020 17:26:14 +0800 Subject: [PATCH 1/3] Experiment with sci (#67) and devcards (#6) --- project.clj | 1 + src/cljs/athens/devcards.cljs | 2 + src/cljs/athens_devcards/db.cljs | 6 + src/cljs/athens_devcards/sci_boxes.cljs | 256 ++++++++++++++++++++++++ 4 files changed, 265 insertions(+) create mode 100644 src/cljs/athens_devcards/db.cljs create mode 100644 src/cljs/athens_devcards/sci_boxes.cljs diff --git a/project.clj b/project.clj index 013c63d87e..14c4138c60 100644 --- a/project.clj +++ b/project.clj @@ -24,6 +24,7 @@ [metosin/reitit "0.4.2"] [instaparse "1.4.10"] [devcards "0.2.6"] + [borkdude/sci "0.0.13-alpha.22"] [garden "1.3.10"]] :plugins [[lein-shell "0.5.0"]] diff --git a/src/cljs/athens/devcards.cljs b/src/cljs/athens/devcards.cljs index e16abc5e72..0e826d1966 100644 --- a/src/cljs/athens/devcards.cljs +++ b/src/cljs/athens/devcards.cljs @@ -2,6 +2,8 @@ (:require [cljsjs.react] [cljsjs.react.dom] + [athens-devcards.db] + [athens-devcards.sci-boxes] [devcards.core :as devcards :include-macros true :refer [defcard]] [reagent.core :as r :include-macros true])) diff --git a/src/cljs/athens_devcards/db.cljs b/src/cljs/athens_devcards/db.cljs new file mode 100644 index 0000000000..d239f42909 --- /dev/null +++ b/src/cljs/athens_devcards/db.cljs @@ -0,0 +1,6 @@ +(ns athens-devcards.db + (:require + [athens.db] + [devcards.core :refer-macros [defcard]])) + +(defcard datascript-connection athens.db/dsdb) diff --git a/src/cljs/athens_devcards/sci_boxes.cljs b/src/cljs/athens_devcards/sci_boxes.cljs new file mode 100644 index 0000000000..fb8b6b7196 --- /dev/null +++ b/src/cljs/athens_devcards/sci_boxes.cljs @@ -0,0 +1,256 @@ +(ns athens-devcards.sci-boxes + (:require + [clojure.string :as str] + [devcards.core :refer [defcard defcard-rg]] + [reagent.core :as rg] + [sci.core :as sci])) + +(def log js/console.log) +(defn trace [x] (log x) x) + +(defcard " + # An experiment in connecting mini SCI environments + + Let's say you could put executable code in Athens' blocks. + + Some questions: + - In what order do we evaluate our blocks? + - How do we pass data in and out of our blocks? + - How do we handle async code? + + Attempted approach: + - Blocks are passed the evaluated result of their parent (`*1`) + + Some other approaches: + - Blocks inherit the environment of their parent + - Blocks mutate a global environment + - Blocks are babashka pods? + + Fun stuff to try: + - Pass in the datascript connection + - `spit`/`slurp` to IPFS etc. + ") + +(defcard sci + "## Small Clojure Interpreter + https://github.com/borkdude/sci") + +(defn remove-from-vec + "Returns a new vector with the element at 'index' removed. + + (remove-from-vec [:a :b :c] 1) => [:a :c]" + [v index] + (vec (concat (subvec v 0 index) (subvec v (inc index))))) + +(defn index-of [col val] + (first (keep-indexed (fn [idx x] + (when (= x val) + idx)) + col))) + +(defcard sci-examples + (for [[s opts] + [["(inc 1)"] + ["x" {:bindings {'x 1}}] + ["{:hiccup [:span \"Hello\"]}"] + ["(def a 1)"] + [":a"] + ["(require '[lib]) lib/msg" {:namespaces {'lib {'msg "hi"}}}]]] + (merge {:s s :result (sci/eval-string s opts)} + (when opts + {:opts opts})))) + +(def key-code->key + {8 :backspace + 9 :tab + 13 :return + 57 :left-paren + 219 :left-brace}) + +(def empty-box {:str-content "" + :children-ids []}) + +(defcard " + ## Experiment #1 + - A tree of boxes + - If a box's `:str-content` begins with `:sci`, + evaluate the rest of the string with SCI and assign it to `:result` + - Child boxes are passed their parent's `:result` as `*1`, like a REPL + - Every time a box's content changes, naively re-evaluate the whole tree top to bottom! + - If a box's `:result` is a map with a `hiccup` key, render it after the box + + ENTER key makes a new sibling (if not root) + + SHIFT-ENTER to make a new line + + BACKSPACE in an empty box deletes it + ") + +(defonce box-state* + (rg/atom {:next-id 4 + :boxes {0 (merge empty-box {:children-ids [1 3] + :str-content ":sci {:message \"🌻\" :size 70}"}) + 1 (merge empty-box {:children-ids [2] + :str-content ":sci (merge *1 {:hiccup [:div {:style {:font-size (:size *1)}} (:message *1)]})"}) + + 2 (merge empty-box {:str-content "I am just a 🍃"}) + 3 (merge empty-box {:str-content ":sci (:message *1)"})}})) + +(defcard box-state* box-state*) + +(defn get-parent-id [boxes child-id] + (some (fn [[id box]] + (when (some #{child-id} (:children-ids box)) + id)) + boxes)) + +(defn sci-node? [{:keys [str-content]}] + (str/starts-with? str-content ":sci")) + +(defn eval-box [{:keys [str-content] :as box} parent] + (if-not (sci-node? box) + box + (let [code (subs str-content 4) + result (try + (sci/eval-string code {:bindings {'*1 (:result parent)}}) + (catch js/Error e + (trace e)))] + (assoc box :result result)))) + +;; very naive depth-first search, probably buggy +(defn next-box-id [boxes visited id] + (if (not (visited id)) + id + (let [go-up #(when-let [parent-id (get-parent-id boxes id)] + (next-box-id boxes visited parent-id))] + (if-let [children (-> boxes (get id) :children-ids seq)] + (if-let [unvisited-child (some #(when (not (visited %)) + %) + children)] + unvisited-child + (go-up)) + (let [parent (get-parent-id boxes id) + siblings (:children-ids parent)] + (if-let [unvisited-sibling (some #(when (not (visited %)) + %) + siblings)] + unvisited-sibling + (go-up))))))) + +(defn eval-all-boxes [boxes] + (loop [boxes boxes + visited #{} + id 0] + (let [box (get boxes id) + parent (get boxes (get-parent-id boxes id)) + boxes' (assoc boxes id (eval-box box parent)) + visited' (conj visited id) + id' (next-box-id boxes visited' id)] + (if-not id' + boxes' + (recur boxes' visited' id'))))) + +(defn add-child [{:keys [children-ids] :as box} idx id] + (let [new-idx (inc idx)] + (assoc box :children-ids (apply conj + (subvec children-ids 0 new-idx) + id + (subvec children-ids new-idx))))) + +(defn remove-child [parent child-id] + (let [idx (index-of (:children-ids parent) child-id)] + (update parent :children-ids remove-from-vec idx))) + +(defn add-sibling [{:keys [next-id boxes] :as state} id] + (let [parent-id (get-parent-id boxes id) + siblings (get-in boxes [parent-id :children-ids]) + idx (index-of siblings id)] + (-> state + (update :next-id inc) + (update :boxes update parent-id add-child idx next-id) + (update :boxes assoc next-id empty-box) + (update :boxes eval-all-boxes)))) + +(defn delete-box [{:keys [boxes] :as state} id] + (let [parent-id (get-parent-id boxes id)] + (-> state + (update-in [:boxes parent-id] remove-child id) + (update :boxes dissoc id) + (update :boxes eval-all-boxes)))) + +(defn update-box-content [boxes id value] + (update boxes id assoc :str-content value)) + +(defn handle-return-key! [e id] + (.preventDefault e) + (swap! box-state* add-sibling id)) + +(defn handle-backspace-key! [e id] + (let [{:keys [str-content]} (get-in @box-state* [:boxes id])] + (when (empty? str-content) + (.preventDefault e) + (swap! box-state* delete-box id)))) + +(defn handle-box-key-down! [e id] + (let [key-code (.-keyCode e) + shift? (.-shiftKey e) + k (key-code->key key-code)] + (case k + :return (when (not shift?) + (handle-return-key! e id)) + :backspace (handle-backspace-key! e id) + nil))) + +(defn handle-box-change! [e id] + (let [target (.-target e) + value (.-value target)] + (swap! box-state* + #(-> % + (update :boxes update-box-content id value) + (update :boxes eval-all-boxes))))) + +(defn sci-result-component [result] + (when result + (let [{:keys [hiccup]} result] + (if hiccup + hiccup + (str result))))) + +;; resulting :hiccup could be malformed, catch errors & allow retry +(defn sci-result-wrapper [] + (let [err* (rg/atom nil)] + (rg/create-class + {:component-did-catch (fn [err info] + (reset! err* [err info])) + :reagent-render (fn [result] + (if (nil? @err*) + [sci-result-component result] + (let [[_ info] @err*] + [:div + [:code (str info)] + [:div + [:button {:on-click #(reset! err* nil)} + "re-render"]]])))}))) + +(defn box-component [id] + (let [{:keys [boxes]} @box-state* + {:keys [str-content children-ids result] :as box} (get boxes id)] + [:div + [:div {:style {:display "flex"}} + id + [:textarea {:style {:font-size "1rem" + :width "30rem"} + :value str-content + :on-change #(handle-box-change! % id) + :on-key-down #(handle-box-key-down! % id)}] + (when (sci-node? box) + [sci-result-wrapper result])] + (when (seq children-ids) + (into [:div {:style {:margin-left "1rem"}}] + (for [id children-ids] + [box-component id])))])) + +(defcard-rg boxes + (do + (swap! box-state* update :boxes eval-all-boxes) + [box-component 0])) From 956f6fff54768ec3036d04afc69aeccf2cd44d52 Mon Sep 17 00:00:00 2001 From: Tom Hutchinson Date: Mon, 25 May 2020 18:05:28 +0800 Subject: [PATCH 2/3] fix style --- src/cljs/athens/devcards.cljs | 4 +- src/cljs/athens_devcards/db.cljs | 1 + src/cljs/athens_devcards/sci_boxes.cljs | 110 +++++++++++++++++------- 3 files changed, 84 insertions(+), 31 deletions(-) diff --git a/src/cljs/athens/devcards.cljs b/src/cljs/athens/devcards.cljs index 3bab1e199b..ff3f73ddf4 100644 --- a/src/cljs/athens/devcards.cljs +++ b/src/cljs/athens/devcards.cljs @@ -1,9 +1,9 @@ (ns athens.devcards (:require - [cljsjs.react] - [cljsjs.react.dom] [athens-devcards.db] [athens-devcards.sci-boxes] + [cljsjs.react] + [cljsjs.react.dom] [devcards.core :as devcards :include-macros true :refer [defcard]] [reagent.core :as r :include-macros true])) diff --git a/src/cljs/athens_devcards/db.cljs b/src/cljs/athens_devcards/db.cljs index d239f42909..d79d4f1f00 100644 --- a/src/cljs/athens_devcards/db.cljs +++ b/src/cljs/athens_devcards/db.cljs @@ -3,4 +3,5 @@ [athens.db] [devcards.core :refer-macros [defcard]])) + (defcard datascript-connection athens.db/dsdb) diff --git a/src/cljs/athens_devcards/sci_boxes.cljs b/src/cljs/athens_devcards/sci_boxes.cljs index fb8b6b7196..bcb31bb08b 100644 --- a/src/cljs/athens_devcards/sci_boxes.cljs +++ b/src/cljs/athens_devcards/sci_boxes.cljs @@ -1,12 +1,18 @@ (ns athens-devcards.sci-boxes (:require - [clojure.string :as str] - [devcards.core :refer [defcard defcard-rg]] - [reagent.core :as rg] - [sci.core :as sci])) + [clojure.string :as str] + [devcards.core :refer [defcard defcard-rg]] + [reagent.core :as rg] + [sci.core :as sci])) + (def log js/console.log) -(defn trace [x] (log x) x) + + +(defn trace + [x] + (log x) x) + (defcard " # An experiment in connecting mini SCI environments @@ -31,10 +37,12 @@ - `spit`/`slurp` to IPFS etc. ") + (defcard sci "## Small Clojure Interpreter https://github.com/borkdude/sci") + (defn remove-from-vec "Returns a new vector with the element at 'index' removed. @@ -42,12 +50,15 @@ [v index] (vec (concat (subvec v 0 index) (subvec v (inc index))))) -(defn index-of [col val] + +(defn index-of + [col val] (first (keep-indexed (fn [idx x] (when (= x val) idx)) col))) + (defcard sci-examples (for [[s opts] [["(inc 1)"] @@ -60,6 +71,7 @@ (when opts {:opts opts})))) + (def key-code->key {8 :backspace 9 :tab @@ -67,8 +79,11 @@ 57 :left-paren 219 :left-brace}) -(def empty-box {:str-content "" - :children-ids []}) + +(def empty-box + {:str-content "" + :children-ids []}) + (defcard " ## Experiment #1 @@ -86,6 +101,7 @@ BACKSPACE in an empty box deletes it ") + (defonce box-state* (rg/atom {:next-id 4 :boxes {0 (merge empty-box {:children-ids [1 3] @@ -96,29 +112,38 @@ 2 (merge empty-box {:str-content "I am just a 🍃"}) 3 (merge empty-box {:str-content ":sci (:message *1)"})}})) + (defcard box-state* box-state*) -(defn get-parent-id [boxes child-id] + +(defn get-parent-id + [boxes child-id] (some (fn [[id box]] (when (some #{child-id} (:children-ids box)) id)) boxes)) -(defn sci-node? [{:keys [str-content]}] + +(defn sci-node? + [{:keys [str-content]}] (str/starts-with? str-content ":sci")) -(defn eval-box [{:keys [str-content] :as box} parent] + +(defn eval-box + [{:keys [str-content] :as box} parent] (if-not (sci-node? box) box (let [code (subs str-content 4) result (try (sci/eval-string code {:bindings {'*1 (:result parent)}}) (catch js/Error e - (trace e)))] + (trace e)))] (assoc box :result result)))) + ;; very naive depth-first search, probably buggy -(defn next-box-id [boxes visited id] +(defn next-box-id + [boxes visited id] (if (not (visited id)) id (let [go-up #(when-let [parent-id (get-parent-id boxes id)] @@ -137,7 +162,9 @@ unvisited-sibling (go-up))))))) -(defn eval-all-boxes [boxes] + +(defn eval-all-boxes + [boxes] (loop [boxes boxes visited #{} id 0] @@ -150,18 +177,24 @@ boxes' (recur boxes' visited' id'))))) -(defn add-child [{:keys [children-ids] :as box} idx id] + +(defn add-child + [{:keys [children-ids] :as box} idx id] (let [new-idx (inc idx)] (assoc box :children-ids (apply conj - (subvec children-ids 0 new-idx) - id - (subvec children-ids new-idx))))) + (subvec children-ids 0 new-idx) + id + (subvec children-ids new-idx))))) + -(defn remove-child [parent child-id] +(defn remove-child + [parent child-id] (let [idx (index-of (:children-ids parent) child-id)] (update parent :children-ids remove-from-vec idx))) -(defn add-sibling [{:keys [next-id boxes] :as state} id] + +(defn add-sibling + [{:keys [next-id boxes] :as state} id] (let [parent-id (get-parent-id boxes id) siblings (get-in boxes [parent-id :children-ids]) idx (index-of siblings id)] @@ -171,27 +204,37 @@ (update :boxes assoc next-id empty-box) (update :boxes eval-all-boxes)))) -(defn delete-box [{:keys [boxes] :as state} id] + +(defn delete-box + [{:keys [boxes] :as state} id] (let [parent-id (get-parent-id boxes id)] (-> state (update-in [:boxes parent-id] remove-child id) (update :boxes dissoc id) (update :boxes eval-all-boxes)))) -(defn update-box-content [boxes id value] + +(defn update-box-content + [boxes id value] (update boxes id assoc :str-content value)) -(defn handle-return-key! [e id] + +(defn handle-return-key! + [e id] (.preventDefault e) (swap! box-state* add-sibling id)) -(defn handle-backspace-key! [e id] + +(defn handle-backspace-key! + [e id] (let [{:keys [str-content]} (get-in @box-state* [:boxes id])] (when (empty? str-content) (.preventDefault e) (swap! box-state* delete-box id)))) -(defn handle-box-key-down! [e id] + +(defn handle-box-key-down! + [e id] (let [key-code (.-keyCode e) shift? (.-shiftKey e) k (key-code->key key-code)] @@ -201,7 +244,9 @@ :backspace (handle-backspace-key! e id) nil))) -(defn handle-box-change! [e id] + +(defn handle-box-change! + [e id] (let [target (.-target e) value (.-value target)] (swap! box-state* @@ -209,15 +254,19 @@ (update :boxes update-box-content id value) (update :boxes eval-all-boxes))))) -(defn sci-result-component [result] + +(defn sci-result-component + [result] (when result (let [{:keys [hiccup]} result] (if hiccup hiccup (str result))))) + ;; resulting :hiccup could be malformed, catch errors & allow retry -(defn sci-result-wrapper [] +(defn sci-result-wrapper + [] (let [err* (rg/atom nil)] (rg/create-class {:component-did-catch (fn [err info] @@ -232,7 +281,9 @@ [:button {:on-click #(reset! err* nil)} "re-render"]]])))}))) -(defn box-component [id] + +(defn box-component + [id] (let [{:keys [boxes]} @box-state* {:keys [str-content children-ids result] :as box} (get boxes id)] [:div @@ -250,6 +301,7 @@ (for [id children-ids] [box-component id])))])) + (defcard-rg boxes (do (swap! box-state* update :boxes eval-all-boxes) From 5a0b98420804a21e93823112d84ddce7adb2e962 Mon Sep 17 00:00:00 2001 From: Tom Hutchinson Date: Tue, 26 May 2020 08:23:56 +0800 Subject: [PATCH 3/3] move devcards ns --- src/cljs/athens/devcards.cljs | 4 ++-- src/cljs/{athens_devcards => athens/devcards}/db.cljs | 4 +++- .../{athens_devcards => athens/devcards}/sci_boxes.cljs | 6 ++++-- 3 files changed, 9 insertions(+), 5 deletions(-) rename src/cljs/{athens_devcards => athens/devcards}/db.cljs (65%) rename src/cljs/{athens_devcards => athens/devcards}/sci_boxes.cljs (98%) diff --git a/src/cljs/athens/devcards.cljs b/src/cljs/athens/devcards.cljs index ff3f73ddf4..b019316ee8 100644 --- a/src/cljs/athens/devcards.cljs +++ b/src/cljs/athens/devcards.cljs @@ -1,7 +1,7 @@ (ns athens.devcards (:require - [athens-devcards.db] - [athens-devcards.sci-boxes] + [athens.devcards.db] + [athens.devcards.sci-boxes] [cljsjs.react] [cljsjs.react.dom] [devcards.core :as devcards :include-macros true :refer [defcard]] diff --git a/src/cljs/athens_devcards/db.cljs b/src/cljs/athens/devcards/db.cljs similarity index 65% rename from src/cljs/athens_devcards/db.cljs rename to src/cljs/athens/devcards/db.cljs index d79d4f1f00..4f012bcd72 100644 --- a/src/cljs/athens_devcards/db.cljs +++ b/src/cljs/athens/devcards/db.cljs @@ -1,6 +1,8 @@ -(ns athens-devcards.db +(ns athens.devcards.db (:require [athens.db] + [cljsjs.react] + [cljsjs.react.dom] [devcards.core :refer-macros [defcard]])) diff --git a/src/cljs/athens_devcards/sci_boxes.cljs b/src/cljs/athens/devcards/sci_boxes.cljs similarity index 98% rename from src/cljs/athens_devcards/sci_boxes.cljs rename to src/cljs/athens/devcards/sci_boxes.cljs index bcb31bb08b..3cae996565 100644 --- a/src/cljs/athens_devcards/sci_boxes.cljs +++ b/src/cljs/athens/devcards/sci_boxes.cljs @@ -1,7 +1,9 @@ -(ns athens-devcards.sci-boxes +(ns athens.devcards.sci-boxes (:require + [cljsjs.react] + [cljsjs.react.dom] [clojure.string :as str] - [devcards.core :refer [defcard defcard-rg]] + [devcards.core :as devcards :refer [defcard defcard-rg]] [reagent.core :as rg] [sci.core :as sci]))