|
(defn- wrap-in-tap [code] |
|
(str "(let [value " code |
|
" rr (try (resolve 'requiring-resolve) (catch Throwable _))]" |
|
" (if-let [rs (try (rr 'cognitect.rebl/submit) (catch Throwable _))]" |
|
" (rs '" code " value)" |
|
" (tap> value))" |
|
" value)")) |
|
|
|
(defn tap-top-block [] |
|
(p/let [block (editor/get-top-block)] |
|
(when (seq (:text block)) |
|
(-> block |
|
(update :text wrap-in-tap) |
|
(editor/eval-and-render))))) |
|
|
|
(defn tap-block [] |
|
(p/let [block (editor/get-block)] |
|
(when (seq (:text block)) |
|
(-> block |
|
(update :text wrap-in-tap) |
|
(editor/eval-and-render))))) |
|
|
|
(defn tap-selection [] |
|
(p/let [block (editor/get-selection)] |
|
(when (seq (:text block)) |
|
(-> block |
|
(update :text wrap-in-tap) |
|
(editor/eval-and-render))))) |
|
|
|
(defn tap-def-var [] |
|
(p/let [block (editor/get-selection)] |
|
(when (seq (:text block)) |
|
(-> block |
|
(update :text |
|
#(str "(def " % ")")) |
|
(update :text wrap-in-tap) |
|
(editor/eval-and-render))))) |
|
|
|
(defn tap-var [] |
|
(p/let [block (editor/get-var)] |
|
(when (seq (:text block)) |
|
(-> block |
|
(update :text #(str "#'" %)) |
|
(update :text wrap-in-tap) |
|
(editor/eval-and-render))))) |
|
|
|
(defn tap-ns [] |
|
(p/let [block (editor/get-namespace) |
|
here (editor/get-selection)] |
|
(when (seq (:text block)) |
|
(-> block |
|
(update :text #(str "(find-ns '" % ")")) |
|
(update :text wrap-in-tap) |
|
(assoc :range (:range here)) |
|
(editor/eval-and-render))))) |
|
|
|
(defn tap-remove-ns [] |
|
(p/let [block (editor/get-namespace) |
|
here (editor/get-selection)] |
|
(when (seq (:text block)) |
|
(editor/run-callback |
|
:notify |
|
{:type :info :title "Removing..." :message (:text block)}) |
|
(-> block |
|
(update :text #(str "(remove-ns '" % ")")) |
|
(update :text wrap-in-tap) |
|
(assoc :range (:range here)) |
|
(editor/eval-and-render))))) |
|
|
|
(defn tap-reload-all-ns [] |
|
(p/let [block (editor/get-namespace) |
|
here (editor/get-selection)] |
|
(when (seq (:text block)) |
|
(editor/run-callback |
|
:notify |
|
{:type :info :title "Reloading all..." :message (:text block)}) |
|
(p/let [res (editor/eval-and-render |
|
(-> block |
|
(update :text #(str "(require '" % " :reload-all)")) |
|
(update :text wrap-in-tap) |
|
(assoc :range (:range here))))] |
|
(editor/run-callback |
|
:notify |
|
{:type (if (:error res) :warn :info) |
|
:title (if (:error res) |
|
"Reload failed for..." |
|
"Reload succeeded!") |
|
:message (:text block)}))))) |
|
|
|
(defn- format-test-result [{:keys [test pass fail error]}] |
|
(str "Ran " test " test" |
|
(when-not (= 1 test) "s") |
|
(when-not (zero? pass) |
|
(str ", " pass " assertion" |
|
(when-not (= 1 pass) "s") |
|
" passed")) |
|
(when-not (zero? fail) |
|
(str ", " fail " failed")) |
|
(when-not (zero? error) |
|
(str ", " error " errored")) |
|
".")) |
|
|
|
(defn tap-run-side-tests [] |
|
(p/let [block (editor/get-namespace) |
|
here (editor/get-selection)] |
|
(when (seq (:text block)) |
|
(p/let [res (editor/eval-and-render |
|
(-> block |
|
(update :text (fn [s] (str " |
|
(some #(try |
|
(let [nt (symbol (str \"" s "\" \"-\" %))] |
|
(require nt) |
|
(clojure.test/run-tests nt)) |
|
(catch Throwable _)) |
|
[\"test\" \"expectations\"])"))) |
|
(update :text wrap-in-tap) |
|
(assoc :range (:range here))))] |
|
(editor/run-callback |
|
:notify |
|
{:type (if (:error res) :warn :info) |
|
:title (if (:error res) |
|
"Failed to run tests for..." |
|
"Tests completed!") |
|
:message (if (:error res) (:text block) (format-test-result (:result res)))}))))) |
|
|
|
(defn tap-doc-var [] |
|
(p/let [block (editor/get-var)] |
|
(when (seq (:text block)) |
|
(-> block |
|
(update :text |
|
#(str |
|
"(java.net.URL." |
|
" (str \"http://clojuredocs.org/\"" |
|
" (-> (str (symbol #'" % "))" |
|
;; clean up ? ! & |
|
" (clojure.string/replace \"?\" \"%3f\")" |
|
" (clojure.string/replace \"!\" \"%21\")" |
|
" (clojure.string/replace \"&\" \"%26\")" |
|
")))")) |
|
(update :text wrap-in-tap) |
|
(editor/eval-and-render))))) |
|
|
|
(defn tap-javadoc [] |
|
(p/let [block (editor/get-selection) |
|
block (if (< 1 (count (:text block))) block (editor/get-var))] |
|
(when (seq (:text block)) |
|
(-> block |
|
(update :text |
|
#(str |
|
"(let [c-o-o " % |
|
" ^Class c (if (instance? Class c-o-o) c-o-o (class c-o-o))] " |
|
" (java.net.URL. " |
|
" (clojure.string/replace" |
|
" ((requiring-resolve 'clojure.java.javadoc/javadoc-url)" |
|
" (.getName c))" |
|
;; strip inner class |
|
" #\"\\$[a-zA-Z0-9_]+\" \"\"" |
|
")))")) |
|
(update :text wrap-in-tap) |
|
(editor/eval-and-render))))) |
|
|
|
(defn explain-schema [] |
|
(p/let [editor-data (editor/get-var)] |
|
(when editor-data |
|
(-> editor-data |
|
(update :text #(str "(if (satisfies? schema.core/Schema " % ") " |
|
"(schema.core/explain " % ")" |
|
"(or #?(:cljs nil :default (:schema (meta (ns-resolve *ns* '" % "))))" |
|
"\"Is not a schema\"))")) |
|
(editor/eval-and-render))))) |
|
|
|
(defn fqn-of-var [] |
|
(p/let [editor-data (editor/get-var)] |
|
(-> editor-data |
|
(update :text #(str "`" %)) |
|
editor/eval-and-render))) |
|
|
|
(defn notify [] |
|
(p/let [res (editor/run-callback |
|
:prompt {:title "What do you want?" |
|
:message (str "How do you want to evaluate " |
|
"your code?") |
|
:arguments [{:key :top :value "Top Block"} |
|
{:key :block :value "Block"} |
|
{:key :var :value "Current Var"}]}) |
|
{:keys [text]} (case res |
|
:top (editor/get-top-block) |
|
:block (editor/get-block) |
|
:var (editor/get-var))] |
|
(editor/run-callback :notify {:type :info :title text}))) |
|
|
|
(defn example-notify [] |
|
(let [res '(fn [_] (editor/run-callback |
|
:notify {:type :info :title "LOL!"}))] |
|
(editor/eval-interactive {:range [[0 0] [0 0]] |
|
:text (str "{:html [:a {:on-click '" |
|
res |
|
"} \"Something\"]}")}))) |
|
|
|
(defn dependencies-of-block [] |
|
(p/let [{curr-ns :text} (editor/get-namespace) |
|
{curr-txt :text curr-range :range} (editor/get-top-block) |
|
code (str "(->> `" curr-txt |
|
" (tree-seq coll? seq)" |
|
" rest" |
|
" (filter #(not (coll? %)))" |
|
" (filter symbol?)" |
|
" (filter namespace)" |
|
" (remove #(#{" (pr-str curr-ns) |
|
" \"clojure.core\"" |
|
" \"cljs.core\"}" |
|
" (namespace %)))" |
|
" (remove #(clojure.string/starts-with? (str %) \".\"))" |
|
" (group-by namespace)" |
|
" (mapcat (fn [[ns names]] (map #(vector ns (str (name %))) names)))" |
|
" vec)") |
|
code (str "{:html [:div.pre [:p/diag (doto " code " prn)]]}")] |
|
(editor/eval-interactive {:text code :range curr-range}))) |
|
|
|
(defn- counter [c] |
|
(let [s (r/atom 0) |
|
f (fn [] |
|
[:div "Clicked " [:button {:on-click (fn [_] |
|
(swap! s inc))} |
|
@s] |
|
" time(s) - " c])] |
|
[f])) |
|
(render/register-reagent :p/counter counter) |
|
|
|
(defn hello [ & args] |
|
(doto (render/create-tag "div") |
|
(render/set-text 10))) |
|
|
|
(render/register-tag :p/hello hello) |
|
|
|
(def ^:private nomno (render/js-require "./chlorine/nomno")) |
|
(defn- parse-nomno [data-struct] |
|
(if (empty? data-struct) |
|
"[*]" |
|
(reduce (fn [acc [k v]] |
|
(str acc "[" k "]->[" v "]\n")) |
|
"#direction: right\n" |
|
data-struct))) |
|
|
|
(defn- diag [txt] |
|
(doto (render/create-tag "div") |
|
(render/set-html ((aget nomno "renderSvg") |
|
(cond-> txt (not (string? txt)) parse-nomno))))) |
|
(render/register-tag :p/diag diag) |
|
|
|
(defn as-diagram [] |
|
(p/let [res (editor/get-top-block)] |
|
(editor/eval-interactive |
|
(update res :text #(str "{:html [:div [:p/diag " |
|
% |
|
"]]}"))))) |
|
|
|
(def ^:private plant-uml (render/js-require "chlorine/plant")) |
|
(defn- plant [txt] |
|
(p/let [div (render/create-tag "div") |
|
svg (plant-uml txt)] |
|
(doto (render/create-tag "div") |
|
(render/set-html svg)))) |
|
(render/register-tag :plant/uml plant) |
|
|
|
(declare parse-elem) |
|
(defn- parse-list [prev acc [fst & r]] |
|
(case fst |
|
def (parse-elem prev acc (second r)) |
|
fn* (parse-elem prev acc (cons 'do (->> r first rest))) |
|
if (let [after-conds (gensym) |
|
[c t f] r] |
|
(swap! acc assoc after-conds {:type :connector :next []}) |
|
(let [if-sym (parse-elem prev acc c) |
|
true-sym (parse-elem if-sym acc t) |
|
false-sym (some->> f (parse-elem if-sym acc))] |
|
(swap! acc #(cond-> (update % true-sym assoc :connector "Y" :next [after-conds]) |
|
|
|
false-sym |
|
(update false-sym assoc :connector "N" :next [after-conds]) |
|
|
|
(nil? false-sym) |
|
(update-in [if-sym :next] conj after-conds))) |
|
(swap! acc update if-sym assoc :type :question) |
|
after-conds)) |
|
do (let [actual (atom prev)] |
|
(doseq [elem r |
|
:let [sym (parse-elem @actual acc elem)]] |
|
(reset! actual sym)) |
|
@actual) |
|
(let [elem (cons fst r) |
|
sym (gensym)] |
|
(swap! acc assoc sym {:text (pr-str elem) :next []}) |
|
(swap! acc update-in [prev :next] conj sym) |
|
sym))) |
|
|
|
(defn- parse-elem [prev acc elem] |
|
; (prn :PARSING (seq? elem) elem) |
|
(if (seq? elem) |
|
(parse-list prev acc elem) |
|
(let [sym (gensym)] |
|
(swap! acc assoc sym {:text (pr-str elem) :next []}) |
|
(swap! acc update-in [prev :next] conj sym) |
|
sym))) |
|
|
|
(defn- normalize-tags [tags] |
|
(let [elem-name (fn [{:keys [type text connector]}] |
|
(str "[" |
|
(case type |
|
:connector "<conn> '" |
|
:start "<st> s" |
|
:end "<ed> e" |
|
:question "<question> " |
|
"") |
|
text |
|
"]")) |
|
seed (str "#.question: visual=rhomb\n" |
|
"#.conn: visual=none\n" |
|
"#.st: visual=start\n" |
|
"#.ed: visual=end\n\n")] |
|
(reduce (fn [sofar elem] |
|
(->> (:next elem) |
|
(reduce (fn [sofar next-key] |
|
(let [next-elem (get tags next-key)] |
|
(str sofar "\n" |
|
(elem-name elem) |
|
"->" (:connector next-elem) |
|
(elem-name next-elem)))) |
|
sofar))) |
|
seed (vals tags)))) |
|
|
|
(defn shadow-runtimes [] |
|
(p/let [data (editor/get-selection) |
|
{:keys [result]} (editor/eval {:text (pr-str {:op :request-clients, |
|
:query [:eq :type :runtime]}) |
|
:shadow-command true |
|
:filename "eval_user.cljs" |
|
:range (:range data)}) |
|
clients (->> (:clients result) |
|
(map :client-info) |
|
(mapv #(select-keys % [:user-agent :desc :build-id])))] |
|
|
|
(editor/eval-interactive |
|
{:text (pr-str {:html [:div.rows |
|
[:div.title "Shadow Runtimes"] |
|
[:<> |
|
''(for [{:keys [desc build-id user-agent]} ?state] |
|
[:ul |
|
[:li |
|
(or desc user-agent)] " " (pr-str build-id)])]] |
|
:state clients}) |
|
:range (:range data)}))) |
|
|
|
(def last-command (atom {:text "" |
|
:namespace ""})) |
|
|
|
(defn eval-and-save [] |
|
(p/let [txt (editor/get-block) |
|
namespace (editor/get-namespace)] |
|
(reset! last-command {:text (:text txt) |
|
:namespace (:text namespace)}) |
|
(editor/eval-and-render txt))) |
|
|
|
(defn repeat-last-eval [] |
|
(p/let [{:keys [range]} (editor/get-selection)] |
|
(editor/eval-and-render {:range range |
|
:text (:text @last-command) |
|
:namespace (:namespace @last-command)}))) |
|
|
|
(def old-fail-blob |
|
'(defmethod clojure.test/report :fail [m] |
|
(clojure.test/with-test-out |
|
(clojure.test/inc-report-counter :fail) |
|
(println "\nFAIL in" (clojure.test/testing-vars-str m)) |
|
(when (seq clojure.test/*testing-contexts*) (println (clojure.test/testing-contexts-str))) |
|
(when-let [message (:message m)] (println message)) |
|
(println "expected:" (pr-str (:expected m))) |
|
(println " actual:" (pr-str (:actual m)))))) |
|
|
|
(def old-error-blob |
|
'(defmethod clojure.test/report :error [m] |
|
(clojure.test/with-test-out |
|
(clojure.test/inc-report-counter :error) |
|
(println "\nERROR in" (clojure.test/testing-vars-str m)) |
|
(when (seq clojure.test/*testing-contexts*) (println (clojure.test/testing-contexts-str))) |
|
(when-let [message (:message m)] (println message)) |
|
(println "expected:" (pr-str (:expected m))) |
|
(print " actual: ") |
|
(let [actual (:actual m)] |
|
(if (instance? Throwable actual) |
|
(clojure.stacktrace/print-cause-trace actual clojure.test/*stack-trace-depth*) |
|
(prn actual)))))) |
|
|
|
(def html-for-tests |
|
'{:html '(if (empty? ?state) |
|
[:div.title "All tests passed"] |
|
[:div.rows |
|
[:div.title.error "Test(s) failed!"] |
|
[:<> |
|
(map (fn [error idx] |
|
[:div.rows {:key idx} |
|
[:div.space] |
|
[:div.title |
|
(-> error :type name str/upper-case) " at: " |
|
[:a {:href "#" |
|
:on-click (fn [_] (editor/run-callback :open-editor |
|
{:file-name (:file error) |
|
:line (dec (:line error))}))} |
|
(:file error) ":" (:line error)]] |
|
|
|
(if (-> error :type (= :error)) |
|
(do |
|
(log (pr-str (:actual error))) |
|
[:div/clj (:actual error)]) |
|
[:div/ansi (:actual error)])]) |
|
; [:a {:href "#" :on-click (fn [_] |
|
; (editor/eval-interactive "__PLACE_HOLDER_HERE__"))} |
|
; "Re-run test")]) |
|
?state (range))]]) |
|
:state @s}) |
|
|
|
(defn eval-block-as-test [] |
|
(p/let [txt-code (editor/get-block) |
|
code (str "(let [s (atom [])] " |
|
" (defmethod clojure.test/report :error [m]" |
|
" (swap! s conj m))" |
|
" (defmethod clojure.test/report :fail [m]" |
|
" (swap! s conj (update m :actual pr-str))) " |
|
(:text txt-code) " " |
|
(pr-str old-fail-blob) " " |
|
(pr-str old-error-blob) " " |
|
html-for-tests " )") |
|
obj {:range (:range txt-code) |
|
:text (str code)}] |
|
(editor/eval-interactive obj))) |
|
|
|
|
|
;;; DOT |
|
(def ^:private wasm (render/js-require "./chlorine/hpcc-js")) |
|
(def ^:private viz (render/js-require "./chlorine/viz")) |
|
(defn render-viz |
|
([txt] (render-viz {} txt)) |
|
([opts txt] |
|
(prn :OPTS? opts) |
|
(let [tag (render/create-tag "div")] |
|
(render/set-text tag "RENDERING...") |
|
(-> (p/let [res (.. wasm |
|
-graphviz |
|
(layout txt "svg" "dot"))] |
|
(render/set-html tag res) |
|
(doseq [n (.querySelectorAll tag "g.node.foo")] |
|
(aset n "onclick" (fn [a] |
|
(prn :A a))))) |
|
; (prn :N n))) |
|
|
|
(p/catch (fn [ & args] |
|
(render/set-text tag "Failed to render")))) |
|
tag))) |
|
|
|
(defn pprint-block [] |
|
(p/let [res (editor/get-block) |
|
res (update res :text #(str "(clojure.pprint/pprint " % ")")) |
|
result (editor/eval res)] |
|
(println (:result result)))) |
|
|
|
(defn pprint-block-in-new-txt [] |
|
(p/let [res (editor/get-block) |
|
res (update res :text #(str "(with-out-str (clojure.pprint/pprint " % "))")) |
|
result (editor/eval (assoc res :aux true))] |
|
(editor/run-callback :open-editor |
|
{:file-name (str (gensym "eval-result-") ".clj") |
|
:line 0 |
|
:contents (str (:result result))}))) |
|
|
|
(render/register-tag :p/viz render-viz) |
|
|
|
(def table-html |
|
'(if (map? (:edn ?state)) |
|
[:div.rows |
|
[:div.title "Key/Vals"] |
|
[:div.space] |
|
[:table |
|
[:tr {:style {:border-bottom "4px double gray"}} |
|
[:th {:style {:border-right "1px solid gray"}} |
|
[:a {:href "#" :on-click (?sort true)} "Keys"]] |
|
[:th {:style {:padding-left "1em"}} |
|
[:a {:href "#" :on-click (?sort false)} "Vals"]]] |
|
[:<> |
|
(map (fn [i [k v]] |
|
[:tr {:key i} |
|
[:td {:style {:border-bottom "1px solid gray" |
|
:border-right "1px solid gray"} |
|
:width 1} |
|
[:div/clj k]] |
|
[:td {:style {:border-bottom "1px solid gray" |
|
:padding-left "1em"}} |
|
[:div/clj v]]]) |
|
(take (:show-first ?state) (range)) |
|
(cond->> (:edn ?state) |
|
(some? (:sort-by ?state)) |
|
(sort-by (if (:sort-by ?state) first second))))]] |
|
[:a {:href "#"} "..."]] |
|
[:div/clj (:edn ?state)])) |
|
|
|
(defn run-as-table [] |
|
(p/let [res (editor/get-block) |
|
res (update res |
|
:text |
|
#(str "{:html '" (pr-str table-html) |
|
" :state {:edn " % " :show-first 10}" |
|
" :fns {:sort '(fn [_ state k?]" |
|
" (assoc state :sort-by k?))}}"))] |
|
(editor/eval-interactive res))) |
|
|
|
(defn eval-and-trace [] |
|
(p/let [res (editor/get-block) |
|
res (update res :text #(str "(flow-storm.api/trace" % ")"))] |
|
(editor/eval-and-render res))) |
|
|
|
(def html-for-chess |
|
'(let [pieces {:black/pawn "\u265F" |
|
:black/rook "\u265C" |
|
:black/knight "\u265E" |
|
:black/bishop "\u265D" |
|
:black/queen "\u265B" |
|
:black/king "\u265A" |
|
:white/rook "\u2656" |
|
:white/knight "\u2658" |
|
:white/bishop "\u2657" |
|
:white/queen "\u2655" |
|
:white/king "\u2654" |
|
:white/pawn "\u2659"} |
|
w-style {:width "35pt" :height "35pt" |
|
:background-color "gray" |
|
:font-size "20pt" |
|
:text-align "center" |
|
:color "black"} |
|
b-style (assoc w-style :background-color "lightgray") |
|
tds (cycle [[:td {:style w-style}] [:td {:style b-style}]]) |
|
light-tds (take 8 (rest tds)) |
|
black-tds (take 8 tds) |
|
make-row (fn [col html-col] |
|
(conj html-col (str (pieces col)))) |
|
board (map (fn [row html-row] (map make-row row html-row)) |
|
?state (cycle [light-tds black-tds])) |
|
html-board (map (fn [tds] [:tr [:<> tds]]) board)] |
|
[:div |
|
[:table |
|
[:tbody [:<> html-board]]]])) |
|
|
|
(defn eval-chess-board [] |
|
(p/let [block (editor/get-block) |
|
res (update block :text #(str "{:html '" (pr-str html-for-chess) |
|
":state " % "}"))] |
|
(editor/eval-interactive res))) |
|
|
|
(editor/run-callback :notify {:type :info :title "Config reloaded"}) |