Browser repl (#24)

This commit is contained in:
Michiel Borkent 2022-05-17 21:07:22 +02:00 committed by GitHub
parent 0d204c7ae6
commit 2a93334a43
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
10 changed files with 208 additions and 129 deletions

View file

@ -29,15 +29,29 @@
'goog.object {'set gobject/set
'get gobject/get}})
(def ctx (atom (sci/init {:namespaces namespaces
(def !sci-ctx (atom (sci/init {:namespaces namespaces
:classes {'js js/window
:allow :all}
:disable-arity-checks true})))
(def !last-ns (volatile! @sci/ns))
(defn- -eval-string [s]
(sci/binding [sci/ns @!last-ns]
(let [rdr (sci/reader s)]
(loop [res nil]
(let [form (sci/parse-next @!sci-ctx rdr)]
(if (= :sci.core/eof form)
(do
(vreset! !last-ns @sci/ns)
res)
(recur (sci/eval-form @!sci-ctx form))))))))
(defn ^:export eval-string [s]
(try (sci/eval-string* @ctx s)
(try (-eval-string s)
(catch :default e
(error/error-handler e (:src @ctx))
(error/error-handler e (:src @!sci-ctx))
(let [sci-error? (isa? (:type (ex-data e)) :sci/error)]
(throw (if sci-error?
(or (ex-cause e) e)
@ -45,14 +59,14 @@
(defn register-plugin! [plug-in-name sci-opts]
plug-in-name ;; unused for now
(swap! ctx sci/merge-opts sci-opts))
(swap! !sci-ctx sci/merge-opts sci-opts))
(defn- eval-script-tags* [script-tags]
(when-let [tag (first script-tags)]
(if-let [text (not-empty (gobject/get tag "textContent"))]
(let [scittle-id (str (gensym "scittle-tag-"))]
(gobject/set tag "scittle_id" scittle-id)
(swap! ctx assoc-in [:src scittle-id] text)
(swap! !sci-ctx assoc-in [:src scittle-id] text)
(sci/binding [sci/file scittle-id]
(eval-string text))
(eval-script-tags* (rest script-tags)))
@ -64,7 +78,7 @@
(let [response (gobject/get this "response")]
(gobject/set tag "scittle_id" src)
;; save source for error messages
(swap! ctx assoc-in [:src src] response)
(swap! !sci-ctx assoc-in [:src src] response)
(sci/binding [sci/file src]
(eval-string response)))
(eval-script-tags* (rest script-tags)))))]
@ -89,3 +103,4 @@
(enable-console-print!)
(sci/alter-var-root sci/print-fn (constantly *print-fn*))

45
src/scittle/nrepl.cljs Normal file
View file

@ -0,0 +1,45 @@
(ns scittle.nrepl
(:require
[clojure.edn :as edn]
[sci.nrepl.completions :refer [completions]]
[scittle.core :refer [!last-ns eval-string !sci-ctx]]))
(defn nrepl-websocket []
(.-ws_nrepl js/window))
(defn nrepl-reply [{:keys [id session]} payload]
(.send (nrepl-websocket)
(str (assoc payload :id id :session session :ns (str @!last-ns)))))
(defn handle-nrepl-eval [{:keys [code] :as msg}]
(let [[kind val] (try [::success (eval-string code)]
(catch :default e
[::error (str e)]))]
(case kind
::success
(do (nrepl-reply msg {:value (pr-str val)})
(nrepl-reply msg {:status ["done"]}))
::error
(do
(nrepl-reply msg {:err (pr-str val)})
(nrepl-reply msg {:ex (pr-str val)
:status ["error" "done"]})))))
(defn handle-nrepl-message [msg]
(case (:op msg)
:eval (handle-nrepl-eval msg)
:complete (let [completions (completions (assoc msg :ctx @!sci-ctx))]
(nrepl-reply msg completions))))
(when (.-SCITTLE_NREPL_WEBSOCKET_PORT js/window)
(set! (.-ws_nrepl js/window)
(new js/WebSocket "ws://localhost:1340/_nrepl")))
(when-let [ws (nrepl-websocket)]
(prn :ws ws)
(set! (.-onmessage ws)
(fn [event]
(handle-nrepl-message (edn/read-string (.-data event)))))
(set! (.-onerror ws)
(fn [event]
(js/console.log event))))

View file

@ -1,106 +1,10 @@
(ns scittle.reagent
(:require [reagent.core :as r]
[reagent.debug :as d :refer-macros [dev?]]
[reagent.dom :as rdom]
[reagent.ratom :as ratom]
[sci.core :as sci]
[scittle.core :as scittle]))
;; The with-let macro from reagent.core. The only change is that the
;; interop/unchecked-aget+set were replaced by aget and aset.
(defn ^:macro with-let [_ _ bindings & body]
(assert (vector? bindings)
(str "with-let bindings must be a vector, not "
(pr-str bindings)))
(let [v (gensym "with-let")
k (keyword v)
init (gensym "init")
;; V is a reaction, which holds a JS array.
;; If the array is empty, initialize values and store to the
;; array, using binding index % 2 to access the array.
;; After init, the bindings are just bound to the values in the array.
bs (into [init `(zero? (alength ~v))]
(map-indexed (fn [i x]
(if (even? i)
x
(let [j (quot i 2)]
;; Issue 525
;; If binding value is not yet set,
;; try setting it again. This should
;; also throw errors for each render
;; and prevent the body being called
;; if bindings throw errors.
`(if (or ~init
(not (.hasOwnProperty ~v ~j)))
(aset ~v ~j ~x)
(aget ~v ~j)))))
bindings))
[forms destroy] (let [fin (last body)]
(if (and (list? fin)
(= 'finally (first fin)))
[(butlast body) `(fn [] ~@(rest fin))]
[body nil]))
add-destroy (when destroy
(list
`(let [destroy# ~destroy]
(if (reagent.ratom/reactive?)
(when (nil? (.-destroy ~v))
(set! (.-destroy ~v) destroy#))
(destroy#)))))
asserting (dev?) #_(if *assert* true false)
res (gensym "res")]
`(let [~v (reagent.ratom/with-let-values ~k)]
~(when asserting
`(when-some [c# (reagent.ratom/-ratom-context)]
(when (== (.-generation ~v) (.-ratomGeneration c#))
(d/error "Warning: The same with-let is being used more "
"than once in the same reactive context."))
(set! (.-generation ~v) (.-ratomGeneration c#))))
(let ~(into bs [res `(do ~@forms)])
~@add-destroy
~res))))
(def rns (sci/create-ns 'reagent.core nil))
(def reagent-namespace
{'atom (sci/copy-var r/atom rns)
'as-element (sci/copy-var r/as-element rns)
'with-let (sci/copy-var with-let rns)
'cursor (sci/copy-var r/cursor rns)
'create-class (sci/copy-var r/create-class rns)
'create-compiler (sci/copy-var r/create-compiler rns)})
(def rtmns (sci/create-ns 'reagent.ratom nil))
(defn -ratom-context
"Read-only access to the ratom context."
[]
ratom/*ratom-context*)
(def reagent-ratom-namespace
{'with-let-values (sci/copy-var ratom/with-let-values rtmns)
'reactive? (sci/copy-var ratom/reactive? rtmns)
'-ratom-context (sci/copy-var -ratom-context rtmns)})
(def rdbgns (sci/create-ns 'reagent.debug nil))
(defn -tracking? []
reagent.debug/tracking)
(defn ^:macro error
"Print with console.error."
[_ _ & forms]
(when *assert*
`(when (some? js/console)
(.error (if (reagent.debug/-tracking?)
reagent.debug/track-console
js/console)
(str ~@forms)))))
(def reagent-debug-namespace
{'error (sci/copy-var error rdbgns)
'-tracking? (sci/copy-var -tracking? rdbgns)
'track-console (sci/copy-var d/track-console rdbgns)})
(:require
[reagent.dom :as rdom]
[sci.configs.reagent.reagent :refer [reagent-debug-namespace
reagent-namespace reagent-ratom-namespace]]
[sci.core :as sci]
[scittle.core :as scittle]))
(def rdns (sci/create-ns 'reagent.dom nil))