My Chlorine Config

chlorine-config.cljs

(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 " code "]]}")]
    (editor/eval-interactive {:text code :range curr-range})))

(defn dependencies-of-text []
  (p/let [{curr-txt :contents curr-range :range} (editor/run-callback :editor-data)
          {curr-ns :text} (editor/get-namespace)
          code (str "(->> `(do " 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 " code "]]}")]
    (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 "
                             %
                             "]]}")))))
    ; (prn :RES res)
    ; (editor/eval-interactive
    ;  (update res :text #(str "{:html [:div [:p/diag "
    ;                          (str/trim (pr-str %))
    ;                          "]]}")))))

(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 [[fst & r]]
;   (prn :PARSING fst)
;   (cond
;     (= 'def fst) (parse-elem (second r))
;     (= 'fn* fst) (parse-elem (cons 'do (->> r first rest)))
;     (= 'if fst) (when-let [[c t f] r]
;                   ; (when-let [s :FOO]
;                     [(str "[<question>" (first (parse-elem c)) "]")
;                      (first (parse-elem t))
;                      ; s
;                      (str "[<question>" (parse-elem c) "]")
;                      (first (parse-elem f))])
;                      ; s])
;     (= 'do fst) (mapcat parse-elem r)
;     :else [(pr-str (cons fst r))]))
;
; (defn- parse-elem [elem]
;   (prn :LIST? (list? elem) elem)
;   (if (list? elem)
;     (parse-list elem)
;     (pr-str elem)))
;
; (defn- normalize-tags [tags]
;   (let [tags (concat ["[<st> s]"] tags ["[<ed> e]"])]
;     (str "#.question: visual=rhomb\n"
;          "#.st: visual=start\n"
;          "#.ed: visual=end\n\n"
;          (->> tags
;               (partition 2 1)
;               (map (fn [[a b]] (str a "->" b)))
;               (str/join "\n")))))
;
; (defn flowchart-for []
;   (let [opts (editor/get-top-block)
;         txt (str "(clojure.walk/macroexpand-all '" (:text opts) ")")
;         {:keys [result]} (editor/eval txt (:range opts))
;         tags (parse-elem result)
;         norm (normalize-tags tags)]
;
;     (prn tags)
;     (println norm)
;     #_
;     (println
;          (str "#.question: visual=rhomb\n"
;               "#.st: visual=start\n"
;               "#.ed: visual=end\n\n"
;               "[<st> s]->"
;               ; (parse-elem result)
;               "[<ed> e]"))))

(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 flowchart-for []
;   (p/let [opts (editor/get-top-block)
;           txt (str "(clojure.walk/macroexpand-all '" (:text opts) ")")
;           {:keys [result]} (editor/eval txt (:range opts))
;           acc (atom {:st {:type :start :next []} :ed {:type :end}})
;           last-sym (parse-elem :st acc result)]
;
;
;     (println (normalize-tags @acc))
;     (editor/eval-interactive {:text (str "'{:html [:div [:p/diag "
;                                          (pr-str (normalize-tags @acc))
;                                          "]]}")
;                               :range (:range opts)})))

(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))
                         [: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]
   (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 :autodetect 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"}
        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 [:a {:href "#" :style {:color "black"}
                                       :on-click (fn [_] (editor/run-callback :on-copy
                                                                              (pr-str col)))}
                                   (str (pieces col))]))
        board (map (fn [row html-row]
                     (cons [:a.icon.clipboard {:href "#" :on-click (fn [_]
                                                                     (editor/run-callback :on-copy (pr-str 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)))

(defn eval-block-and-copy []
  (p/let [v (editor/get-block)
          v (update v :text #(str "(symbol (pr-str " % "))"))
          _ (prn :TXT v)
          eval-res (editor/eval-and-render v)]
    (editor/run-callback :on-copy (str (:result eval-res)))))

(def ^:private refresh-needs-clear (atom true))
(defn- full-refresh-command []
  (list 'if-let '[ref (requiring-resolve 'user/refresh)] '(ref)
        (if @refresh-needs-clear
          '(do
             (clojure.core/require '[clojure.tools.namespace.repl])
             (clojure.tools.namespace.repl/clear)
             (clojure.tools.namespace.repl/refresh-all))
          '(do
             (clojure.core/require '[clojure.tools.namespace.repl])
             (clojure.tools.namespace.repl/refresh)))))

(defn refresh []
  (p/let [_ (editor/eval {:text "(clojure.core/require '[clojure.tools.namespace.repl])"})
          contents (editor/get-selection)
          code (pr-str {:html ''[:div.rows
                                 [:div.title "Refresh result"]
                                 [:div.space]
                                 (if (= ?state :ok)
                                   [:div "Refresh successful"]
                                   [:div.error [:div/clj ?state]])]
                        :state (full-refresh-command)})]
    (-> (editor/eval-interactive (assoc contents :text code))
        (p/then #(reset! refresh-needs-clear (-> % :result (= :ok))))
        (p/catch #(reset! refresh-needs-clear false)))))

(editor/run-callback :notify {:type :info :title "Config reloaded"})

preparation.sh

cd ~/.atom/
mkdir chlorine/
cd chlorine
npm install nomnoml plantuml
echo "module.exports = require('nomnoml');" > nomno.js
echo "module.exports = require('plantuml');" > plant.js