simon/mw-scittle
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

wip

Browse source
This commit is contained in:
Michiel Borkent 2022-05-10 17:00:04 +02:00
parent 0d204c7ae6
commit d36b87cdee
2 changed files with 63 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

8
deps.edn
View file

@ -2,12 +2,16 @@
:deps
{org.clojure/clojure {:mvn/version "1.10.3"}
org.babashka/sci {:mvn/version "0.3.1"}
org.babashka/sci {:mvn/version "0.3.5"}
reagent/reagent {:mvn/version "1.1.0"}
cljsjs/react {:mvn/version "17.0.2-0"}
cljsjs/react-dom {:mvn/version "17.0.2-0"}
cljsjs/react-dom-server {:mvn/version "17.0.2-0"}
cljs-ajax/cljs-ajax {:mvn/version "0.8.3"}}
cljs-ajax/cljs-ajax {:mvn/version "0.8.3"}
io.github.babashka/sci.nrepl
#_{:local/root "../sci.nrepl"}
{:git/sha "8998f2a4fd25ff02474d7298253e91f059f482b2"}}
:aliases
{:dev

63
src/scittle/core.cljs
View file

@ -1,9 +1,11 @@
(ns scittle.core
(:refer-clojure :exclude [time])
(:require [cljs.reader :refer [read-string]]
[clojure.edn :as edn]
[goog.object :as gobject]
[goog.string]
[sci.core :as sci]
[sci.nrepl.completions :refer [completions]]
[scittle.impl.common :refer [cljns]]
[scittle.impl.error :as error]))
@ -29,15 +31,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 +61,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 +80,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 +105,38 @@
(enable-console-print!)
(sci/alter-var-root sci/print-fn (constantly *print-fn*))
(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 (nrepl-reply msg (completions (assoc msg :ctx @!sci-ctx)))))
(defn ^:export init-nrepl []
(let [ws (nrepl-websocket)]
(set! (.-onmessage ws)
(fn [event]
(handle-nrepl-message (edn/read-string (.-data event)))))
(set! (.-onerror ws)
(fn [event]
(js/console.log event)))))