diff --git a/package.json b/package.json index 3c91a70..dff5410 100644 --- a/package.json +++ b/package.json @@ -27,9 +27,9 @@ }, "dependencies": { "historic-readline": "^1.0.8", - "lumo": "^0.20.6", "lumo-cljs": "1.7.0", "os-homedir": "^1.0.2", + "packed-printer": "^0.3.0", "unzipper": "^0.8.11" } } diff --git a/resources/unrepl/blob.clj b/resources/unrepl/blob.clj index f78856f..2f880f1 100644 --- a/resources/unrepl/blob.clj +++ b/resources/unrepl/blob.clj @@ -1 +1 @@ -(clojure.core/let [prefix__641__auto__ (clojure.core/name (clojure.core/gensym)) code__642__auto__ (.replaceAll "(ns unrepl.print\n (:require [clojure.string :as str]\n [clojure.edn :as edn]\n [clojure.main :as main]))\n\n(def ^:dynamic *elide*\n \"Function of 1 argument which returns the elision.\"\n (constantly nil))\n\n(def ^:dynamic *attach* nil)\n\n(def ^:dynamic *string-length* 80)\n\n(defprotocol DefaultEdnize\n (default-ednize [x]))\n\n(def ^:dynamic *ednize* #'default-ednize)\n\n(def ^:dynamic *realize-on-print*\n \"Set to false to avoid realizing lazy sequences.\"\n true)\n\n(deftype ElidedKVs [s]\n clojure.lang.Seqable\n (seq [_] (seq s)))\n\n(def atomic? (some-fn nil? true? false? char? string? symbol? keyword? #(and (number? %) (not (ratio? %)))))\n\n(defn- as-str\n \"Like pr-str but escapes all ASCII control chars.\"\n [x]\n ;hacky\n (cond\n (string? x) (str/replace (pr-str x) #\"\\p{Cntrl}\"\n #(format \"\\\\u%04x\" (int (.charAt ^String % 0))))\n (char? x) (str/replace (pr-str x) #\"\\p{Cntrl}\"\n #(format \"u%04x\" (int (.charAt ^String % 0))))\n :else (pr-str x)))\n\n(defmacro ^:private latent-fn [& fn-body]\n `(let [d# (delay (binding [*ns* (find-ns '~(ns-name *ns*))] (eval '(fn ~@fn-body))))]\n (fn\n ([] (@d#))\n ([x#] (@d# x#))\n ([x# & xs#] (apply @d# x# xs#)))))\n\n(defn- as-inst [x]\n (edn/read-string {:readers {'inst #(tagged-literal 'inst %)}} (pr-str x)))\n\n(def ^:dynamic *object-representations*\n \"map of classes to functions returning their representation component (3rd item in #unrepl/object [class id rep])\"\n {clojure.lang.IDeref\n (fn [x]\n (let [pending? (and (instance? clojure.lang.IPending x) ; borrowed from https://github.com/brandonbloom/fipp/blob/8df75707e355c1a8eae5511b7d73c1b782f57293/src/fipp/ednize.clj#L37-L51\n (not (.isRealized ^clojure.lang.IPending x)))\n [ex val] (when-not pending?\n (try [false @x]\n (catch Throwable e\n [true e])))\n failed? (or ex (and (instance? clojure.lang.Agent x)\n (agent-error x)))\n status (cond\n failed? :failed\n pending? :pending\n :else :ready)]\n {:unrepl.ref/status status :unrepl.ref/val val}))\n \n clojure.lang.AFn\n (fn [x]\n (let [[_ ns name] (re-matches #\"(?:(.+?)/)?(.*)\" (-> x class .getName main/demunge))]\n ; the regex ensure the first group is nil when no ns\n (symbol ns name)))\n \n java.io.File (fn [^java.io.File f]\n (into {:path (.getPath f)}\n (when (and *attach* (.isFile f))\n {:attachment (tagged-literal 'unrepl/mime\n (into {:content-type \"application/octet-stream\"\n :content-length (.length f)}\n (*attach* #(java.io.FileInputStream. f))))})))\n \n java.awt.Image (latent-fn [^java.awt.Image img]\n (let [w (.getWidth img nil)\n h (.getHeight img nil)]\n (into {:width w, :height h}\n (when *attach*\n {:attachment\n (tagged-literal 'unrepl/mime\n (into {:content-type \"image/png\"}\n (*attach* #(let [bos (java.io.ByteArrayOutputStream.)]\n (when (javax.imageio.ImageIO/write\n (doto (java.awt.image.BufferedImage. w h java.awt.image.BufferedImage/TYPE_INT_ARGB)\n (-> .getGraphics (.drawImage img 0 0 nil)))\n \"png\" bos)\n (java.io.ByteArrayInputStream. (.toByteArray bos)))))))}))))\n \n Object (fn [x]\n (if (-> x class .isArray)\n (seq x)\n (str x)))})\n\n(defn- object-representation [x] \n (reduce-kv (fn [_ class f]\n (when (instance? class x) (reduced (f x)))) nil *object-representations*)) ; todo : cache\n\n(defn- class-form [^Class x]\n (if (.isArray x) [(-> x .getComponentType class-form)] (symbol (.getName x))))\n\n(def unreachable (tagged-literal 'unrepl/... nil))\n\n(def ^:dynamic *need-quote* false)\n(defn quoted? [x]\n (and (tagged-literal? x) (= 'unrepl/quote (:tag x))))\n(defn may-quote [x]\n (if (and (tagged-literal? x) *need-quote* (re-find #\"^unrepl(?:\\..+)?\" (namespace (:tag x))))\n (tagged-literal 'unrepl/quote x)\n x))\n(defn may-quote-kv [[k v]]\n [(may-quote k) (may-quote v)])\n\n(extend-protocol DefaultEdnize\n clojure.lang.TaggedLiteral (default-ednize [x] x)\n clojure.lang.Ratio (default-ednize [^clojure.lang.Ratio x] (tagged-literal 'unrepl/ratio [(.numerator x) (.denominator x)]))\n clojure.lang.Var (default-ednize [x]\n (tagged-literal 'clojure/var\n (when-some [ns (:ns (meta x))] ; nil when local var\n (symbol (name (ns-name ns)) (name (:name (meta x)))))))\n Throwable (default-ednize [t] (tagged-literal 'error (Throwable->map t)))\n Class (default-ednize [x] (tagged-literal 'unrepl.java/class (class-form x)))\n java.util.Date (default-ednize [x] (as-inst x))\n java.util.Calendar (default-ednize [x] (as-inst x))\n java.sql.Timestamp (default-ednize [x] (as-inst x))\n clojure.lang.Namespace (default-ednize [x] (tagged-literal 'unrepl/ns (ns-name x)))\n java.util.regex.Pattern (default-ednize [x] (tagged-literal 'unrepl/pattern (str x)))\n Object\n (default-ednize [x]\n (tagged-literal 'unrepl/object\n [(class x) (format \"0x%x\" (System/identityHashCode x)) (object-representation x)\n {:bean {unreachable (tagged-literal 'unrepl/... (*elide* (ElidedKVs. (bean x))))}}])))\n\n(defmacro ^:private blame-seq [& body]\n `(try (seq ~@body)\n (catch Throwable t#\n (list (tagged-literal 'unrepl/lazy-error t#)))))\n\n(defn- may-print? [s]\n (or *realize-on-print* (not (instance? clojure.lang.IPending s)) (realized? s)))\n\n(defn- elide-vs [vs print-length]\n (if-some [more-vs (seq (drop print-length vs))]\n (concat (map may-quote (take print-length vs)) [(tagged-literal 'unrepl/... (*elide* more-vs))])\n (map may-quote vs)))\n\n(defn- elide-kvs [kvs print-length]\n (if-some [more-kvs (seq (drop print-length kvs))]\n (concat (map may-quote-kv (take print-length kvs)) [[unreachable (tagged-literal 'unrepl/... (*elide* (ElidedKVs. more-kvs)))]])\n (map may-quote-kv kvs)))\n\n(defn ednize \"Shallow conversion to edn safe subset.\" \n ([x] (ednize x *print-length* *print-meta*))\n ([x print-length] (ednize x print-length *print-meta*))\n ([x print-length print-meta]\n (cond\n (atomic? x) x\n (and print-meta (meta x)) (tagged-literal 'unrepl/meta [(meta x) (ednize x print-length false)])\n (map? x) (into {} (elide-kvs x print-length))\n (instance? ElidedKVs x) (ElidedKVs. (elide-kvs x print-length))\n (instance? clojure.lang.MapEntry x) x\n (vector? x) (into (empty x) (elide-vs x print-length))\n (seq? x) (elide-vs x print-length)\n (set? x) (into #{} (elide-vs x print-length))\n :else (let [x' (*ednize* x)]\n (if (= x x')\n x\n (recur x' print-length print-meta)))))) ; todo : cache\n\n(declare print-on)\n\n(defn- print-vs \n ([write vs rem-depth]\n (print-vs write vs rem-depth print-on \" \"))\n ([write vs rem-depth print-v sep]\n (when-some [[v & vs] (seq vs)]\n (print-v write v rem-depth)\n (doseq [v vs]\n (write sep)\n (print-v write v rem-depth)))))\n\n(defn- print-kv [write [k v] rem-depth]\n (print-on write k rem-depth)\n (write \" \")\n (print-on write v rem-depth))\n\n(defn- print-kvs [write kvs rem-depth]\n (print-vs write kvs rem-depth print-kv \", \"))\n\n(defn- print-on [write x rem-depth]\n (let [rem-depth (dec rem-depth)\n x (ednize x (if (neg? rem-depth) 0 *print-length*))]\n (cond\n (tagged-literal? x)\n (do\n (write (str \"#\" (:tag x) \" \"))\n (case (and *need-quote* (:tag x))\n unrepl/quote (binding [*need-quote* false]\n (print-on write (:form x) rem-depth))\n unrepl/... (binding ; don't elide the elision \n [*print-length* Long/MAX_VALUE\n *print-level* Long/MAX_VALUE\n *string-length* Long/MAX_VALUE]\n (print-on write (:form x) Long/MAX_VALUE))\n (recur write (:form x) rem-depth)))\n (map? x) (let [elision (get x unreachable)\n x (dissoc x unreachable)]\n (write \"{\")\n (print-kvs write x rem-depth)\n (when elision\n (write \", \")\n (print-on write unreachable rem-depth)\n (write \" \")\n (print-on write elision rem-depth))\n (write \"}\"))\n (instance? ElidedKVs x) (do (write \"{\") (print-kvs write x rem-depth) (write \"}\"))\n (vector? x) (do (write \"[\") (print-vs write x rem-depth) (write \"]\"))\n (seq? x) (do (write \"(\") (print-vs write x rem-depth) (write \")\"))\n (set? x) (do (write \"#{\") (print-vs write x rem-depth) (write \"}\"))\n (and (string? x) (> (count x) *string-length*))\n (let [i (if (and (Character/isHighSurrogate (.charAt ^String x (dec *string-length*)))\n (Character/isLowSurrogate (.charAt ^String x *string-length*)))\n (inc *string-length*) *string-length*)\n prefix (subs x 0 i)\n rest (subs x i)]\n (if (= rest \"\")\n (write (as-str x))\n (do\n (write \"#unrepl/string [\")\n (write (as-str prefix))\n (write \" \")\n (print-on write (tagged-literal 'unrepl/... (*elide* rest)) rem-depth)\n (write \"]\"))))\n (atomic? x) (write (as-str x))\n :else (throw (ex-info \"Can't print value.\" {:value x})))))\n\n(defn edn-str [x]\n (let [out (java.io.StringWriter.)\n write (fn [^String s] (.write out s))]\n (binding [*print-readably* true\n *print-length* (or *print-length* 10)]\n (print-on write x (or *print-level* 8))\n (str out))))\n\n(defn full-edn-str [x]\n (binding [*print-length* Long/MAX_VALUE\n *print-level* Long/MAX_VALUE]\n (edn-str x)))\n(ns unrepl.repl\n (:require [clojure.main :as m]\n [unrepl.print :as p]\n [clojure.edn :as edn]\n [clojure.java.io :as io]))\n\n(defn classloader\n \"Creates a classloader that obey standard delegating policy.\n Takes two arguments: a parent classloader and a function which\n takes a keyword (:resource or :class) and a string (a resource or a class name) and returns an array of bytes\n or nil.\"\n [parent f]\n (let [define-class (doto (.getDeclaredMethod ClassLoader \"defineClass\" (into-array [String (Class/forName \"[B\") Integer/TYPE Integer/TYPE]))\n (.setAccessible true))]\n (proxy [ClassLoader] [parent]\n (findResource [name]\n (when-some [bytes (f :resource name)]\n (let [file (doto (java.io.File/createTempFile \"unrepl-sideload-\" (str \"-\" (re-find #\"[^/]*$\" name)))\n .deleteOnExit)]\n (io/copy bytes file)\n (-> file .toURI .toURL))))\n (findClass [name]\n (if-some [bytes (f :class name)]\n (.invoke define-class this (to-array name bytes 0 (count bytes)))\n (throw (ClassNotFoundException. name)))))))\n\n(defn ^java.io.Writer tagging-writer\n ([write]\n (proxy [java.io.Writer] []\n (close []) ; do not cascade\n (flush []) ; atomic always flush\n (write\n ([x]\n (write (cond \n (string? x) x\n (integer? x) (str (char x))\n :else (String. ^chars x))))\n ([string-or-chars off len]\n (when (pos? len)\n (write (subs (if (string? string-or-chars) string-or-chars (String. ^chars string-or-chars))\n off (+ off len))))))))\n ([tag write]\n (tagging-writer (fn [s] (write [tag s]))))\n ([tag group-id write]\n (tagging-writer (fn [s] (write [tag s group-id])))))\n\n(defn blame-ex [phase ex]\n (if (::phase (ex-data ex))\n ex\n (ex-info (str \"Exception during \" (name phase) \" phase.\")\n {::ex ex ::phase phase} ex)))\n\n(defmacro blame [phase & body]\n `(try ~@body\n (catch Throwable t#\n (throw (blame-ex ~phase t#)))))\n\n(defn atomic-write [^java.io.Writer w]\n (fn [x]\n (let [s (blame :print (p/edn-str x))] ; was pr-str, must occur outside of the locking form to avoid deadlocks\n (locking w\n (.write w s)\n (.write w \"\\n\")\n (.flush w)))))\n\n(defn fuse-write [awrite]\n (fn [x]\n (when-some [w @awrite]\n (try\n (w x)\n (catch Throwable t\n (reset! awrite nil))))))\n\n(def ^:dynamic write)\n\n(defn quoted-write [x]\n (binding [p/*need-quote* true] (write x)))\n\n(defn unrepl-reader [^java.io.Reader r before-read]\n (let [offset (atom 0)\n offset! #(swap! offset + %)]\n (proxy [clojure.lang.LineNumberingPushbackReader clojure.lang.ILookup] [r]\n (valAt\n ([k] (get this k nil))\n ([k not-found] (case k :offset @offset not-found)))\n (read\n ([]\n (before-read)\n (let [c (proxy-super read)]\n (when-not (neg? c) (offset! 1))\n c))\n ([cbuf]\n (before-read)\n (let [n (proxy-super read cbuf)]\n (when (pos? n) (offset! n))\n n))\n ([cbuf off len]\n (before-read)\n (let [n (proxy-super read cbuf off len)]\n (when (pos? n) (offset! n))\n n)))\n (unread\n ([c-or-cbuf]\n (if (integer? c-or-cbuf)\n (when-not (neg? c-or-cbuf) (offset! -1))\n (offset! (- (alength c-or-cbuf))))\n (proxy-super unread c-or-cbuf))\n ([cbuf off len]\n (offset! (- len))\n (proxy-super unread cbuf off len)))\n (skip [n]\n (let [n (proxy-super skip n)]\n (offset! n)\n n))\n (readLine []\n (when-some [s (proxy-super readLine)]\n (offset! (count s))\n s)))))\n\n(defn- close-socket! [x]\n ; hacky way because the socket is not exposed by clojure.core.server\n (loop [x x]\n (if (= \"java.net.SocketInputStream\" (.getName (class x)))\n (do (.close x) true)\n (when-some [^java.lang.reflect.Field field \n (->> x class (iterate #(.getSuperclass %)) (take-while identity)\n (mapcat #(.getDeclaredFields %))\n (some #(when (#{\"in\" \"sd\"} (.getName ^java.lang.reflect.Field %)) %)))]\n (recur (.get (doto field (.setAccessible true)) x))))))\n\n(defn soft-store [make-action not-found]\n (let [ids-to-refs (atom {})\n refs-to-ids (atom {})\n refq (java.lang.ref.ReferenceQueue.)\n NULL (Object.)]\n (.start (Thread. (fn []\n (let [ref (.remove refq)]\n (let [id (@refs-to-ids ref)]\n (swap! refs-to-ids dissoc ref)\n (swap! ids-to-refs dissoc id)))\n (recur))))\n {:put (fn [x]\n (let [x (if (nil? x) NULL x)\n id (keyword (gensym))\n ref (java.lang.ref.SoftReference. x refq)]\n (swap! refs-to-ids assoc ref id)\n (swap! ids-to-refs assoc id ref)\n {:get (make-action id)}))\n :get (fn [id]\n (if-some [x (some-> @ids-to-refs ^java.lang.ref.Reference (get id) .get)]\n (if (= NULL x) nil x)\n not-found))}))\n\n(defn- base64-encode [^java.io.InputStream in]\n (let [table \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"\n sb (StringBuilder.)]\n (loop [shift 4 buf 0]\n (let [got (.read in)]\n (if (neg? got)\n (do\n (when-not (= shift 4)\n (let [n (bit-and (bit-shift-right buf 6) 63)]\n (.append sb (.charAt table n))))\n (cond\n (= shift 2) (.append sb \"==\")\n (= shift 0) (.append sb \\=))\n (str sb))\n (let [buf (bit-or buf (bit-shift-left got shift))\n n (bit-and (bit-shift-right buf 6) 63)]\n (.append sb (.charAt table n))\n (let [shift (- shift 2)]\n (if (neg? shift)\n (do\n (.append sb (.charAt table (bit-and buf 63)))\n (recur 4 0))\n (recur shift (bit-shift-left buf 6))))))))))\n\n(defn- base64-decode [^String s]\n (let [table \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"\n in (java.io.StringReader. s)\n bos (java.io.ByteArrayOutputStream.)]\n (loop [bits 0 buf 0]\n (let [got (.read in)]\n (when-not (or (neg? got) (= 61 #_\\= got))\n (let [buf (bit-or (.indexOf table got) (bit-shift-left buf 6))\n bits (+ bits 6)]\n (if (<= 8 bits)\n (let [bits (- bits 8)]\n (.write bos (bit-shift-right buf bits))\n (recur bits (bit-and 63 buf)))\n (recur bits buf))))))\n (.toByteArray bos)))\n\n(defonce ^:private sessions (atom {}))\n\n(defonce ^:private elision-store (soft-store #(list `fetch %) p/unreachable))\n(defn fetch [id] \n (let [x ((:get elision-store) id)]\n (cond\n (= p/unreachable x) x\n (instance? unrepl.print.ElidedKVs x) x\n (string? x) x\n :else (seq x))))\n\n(defonce ^:private attachment-store (soft-store #(list `download %) (constantly nil)))\n(defn download [id] ((:get attachment-store) id))\n\n(defn session [id]\n (some-> @sessions (get id) deref))\n\n(defn interrupt! [session-id eval]\n (let [{:keys [^Thread thread eval-id promise]}\n (some-> session-id session :current-eval)]\n (when (and (= eval eval-id)\n (deliver promise\n {:ex (doto (ex-info \"Evaluation interrupted\" {::phase :eval})\n (.setStackTrace (.getStackTrace thread)))\n :bindings {}}))\n (.stop thread)\n true)))\n\n(defn background! [session-id eval]\n (let [{:keys [eval-id promise future]}\n (some-> session-id session :current-eval)]\n (boolean\n (and\n (= eval eval-id)\n (deliver promise\n {:eval future\n :bindings {}})))))\n\n(defn exit! [session-id] ; too violent\n (some-> session-id session :in close-socket!))\n\n(defn reattach-outs! [session-id]\n (some-> session-id session :write-atom \n (reset!\n (if (bound? #'write)\n write\n (let [out *out*]\n (fn [x]\n (binding [*out* out\n *print-readably* true]\n (prn x))))))))\n\n(defn attach-sideloader! [session-id]\n (prn '[:unrepl.jvm.side-loader/hello])\n (some-> session-id session :side-loader \n (reset!\n (let [out *out*\n in *in*]\n (fn self [k name]\n (binding [*out* out]\n (locking self\n (prn [k name])\n (some-> (edn/read {:eof nil} in) base64-decode)))))))\n (let [o (Object.)] (locking o (.wait o))))\n\n(defn set-file-line-col [session-id file line col]\n (when-some [^java.lang.reflect.Field field \n (->> clojure.lang.LineNumberingPushbackReader\n .getDeclaredFields\n (some #(when (= \"_columnNumber\" (.getName ^java.lang.reflect.Field %)) %)))]\n (doto field (.setAccessible true)) ; sigh\n (when-some [in (some-> session-id session :in)]\n (set! *file* file)\n (set! *source-path* file)\n (.setLineNumber in line)\n (.set field in (int col)))))\n\n(defn get-set-print-limits [string-length coll-length nesting-depth]\n (let [bak {:unrepl.print/string-length p/*string-length*\n :unrepl.print/coll-length *print-length*\n :unrepl.print/nesting-depth *print-level*}]\n (some->> string-length (set! p/*string-length*))\n (some->> coll-length (set! *print-length*))\n (some->> nesting-depth (set! *print-level*))\n bak))\n\n(defn- writers-flushing-repo [max-latency-ms]\n (let [writers (java.util.WeakHashMap.)\n flush-them-all #(locking writers\n (doseq [^java.io.Writer w (.keySet writers)]\n (.flush w)))]\n (.scheduleAtFixedRate\n (java.util.concurrent.Executors/newScheduledThreadPool 1)\n flush-them-all\n max-latency-ms max-latency-ms java.util.concurrent.TimeUnit/MILLISECONDS)\n (fn [w]\n (locking writers (.put writers w nil)))))\n\n(defmacro ^:private flushing [bindings & body]\n `(binding ~bindings\n (try ~@body\n (finally ~@(for [v (take-nth 2 bindings)]\n `(.flush ~(vary-meta v assoc :tag 'java.io.Writer)))))))\n\n(defn start []\n (with-local-vars [in-eval false\n unrepl false\n eval-id 0\n prompt-vars #{#'*ns* #'*warn-on-reflection*}\n current-eval-future nil]\n (let [session-id (keyword (gensym \"session\"))\n raw-out *out*\n aw (atom (atomic-write raw-out))\n write-here (fuse-write aw)\n schedule-writer-flush! (writers-flushing-repo 50) ; 20 fps (flushes per second)\n scheduled-writer (fn [& args]\n (-> (apply tagging-writer args)\n java.io.BufferedWriter.\n (doto schedule-writer-flush!)))\n edn-out (scheduled-writer :out write-here)\n ensure-raw-repl (fn []\n (when (and @in-eval @unrepl) ; reading from eval!\n (var-set unrepl false)\n (write [:bye {:reason :upgrade :actions {}}])\n (flush)\n ; (reset! aw (blocking-write))\n (set! *out* raw-out)))\n in (unrepl-reader *in* ensure-raw-repl)\n session-state (atom {:current-eval {}\n :in in\n :write-atom aw\n :log-eval (fn [msg]\n (when (bound? eval-id)\n (quoted-write [:log msg @eval-id])))\n :log-all (fn [msg]\n (quoted-write [:log msg nil]))\n :side-loader (atom nil)\n :prompt-vars #{#'*ns* #'*warn-on-reflection*}})\n current-eval-thread+promise (atom nil)\n ensure-unrepl (fn []\n (when-not @unrepl\n (var-set unrepl true)\n (flush)\n (set! *out* edn-out)\n (binding [*print-length* Long/MAX_VALUE\n *print-level* Long/MAX_VALUE\n p/*string-length* Long/MAX_VALUE]\n (write [:unrepl/hello {:session session-id\n :actions (into\n {:exit `(exit! ~session-id)\n :start-aux `(start-aux ~session-id)\n :log-eval\n `(some-> ~session-id session :log-eval)\n :log-all\n `(some-> ~session-id session :log-all)\n :print-limits\n `(unrepl/do\n (get-set-print-limits ~(tagged-literal 'unrepl/param :unrepl.print/string-length)\n ~(tagged-literal 'unrepl/param :unrepl.print/coll-length)\n ~(tagged-literal 'unrepl/param :unrepl.print/nesting-depth)))\n :set-source\n `(unrepl/do\n (set-file-line-col ~session-id\n ~(tagged-literal 'unrepl/param :unrepl/sourcename)\n ~(tagged-literal 'unrepl/param :unrepl/line)\n ~(tagged-literal 'unrepl/param :unrepl/column)))\n :unrepl.jvm/start-side-loader\n `(attach-sideloader! ~session-id)}\n {})}]))))\n \n interruptible-eval\n (fn [form]\n (try\n (let [original-bindings (get-thread-bindings)\n p (promise)\n f\n (future\n (swap! session-state update :current-eval\n assoc :thread (Thread/currentThread))\n (with-bindings original-bindings\n (try\n (write [:started-eval\n {:actions \n {:interrupt (list `interrupt! session-id @eval-id)\n :background (list `background! session-id @eval-id)}}\n @eval-id])\n (let [v (with-bindings {in-eval true}\n (blame :eval (eval form)))]\n (deliver p {:eval v :bindings (get-thread-bindings)})\n v)\n (catch Throwable t\n (deliver p {:ex t :bindings (get-thread-bindings)})\n (throw t)))))]\n (swap! session-state update :current-eval\n into {:eval-id @eval-id :promise p :future f})\n (let [{:keys [ex eval bindings]} @p]\n (doseq [[var val] bindings\n :when (not (identical? val (original-bindings var)))]\n (var-set var val))\n (if ex\n (throw ex)\n eval)))\n (finally\n (swap! session-state assoc :current-eval {}))))\n cl (.getContextClassLoader (Thread/currentThread))\n slcl (classloader cl\n (fn [k x]\n (when-some [f (some-> session-state deref :side-loader deref)]\n (f k x))))]\n (swap! session-state assoc :class-loader slcl)\n (swap! sessions assoc session-id session-state)\n (binding [*out* raw-out\n *err* (tagging-writer :err write)\n *in* in\n *file* \"unrepl-session\"\n *source-path* \"unrepl-session\"\n p/*elide* (:put elision-store)\n p/*attach* (:put attachment-store)\n p/*string-length* p/*string-length* \n *print-length* (or *print-length* 10)\n *print-level* (or *print-level* 8) \n write write-here]\n (.setContextClassLoader (Thread/currentThread) slcl)\n (with-bindings {clojure.lang.Compiler/LOADER slcl}\n (try\n (m/repl\n :prompt (fn []\n (ensure-unrepl)\n (write [:prompt (into {:file *file*\n :line (.getLineNumber *in*)\n :column (.getColumnNumber *in*)\n :offset (:offset *in*)}\n (map (fn [v]\n (let [m (meta v)]\n [(symbol (name (ns-name (:ns m))) (name (:name m))) @v])))\n (:prompt-vars @session-state))]))\n :read (fn [request-prompt request-exit]\n (blame :read (let [line+col [(.getLineNumber *in*) (.getColumnNumber *in*)]\n offset (:offset *in*)\n r (m/repl-read request-prompt request-exit)\n line+col' [(.getLineNumber *in*) (.getColumnNumber *in*)]\n offset' (:offset *in*)\n len (- offset' offset)\n id (when-not (#{request-prompt request-exit} r)\n (var-set eval-id (inc @eval-id)))]\n (write [:read {:from line+col :to line+col'\n :offset offset\n :len (- offset' offset)}\n id])\n (if (and (seq? r) (= (first r) 'unrepl/do))\n (let [id @eval-id]\n (flushing [*err* (tagging-writer :err id write)\n *out* (scheduled-writer :out id write)]\n (eval (cons 'do (next r))))\n request-prompt)\n r))))\n :eval (fn [form]\n (let [id @eval-id]\n (flushing [*err* (tagging-writer :err id write)\n *out* (scheduled-writer :out id write)]\n (interruptible-eval form))))\n :print (fn [x]\n (ensure-unrepl)\n (quoted-write [:eval x @eval-id]))\n :caught (fn [e]\n (ensure-unrepl)\n (let [{:keys [::ex ::phase]\n :or {ex e phase :repl}} (ex-data e)]\n (quoted-write [:exception {:ex e :phase phase} @eval-id]))))\n (finally\n (.setContextClassLoader (Thread/currentThread) cl))))\n (write [:bye {:reason :disconnection\n :outs :muted\n :actions {:reattach-outs `(reattach-outs! ~session-id)}}])))))\n\n(defn start-aux [session-id]\n (let [cl (.getContextClassLoader (Thread/currentThread))]\n (try\n (some->> session-id session :class-loader (.setContextClassLoader (Thread/currentThread)))\n (start)\n (finally\n (.setContextClassLoader (Thread/currentThread) cl)))))\n\n;; WIP for extensions\n\n(defmacro ensure-ns [[fully-qualified-var-name & args :as expr]]\n `(do\n (require '~(symbol (namespace fully-qualified-var-name)))\n ~expr))\n(ns user)\n(unrepl.repl/start)" "(? code__642__auto__ java.io.StringReader. clojure.lang.LineNumberingPushbackReader.)] (try (clojure.core/binding [clojure.core/*ns* clojure.core/*ns*] (clojure.core/loop [ret__644__auto__ nil] (clojure.core/let [form__645__auto__ (clojure.core/read rdr__643__auto__ false (quote eof__646__auto__))] (if (clojure.core/= (quote eof__646__auto__) form__645__auto__) ret__644__auto__ (recur (clojure.core/eval form__645__auto__)))))) (catch java.lang.Throwable t__647__auto__ (clojure.core/println "[:unrepl.upgrade/failed]") (throw t__647__auto__)))) +(clojure.core/let [prefix__522__auto__ (clojure.core/name (clojure.core/gensym)) code__523__auto__ (.replaceAll "(ns unrepl.print\n (:require [clojure.string :as str]\n [clojure.edn :as edn]\n [clojure.main :as main]))\n\n(defprotocol MachinePrintable\n (-print-on [x write rem-depth]))\n\n(defn print-on [write x rem-depth]\n (let [rem-depth (dec rem-depth)]\n (if (and (neg? rem-depth) (or (nil? *print-length*) (pos? *print-length*)))\n (binding [*print-length* 0]\n (print-on write x 0))\n (do\n (when (and *print-meta* (meta x))\n (write \"#unrepl/meta [\")\n (-print-on (meta x) write rem-depth)\n (write \" \"))\n (-print-on x write rem-depth)\n (when (and *print-meta* (meta x))\n (write \"]\"))))))\n\n(defn base64-encode [^java.io.InputStream in]\n (let [table \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"\n sb (StringBuilder.)]\n (loop [shift 4 buf 0]\n (let [got (.read in)]\n (if (neg? got)\n (do\n (when-not (= shift 4)\n (let [n (bit-and (bit-shift-right buf 6) 63)]\n (.append sb (.charAt table n))))\n (cond\n (= shift 2) (.append sb \"==\")\n (= shift 0) (.append sb \\=))\n (str sb))\n (let [buf (bit-or buf (bit-shift-left got shift))\n n (bit-and (bit-shift-right buf 6) 63)]\n (.append sb (.charAt table n))\n (let [shift (- shift 2)]\n (if (neg? shift)\n (do\n (.append sb (.charAt table (bit-and buf 63)))\n (recur 4 0))\n (recur shift (bit-shift-left buf 6))))))))))\n\n(defn base64-decode [^String s]\n (let [table \"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/\"\n in (java.io.StringReader. s)\n bos (java.io.ByteArrayOutputStream.)]\n (loop [bits 0 buf 0]\n (let [got (.read in)]\n (when-not (or (neg? got) (= 61 #_\\= got))\n (let [buf (bit-or (.indexOf table got) (bit-shift-left buf 6))\n bits (+ bits 6)]\n (if (<= 8 bits)\n (let [bits (- bits 8)]\n (.write bos (bit-shift-right buf bits))\n (recur bits (bit-and 63 buf)))\n (recur bits buf))))))\n (.toByteArray bos)))\n\n(def ^:dynamic *elide*\n \"Function of 1 argument which returns the elision.\"\n (constantly nil))\n\n(def ^:dynamic *string-length* 80)\n\n(def ^:dynamic *realize-on-print*\n \"Set to false to avoid realizing lazy sequences.\"\n true)\n\n(defmacro ^:private blame-seq [& body]\n `(try (seq ~@body)\n (catch Throwable t#\n (list (tagged-literal 'unrepl/lazy-error t#)))))\n\n(defn- may-print? [s]\n (or *realize-on-print* (not (instance? clojure.lang.IPending s)) (realized? s)))\n\n(declare ->ElidedKVs)\n\n(defn- print-kvs\n [write kvs rem-depth]\n (let [print-length *print-length*]\n (loop [kvs kvs i 0]\n (if (< i print-length)\n (when-some [[[k v] & kvs] (seq kvs)]\n (when (pos? i) (write \", \"))\n (print-on write k rem-depth)\n (write \" \")\n (print-on write v rem-depth)\n (recur kvs (inc i)))\n (when (seq kvs)\n (when (pos? i) (write \", \"))\n (write \"#unrepl/... nil \")\n (print-on write (tagged-literal 'unrepl/... (*elide* (->ElidedKVs kvs))) rem-depth))))))\n\n(defn- print-vs\n [write vs rem-depth]\n (let [print-length *print-length*]\n (loop [vs vs i 0]\n (if (and (< i print-length) (may-print? vs))\n (when-some [[v :as vs] (blame-seq vs)]\n (when (pos? i) (write \" \"))\n (if (and (tagged-literal? v) (= (:tag v) 'unrepl/lazy-error))\n (print-on write v rem-depth)\n (do\n (print-on write v rem-depth)\n (recur (rest vs) (inc i)))))\n (do\n (when (pos? i) (write \" \"))\n (print-on write (tagged-literal 'unrepl/... (*elide* vs)) rem-depth))))))\n\n(defrecord ElidedKVs [s]\n MachinePrintable\n (-print-on [_ write rem-depth]\n (write \"{\")\n (print-kvs write s rem-depth)\n (write \"}\")))\n\n(def atomic? (some-fn nil? true? false? char? string? symbol? keyword? #(and (number? %) (not (ratio? %)))))\n\n(defn- as-str\n \"Like pr-str but escapes all ASCII control chars.\"\n [x]\n ;hacky\n (cond\n (string? x) (str/replace (pr-str x) #\"\\p{Cntrl}\"\n #(format \"\\\\u%04x\" (int (.charAt ^String % 0))))\n (char? x) (str/replace (pr-str x) #\"\\p{Cntrl}\"\n #(format \"u%04x\" (int (.charAt ^String % 0))))\n :else (pr-str x)))\n\n(defmacro ^:private latent-fn [& fn-body]\n `(let [d# (delay (binding [*ns* (find-ns '~(ns-name *ns*))] (eval '(fn ~@fn-body))))]\n (fn\n ([] (@d#))\n ([x#] (@d# x#))\n ([x# & xs#] (apply @d# x# xs#)))))\n\n(defrecord MimeContent [mk-in]\n MachinePrintable\n (-print-on [_ write rem-depth]\n (with-open [in (mk-in)]\n (write \"#unrepl/base64 \\\"\")\n (write (base64-encode in))\n (write \"\\\"\"))))\n\n(defn- mime-content [mk-in]\n (when-some [e (*elide* (MimeContent. mk-in))]\n {:content (tagged-literal 'unrepl/... e)}))\n\n(def ^:dynamic *object-representations*\n \"map of classes to functions returning their representation component (3rd item in #unrepl/object [class id rep])\"\n {clojure.lang.IDeref\n (fn [x]\n (let [pending? (and (instance? clojure.lang.IPending x) ; borrowed from https://github.com/brandonbloom/fipp/blob/8df75707e355c1a8eae5511b7d73c1b782f57293/src/fipp/ednize.clj#L37-L51\n (not (.isRealized ^clojure.lang.IPending x)))\n [ex val] (when-not pending?\n (try [false @x]\n (catch Throwable e\n [true e])))\n failed? (or ex (and (instance? clojure.lang.Agent x)\n (agent-error x)))\n status (cond\n failed? :failed\n pending? :pending\n :else :ready)]\n {:unrepl.ref/status status :unrepl.ref/val val}))\n \n clojure.lang.AFn\n (fn [x]\n (-> x class .getName main/demunge))\n \n java.io.File (fn [^java.io.File f]\n (into {:path (.getPath f)}\n (when (.isFile f)\n {:attachment (tagged-literal 'unrepl/mime\n (into {:content-type \"application/octet-stream\"\n :content-length (.length f)}\n (mime-content #(java.io.FileInputStream. f))))})))\n \n java.awt.Image (latent-fn [^java.awt.Image img]\n (let [w (.getWidth img nil)\n h (.getHeight img nil)]\n (into {:width w, :height h}\n {:attachment\n (tagged-literal 'unrepl/mime\n (into {:content-type \"image/png\"}\n (mime-content #(let [bos (java.io.ByteArrayOutputStream.)]\n (when (javax.imageio.ImageIO/write\n (doto (java.awt.image.BufferedImage. w h java.awt.image.BufferedImage/TYPE_INT_ARGB)\n (-> .getGraphics (.drawImage img 0 0 nil)))\n \"png\" bos)\n (java.io.ByteArrayInputStream. (.toByteArray bos)))))))})))\n \n Object (fn [x]\n (if (-> x class .isArray)\n (seq x)\n (str x)))})\n\n(defn- object-representation [x] \n (reduce-kv (fn [_ class f]\n (when (instance? class x) (reduced (f x)))) nil *object-representations*)) ; todo : cache\n\n(defn- class-form [^Class x]\n (if (.isArray x) [(-> x .getComponentType class-form)] (symbol (.getName x))))\n\n(def unreachable (tagged-literal 'unrepl/... nil))\n\n(defn- print-tag-lit-on [write tag form rem-depth]\n (write (str \"#\" tag \" \"))\n (print-on write form rem-depth))\n\n(extend-protocol MachinePrintable\n clojure.lang.TaggedLiteral\n (-print-on [x write rem-depth]\n \n (case (:tag x)\n unrepl/... (binding ; don't elide the elision \n [*print-length* Long/MAX_VALUE\n *print-level* Long/MAX_VALUE\n *string-length* Long/MAX_VALUE]\n (write (str \"#\" (:tag x) \" \"))\n (print-on write (:form x) Long/MAX_VALUE))\n (print-tag-lit-on write (:tag x) (:form x) rem-depth)))\n\n clojure.lang.Ratio\n (-print-on [x write rem-depth]\n (print-tag-lit-on write \"unrepl/ratio\"\n [(.numerator x) (.denominator x)] rem-depth))\n \n clojure.lang.Var\n (-print-on [x write rem-depth]\n (print-tag-lit-on write \"clojure/var\"\n (when-some [ns (:ns (meta x))] ; nil when local var\n (symbol (name (ns-name ns)) (name (:name (meta x)))))\n rem-depth))\n \n Throwable \n (-print-on [t write rem-depth]\n (print-tag-lit-on write \"error\" (Throwable->map t) rem-depth))\n \n Class\n (-print-on [x write rem-depth]\n (print-tag-lit-on write \"unrepl.java/class\" (class-form x) rem-depth))\n \n java.util.Date (-print-on [x write rem-depth] (write (pr-str x)))\n java.util.Calendar (-print-on [x write rem-depth] (write (pr-str x)))\n java.sql.Timestamp (-print-on [x write rem-depth] (write (pr-str x)))\n clojure.lang.Namespace\n (-print-on [x write rem-depth]\n (print-tag-lit-on write \"unrepl/ns\" (ns-name x) rem-depth))\n java.util.regex.Pattern\n (-print-on [x write rem-depth]\n (print-tag-lit-on write \"unrepl/pattern\" (str x) rem-depth))\n String\n (-print-on [x write rem-depth]\n (if (<= (count x) *string-length*)\n (write (as-str x))\n (let [i (if (and (Character/isHighSurrogate (.charAt ^String x (dec *string-length*)))\n (Character/isLowSurrogate (.charAt ^String x *string-length*)))\n (inc *string-length*) *string-length*)\n prefix (subs x 0 i)\n rest (subs x i)]\n (if (= rest \"\")\n (write (as-str x))\n (do\n (write \"#unrepl/string [\")\n (write (as-str prefix))\n (write \" \")\n (print-on write (tagged-literal 'unrepl/... (*elide* rest)) rem-depth)\n (write \"]\")))))))\n\n(defn- print-coll [open close write x rem-depth]\n (write open)\n (print-vs write x rem-depth)\n (write close))\n\n(extend-protocol MachinePrintable\n nil\n (-print-on [_ write _] (write \"nil\"))\n Object\n (-print-on [x write rem-depth]\n (cond\n (atomic? x) (write (as-str x))\n (map? x)\n (do\n (when (record? x)\n (write \"#\") (write (.getName (class x))) (write \" \"))\n (write \"{\")\n (print-kvs write x rem-depth)\n (write \"}\"))\n (vector? x) (print-coll \"[\" \"]\" write x rem-depth)\n (seq? x) (print-coll \"(\" \")\" write x rem-depth)\n (set? x) (print-coll \"#{\" \"}\" write x rem-depth)\n :else\n (print-tag-lit-on write \"unrepl/object\"\n [(class x) (format \"0x%x\" (System/identityHashCode x)) (object-representation x)\n {:bean {unreachable (tagged-literal 'unrepl/... (*elide* (ElidedKVs. (bean x))))}}]\n rem-depth))))\n\n(defn edn-str [x]\n (let [out (java.io.StringWriter.)\n write (fn [^String s] (.write out s))]\n (binding [*print-readably* true\n *print-length* (or *print-length* 10)\n *print-level* (or *print-level* 8)\n *string-length* (or *string-length* 72)]\n (print-on write x (or *print-level* 8))\n (str out))))\n\n(defn full-edn-str [x]\n (binding [*print-length* Long/MAX_VALUE\n *print-level* Long/MAX_VALUE\n *string-length* Integer/MAX_VALUE]\n (edn-str x)))\n(ns unrepl.repl\n (:require [clojure.main :as m]\n [unrepl.print :as p]\n [clojure.edn :as edn]\n [clojure.java.io :as io]))\n\n(defn classloader\n \"Creates a classloader that obey standard delegating policy.\n Takes two arguments: a parent classloader and a function which\n takes a keyword (:resource or :class) and a string (a resource or a class name) and returns an array of bytes\n or nil.\"\n [parent f]\n (let [define-class (doto (.getDeclaredMethod ClassLoader \"defineClass\" (into-array [String (Class/forName \"[B\") Integer/TYPE Integer/TYPE]))\n (.setAccessible true))]\n (proxy [ClassLoader] [parent]\n (findResource [name]\n (when-some [bytes (f :resource name)]\n (let [file (doto (java.io.File/createTempFile \"unrepl-sideload-\" (str \"-\" (re-find #\"[^/]*$\" name)))\n .deleteOnExit)]\n (io/copy bytes file)\n (-> file .toURI .toURL))))\n (findClass [name]\n (if-some [bytes (f :class name)]\n (.invoke define-class this (to-array name bytes 0 (count bytes)))\n (throw (ClassNotFoundException. name)))))))\n\n(defn ^java.io.Writer tagging-writer\n ([write]\n (proxy [java.io.Writer] []\n (close []) ; do not cascade\n (flush []) ; atomic always flush\n (write\n ([x]\n (write (cond \n (string? x) x\n (integer? x) (str (char x))\n :else (String. ^chars x))))\n ([string-or-chars off len]\n (when (pos? len)\n (write (subs (if (string? string-or-chars) string-or-chars (String. ^chars string-or-chars))\n off (+ off len))))))))\n ([tag write]\n (tagging-writer (fn [s] (write [tag s]))))\n ([tag group-id write]\n (tagging-writer (fn [s] (write [tag s group-id])))))\n\n(defn blame-ex [phase ex]\n (if (::phase (ex-data ex))\n ex\n (ex-info (str \"Exception during \" (name phase) \" phase.\")\n {::ex ex ::phase phase} ex)))\n\n(defmacro blame [phase & body]\n `(try ~@body\n (catch Throwable t#\n (throw (blame-ex ~phase t#)))))\n\n(defn atomic-write [^java.io.Writer w]\n (fn [x]\n (let [s (blame :print (p/edn-str x))] ; was pr-str, must occur outside of the locking form to avoid deadlocks\n (locking w\n (.write w s)\n (.write w \"\\n\")\n (.flush w)))))\n\n(defn fuse-write [awrite]\n (fn [x]\n (when-some [w @awrite]\n (try\n (w x)\n (catch Throwable t\n (reset! awrite nil))))))\n\n(def ^:dynamic write)\n\n(defn unrepl-reader [^java.io.Reader r before-read]\n (let [offset (atom 0)\n offset! #(swap! offset + %)]\n (proxy [clojure.lang.LineNumberingPushbackReader clojure.lang.ILookup] [r]\n (valAt\n ([k] (get this k nil))\n ([k not-found] (case k :offset @offset not-found)))\n (read\n ([]\n (before-read)\n (let [c (proxy-super read)]\n (when-not (neg? c) (offset! 1))\n c))\n ([cbuf]\n (before-read)\n (let [n (proxy-super read cbuf)]\n (when (pos? n) (offset! n))\n n))\n ([cbuf off len]\n (before-read)\n (let [n (proxy-super read cbuf off len)]\n (when (pos? n) (offset! n))\n n)))\n (unread\n ([c-or-cbuf]\n (if (integer? c-or-cbuf)\n (when-not (neg? c-or-cbuf) (offset! -1))\n (offset! (- (alength c-or-cbuf))))\n (proxy-super unread c-or-cbuf))\n ([cbuf off len]\n (offset! (- len))\n (proxy-super unread cbuf off len)))\n (skip [n]\n (let [n (proxy-super skip n)]\n (offset! n)\n n))\n (readLine []\n (when-some [s (proxy-super readLine)]\n (offset! (count s))\n s)))))\n\n(defn- close-socket! [x]\n ; hacky way because the socket is not exposed by clojure.core.server\n (loop [x x]\n (if (= \"java.net.SocketInputStream\" (.getName (class x)))\n (do (.close x) true)\n (when-some [^java.lang.reflect.Field field \n (->> x class (iterate #(.getSuperclass %)) (take-while identity)\n (mapcat #(.getDeclaredFields %))\n (some #(when (#{\"in\" \"sd\"} (.getName ^java.lang.reflect.Field %)) %)))]\n (recur (.get (doto field (.setAccessible true)) x))))))\n\n(defn soft-store [make-action not-found]\n (let [ids-to-refs (atom {})\n refs-to-ids (atom {})\n refq (java.lang.ref.ReferenceQueue.)\n NULL (Object.)]\n (.start (Thread. (fn []\n (let [ref (.remove refq)]\n (let [id (@refs-to-ids ref)]\n (swap! refs-to-ids dissoc ref)\n (swap! ids-to-refs dissoc id)))\n (recur))))\n {:put (fn [x]\n (let [x (if (nil? x) NULL x)\n id (keyword (gensym))\n ref (java.lang.ref.SoftReference. x refq)]\n (swap! refs-to-ids assoc ref id)\n (swap! ids-to-refs assoc id ref)\n {:get (make-action id)}))\n :get (fn [id]\n (if-some [x (some-> @ids-to-refs ^java.lang.ref.Reference (get id) .get)]\n (if (= NULL x) nil x)\n not-found))}))\n\n(defonce ^:private sessions (atom {}))\n\n(defonce ^:private elision-store (soft-store #(list `fetch %) p/unreachable))\n(defn fetch [id] \n (let [x ((:get elision-store) id)]\n (cond\n (= p/unreachable x) x\n (instance? unrepl.print.ElidedKVs x) x\n (string? x) x\n (instance? unrepl.print.MimeContent x) x\n :else (seq x))))\n\n(defn session [id]\n (some-> @sessions (get id) deref))\n\n(defn interrupt! [session-id eval]\n (let [{:keys [^Thread thread eval-id promise]}\n (some-> session-id session :current-eval)]\n (when (and (= eval eval-id)\n (deliver promise\n {:ex (doto (ex-info \"Evaluation interrupted\" {::phase :eval})\n (.setStackTrace (.getStackTrace thread)))\n :bindings {}}))\n (.stop thread)\n true)))\n\n(defn background! [session-id eval]\n (let [{:keys [eval-id promise future]}\n (some-> session-id session :current-eval)]\n (boolean\n (and\n (= eval eval-id)\n (deliver promise\n {:eval future\n :bindings {}})))))\n\n(defn exit! [session-id] ; too violent\n (some-> session-id session :in close-socket!))\n\n(defn reattach-outs! [session-id]\n (some-> session-id session :write-atom \n (reset!\n (if (bound? #'write)\n write\n (let [out *out*]\n (fn [x]\n (binding [*out* out\n *print-readably* true]\n (prn x))))))))\n\n(defn attach-sideloader! [session-id]\n (prn '[:unrepl.jvm.side-loader/hello])\n (some-> session-id session :side-loader \n (reset!\n (let [out *out*\n in *in*]\n (fn self [k name]\n (binding [*out* out]\n (locking self\n (prn [k name])\n (some-> (edn/read {:eof nil} in) p/base64-decode)))))))\n (let [o (Object.)] (locking o (.wait o))))\n\n(defn set-file-line-col [session-id file line col]\n (when-some [^java.lang.reflect.Field field \n (->> clojure.lang.LineNumberingPushbackReader\n .getDeclaredFields\n (some #(when (= \"_columnNumber\" (.getName ^java.lang.reflect.Field %)) %)))]\n (doto field (.setAccessible true)) ; sigh\n (when-some [in (some-> session-id session :in)]\n (set! *file* file)\n (set! *source-path* file)\n (.setLineNumber in line)\n (.set field in (int col)))))\n\n(defn- writers-flushing-repo [max-latency-ms]\n (let [writers (java.util.WeakHashMap.)\n flush-them-all #(locking writers\n (doseq [^java.io.Writer w (.keySet writers)]\n (.flush w)))]\n (.scheduleAtFixedRate\n (java.util.concurrent.Executors/newScheduledThreadPool 1)\n flush-them-all\n max-latency-ms max-latency-ms java.util.concurrent.TimeUnit/MILLISECONDS)\n (fn [w]\n (locking writers (.put writers w nil)))))\n\n(defmacro ^:private flushing [bindings & body]\n `(binding ~bindings\n (try ~@body\n (finally ~@(for [v (take-nth 2 bindings)]\n `(.flush ~(vary-meta v assoc :tag 'java.io.Writer)))))))\n\n(defn start []\n (with-local-vars [in-eval false\n unrepl false\n eval-id 0\n prompt-vars #{#'*ns* #'*warn-on-reflection*}\n current-eval-future nil]\n (let [session-id (keyword (gensym \"session\"))\n raw-out *out*\n aw (atom (atomic-write raw-out))\n write-here (fuse-write aw)\n schedule-writer-flush! (writers-flushing-repo 50) ; 20 fps (flushes per second)\n scheduled-writer (fn [& args]\n (-> (apply tagging-writer args)\n java.io.BufferedWriter.\n (doto schedule-writer-flush!)))\n edn-out (scheduled-writer :out (fn [x] (binding [p/*string-length* Integer/MAX_VALUE] (write-here x))))\n ensure-raw-repl (fn []\n (when (and @in-eval @unrepl) ; reading from eval!\n (var-set unrepl false)\n (write [:bye {:reason :upgrade :actions {}}])\n (flush)\n ; (reset! aw (blocking-write))\n (set! *out* raw-out)))\n in (unrepl-reader *in* ensure-raw-repl)\n session-state (atom {:current-eval {}\n :in in\n :write-atom aw\n :log-eval (fn [msg]\n (when (bound? eval-id)\n (write [:log msg @eval-id])))\n :log-all (fn [msg]\n (write [:log msg nil]))\n :side-loader (atom nil)\n :prompt-vars #{#'*ns* #'*warn-on-reflection*}})\n current-eval-thread+promise (atom nil)\n ensure-unrepl (fn []\n (when-not @unrepl\n (var-set unrepl true)\n (flush)\n (set! *out* edn-out)\n (binding [*print-length* Long/MAX_VALUE\n *print-level* Long/MAX_VALUE\n p/*string-length* Long/MAX_VALUE]\n (write [:unrepl/hello {:session session-id\n :actions (into\n {:exit `(exit! ~session-id)\n :start-aux `(start-aux ~session-id)\n :log-eval\n `(some-> ~session-id session :log-eval)\n :log-all\n `(some-> ~session-id session :log-all)\n :print-limits\n `(let [bak# {:unrepl.print/string-length p/*string-length*\n :unrepl.print/coll-length *print-length*\n :unrepl.print/nesting-depth *print-level*}]\n (some->> ~(tagged-literal 'unrepl/param :unrepl.print/string-length) (set! p/*string-length*))\n (some->> ~(tagged-literal 'unrepl/param :unrepl.print/coll-length) (set! *print-length*))\n (some->> ~(tagged-literal 'unrepl/param :unrepl.print/nesting-depth) (set! *print-level*))\n bak#)\n :set-source\n `(unrepl/do\n (set-file-line-col ~session-id\n ~(tagged-literal 'unrepl/param :unrepl/sourcename)\n ~(tagged-literal 'unrepl/param :unrepl/line)\n ~(tagged-literal 'unrepl/param :unrepl/column)))\n :unrepl.jvm/start-side-loader\n `(attach-sideloader! ~session-id)}\n {})}]))))\n \n interruptible-eval\n (fn [form]\n (try\n (let [original-bindings (get-thread-bindings)\n p (promise)\n f\n (future\n (swap! session-state update :current-eval\n assoc :thread (Thread/currentThread))\n (with-bindings original-bindings\n (try\n (write [:started-eval\n {:actions \n {:interrupt (list `interrupt! session-id @eval-id)\n :background (list `background! session-id @eval-id)}}\n @eval-id])\n (let [v (with-bindings {in-eval true}\n (blame :eval (eval form)))]\n (deliver p {:eval v :bindings (get-thread-bindings)})\n v)\n (catch Throwable t\n (deliver p {:ex t :bindings (get-thread-bindings)})\n (throw t)))))]\n (swap! session-state update :current-eval\n into {:eval-id @eval-id :promise p :future f})\n (let [{:keys [ex eval bindings]} @p]\n (doseq [[var val] bindings\n :when (not (identical? val (original-bindings var)))]\n (var-set var val))\n (if ex\n (throw ex)\n eval)))\n (finally\n (swap! session-state assoc :current-eval {}))))\n cl (.getContextClassLoader (Thread/currentThread))\n slcl (classloader cl\n (fn [k x]\n (when-some [f (some-> session-state deref :side-loader deref)]\n (f k x))))]\n (swap! session-state assoc :class-loader slcl)\n (swap! sessions assoc session-id session-state)\n (binding [*out* raw-out\n *err* (tagging-writer :err write)\n *in* in\n *file* \"unrepl-session\"\n *source-path* \"unrepl-session\"\n p/*elide* (:put elision-store)\n p/*string-length* p/*string-length* \n write write-here]\n (.setContextClassLoader (Thread/currentThread) slcl)\n (with-bindings {clojure.lang.Compiler/LOADER slcl}\n (try\n (m/repl\n :prompt (fn []\n (ensure-unrepl)\n (write [:prompt (into {:file *file*\n :line (.getLineNumber *in*)\n :column (.getColumnNumber *in*)\n :offset (:offset *in*)}\n (map (fn [v]\n (let [m (meta v)]\n [(symbol (name (ns-name (:ns m))) (name (:name m))) @v])))\n (:prompt-vars @session-state))]))\n :read (fn [request-prompt request-exit]\n (blame :read (let [line+col [(.getLineNumber *in*) (.getColumnNumber *in*)]\n offset (:offset *in*)\n r (m/repl-read request-prompt request-exit)\n line+col' [(.getLineNumber *in*) (.getColumnNumber *in*)]\n offset' (:offset *in*)\n len (- offset' offset)\n id (when-not (#{request-prompt request-exit} r)\n (var-set eval-id (inc @eval-id)))]\n (write [:read {:from line+col :to line+col'\n :offset offset\n :len (- offset' offset)}\n id])\n (if (and (seq? r) (= (first r) 'unrepl/do))\n (let [id @eval-id\n write #(binding [p/*string-length* Integer/MAX_VALUE] (write %))]\n (flushing [*err* (tagging-writer :err id write)\n *out* (scheduled-writer :out id write)]\n (eval (cons 'do (next r))))\n request-prompt)\n r))))\n :eval (fn [form]\n (let [id @eval-id\n write #(binding [p/*string-length* Integer/MAX_VALUE] (write %))]\n (flushing [*err* (tagging-writer :err id write)\n *out* (scheduled-writer :out id write)]\n (interruptible-eval form))))\n :print (fn [x]\n (ensure-unrepl)\n (write [:eval x @eval-id]))\n :caught (fn [e]\n (ensure-unrepl)\n (let [{:keys [::ex ::phase]\n :or {ex e phase :repl}} (ex-data e)]\n (write [:exception {:ex ex :phase phase} @eval-id]))))\n (finally\n (.setContextClassLoader (Thread/currentThread) cl))))\n (write [:bye {:reason :disconnection\n :outs :muted\n :actions {:reattach-outs `(reattach-outs! ~session-id)}}])))))\n\n(defn start-aux [session-id]\n (let [cl (.getContextClassLoader (Thread/currentThread))]\n (try\n (some->> session-id session :class-loader (.setContextClassLoader (Thread/currentThread)))\n (start)\n (finally\n (.setContextClassLoader (Thread/currentThread) cl)))))\n\n;; WIP for extensions\n\n(defmacro ensure-ns [[fully-qualified-var-name & args :as expr]]\n `(do\n (require '~(symbol (namespace fully-qualified-var-name)))\n ~expr))\n(ns user)\n(unrepl.repl/start)" "(? code__523__auto__ java.io.StringReader. clojure.lang.LineNumberingPushbackReader.)] (try (clojure.core/binding [clojure.core/*ns* clojure.core/*ns*] (clojure.core/loop [ret__525__auto__ nil] (clojure.core/let [form__526__auto__ (clojure.core/read rdr__524__auto__ false (quote eof__527__auto__))] (if (clojure.core/= (quote eof__527__auto__) form__526__auto__) ret__525__auto__ (recur (clojure.core/eval form__526__auto__)))))) (catch java.lang.Throwable t__528__auto__ (clojure.core/println "[:unrepl.upgrade/failed]") (throw t__528__auto__)))) diff --git a/scripts/run b/scripts/run index 02c2031..835fd70 100755 --- a/scripts/run +++ b/scripts/run @@ -1,3 +1,3 @@ #!/usr/bin/env bash -node_modules/.bin/lumo -c src -m unravel.core "$@" +node_modules/.bin/lumo -c src:node_modules/packed-printer/src/ -m unravel.core "$@" diff --git a/src/unravel/loop.cljs b/src/unravel/loop.cljs index 981ef8b..c64befc 100644 --- a/src/unravel/loop.cljs +++ b/src/unravel/loop.cljs @@ -1,6 +1,5 @@ (ns unravel.loop (:require [clojure.string :as str] - [clojure.pprint :refer [pprint]] [clojure.walk] [lumo.core] [lumo.io :refer [slurp]] @@ -13,7 +12,9 @@ [unravel.log :as ud] [unravel.util :as uu] [unravel.lisp :as ul] - [unravel.exception :as ue])) + [unravel.exception :as ue] + [net.cgrand.packed-printer :as pp] + [unravel.pprint])) (defn squawk [rl & xs] (println) @@ -54,10 +55,15 @@ (some-> ctx :aux-out .end) (some-> ctx :loader-out .destroy)) ; plain .end hangs +(defn- print-result [ctx result] + (if (some-> ctx :options :flags :packed) + (pp/pprint result :as :unrepl/edn :strict 20 :width (quot (.-columns js/process.stdout) 1.11)) + (ut/cyan #(prn result)))) + (defmethod process [:conn :eval] [[_ result counter] _ ctx] (if (and (some? (:trigger ctx)) (= (:trigger ctx) result)) (terminate! ctx) - (ut/cyan #(prn result))) + (print-result ctx result)) (assoc ctx :pending-eval nil)) (defmethod process [:conn :started-eval] [[_ {:keys [actions]}] _ ctx] @@ -126,18 +132,18 @@ (println (str "Unravel " uv/version " connected to " host ":" port "\n")) (println "Type ^O for full docs of symbol under cursor, ^D to quit,") (println "^up and ^down to navigate history, ^C to interrupt current evaluation.") - (println "Enter #__help for help") + (println "Enter /help for help") (println)) (defn help [] (println) (println "Type ^O for full docs of symbol under cursor, ^D to quit.") - (println "Lines starting with `#__` are treated as special commands and + (println "Lines starting with `/` are treated as special commands and interpreted by the REPL client. The following specials are available: -- `#__help` shows a help screen -- `#__1`, `#__2`, `#__3` ...: expand the numberd lazy seq ellipsis -- `#__`: expand the most recent lazy seq ellipsis ") +- `/help` shows a help screen +- `/1`, `/2`, `/3` ...: expand the numbered ellipsis +- `//`: expand the most recent lazy seq ellipsis ") (println)) (defn read-payload [] @@ -150,9 +156,11 @@ interpreted by the REPL client. The following specials are available: (help) (.prompt rl)) - (or (nil? cmd) (re-matches #"^\d*$" cmd)) - (if-let [cmd (get @ug/ellipsis-store (or (some-> cmd js/parseInt) @ug/ellipsis-counter))] - (send-command ctx (str cmd)) + (re-matches #"\d+|/" cmd) + (if-some [{:keys [unravel/source] :as m} (get @ug/ellipsis-store (if (= cmd "/") @ug/ellipsis-counter (js/parseInt cmd)))] + (case source + :unrepl (send-command ctx (pr-str (:get m))) + :unravel (print-result ctx (:value m))) (.prompt rl)))) (defn socket-connector @@ -459,7 +467,7 @@ interpreted by the REPL client. The following specials are available: [[_ line] _ ctx] (when (ut/rich?) (doto (:ostream ctx) .clearLine .clearScreenDown)) - (if-let [[_ cmd] (re-matches #"^\s*#__([a-zA-Z0-9]*)?\s*$" line)] + (if-let [[_ cmd] (re-matches #"^\s*/([/a-zA-Z0-9]+)\s*$" line)] (special ctx cmd) (send-command ctx line)) ctx) @@ -522,4 +530,5 @@ interpreted by the REPL client. The following specials are available: (fn [ctx origin msg] (ud/dbug :receive {:origin origin} msg) (process msg origin ctx)))] + #_(.on js/process.stdout "resize" #(sm :term-resize [(.-columns js/process.stdout) (.-rows js/process.stdout)])) (.on conn-in "data" #(sm :conn %)))) diff --git a/src/unravel/pprint.cljs b/src/unravel/pprint.cljs new file mode 100644 index 0000000..5c079fc --- /dev/null +++ b/src/unravel/pprint.cljs @@ -0,0 +1,116 @@ +(ns unravel.pprint + (:require [net.cgrand.packed-printer.core :as core] + [net.cgrand.packed-printer.text.edn :as te] + [unravel.tags :as tags])) + +(defn ansi [text ansi-text] + {:length (count text) + :text ansi-text + :start-length (count text) + :start-text ansi-text + :br-after? true}) + +(defn nobr [text] + {:length (count text) + :text text + :start-length (count text) + :start-text text}) + +(defn opening [s i] + {:start-length (count s) + :start-text (str "\33[2m" s "\33[22m") + :length (count s) + :text (str "\33[2m" s "\33[22m") + :indent i}) + +(defn closing [s] + {:length (count s) + :text (str "\33[2m" s "\33[22m") + :br-after? true + :indent -1}) + +(def delims + (-> {} + (into (map (fn [s] [s (opening s (count s))])) ["(" "[" "{" "#{"]) + (into (map (fn [s] [s (closing s)])) [")" "]" "}"]))) + +(def comma {:length 1 + :text "\33[2m,\33[22m" + :br-after? true}) + +(defn spans + "Turns x into a collection of spans for layout. Options supported are: + * kv-indent the amount of spaces by which to indent a value when it appears + at the start of a line (default 2), + * coll-indents a map of collection start delimiters (as strings) to the amount + by which to indent (default: length of the delimiter)." + [x {:keys [kv-indent coll-indents] :or {kv-indent 2 coll-indents {}}}] + (let [delims (into delims (map (fn [[s i]] [s (opening s i)])) coll-indents) + kv-open + {:length 0 + :text "" + :start-length 0 + :start-text "" + :indent kv-indent} + meta-open {:length 1 + :text "\33[2m^\33[22m" + :start-length 1 + :start-text "\33[2m^\33[22m" + :indent kv-indent}] + (letfn [(coll-spans + ([x] (coll-spans x [te/space] spans)) + ([x sp spans] + (sequence (comp (map spans) (interpose sp) cat) x))) + (kv-spans [[k v]] + (if (instance? unravel.tags/Ellipsis k) + (spans v) + (-> [kv-open] (into (spans k)) (conj te/space) (into (spans v)) (conj te/kv-close)))) + (spans [x] + (cond + (keyword? x) (let [s (str x)] [(ansi s (str "\33[36m" s "\33[m"))]) ; cyan + (tagged-literal? x) + (case (:tag x) + unrepl/meta (let [[m v] (:form x)] + (concat (cons meta-open (spans m)) (cons te/space (spans v)) [te/kv-close])) + unrepl.java/class [(ansi (str (:form x)) (str "\33[33m" (:form x) "\33[m"))] ; to distinguish from symbols + unrepl/string (let [[s e] (:form x) + s (pr-str s)] (cons (nobr s) (spans e))) + unrepl/ratio (let [[n d] (:form x)] + [(str n "/" d)]) + + unrepl/pattern (let [[n d] (:form x)] + [(pr-str (re-pattern (:form x)))]) + unrepl/lazy-error + (concat [kv-open (ansi (str "/lazy-error") + (str "\33[31m/lazy-error\33[m")) + te/space] + (spans (-> x :form :form :cause)) + [te/space + (let [cmd (str "/" (tags/elide (:form x)))] + (ansi cmd (str "\33[31m\33[4m" cmd "\33[m"))) + te/kv-close]) + error (concat + [kv-open (ansi (str "#" (pr-str (:tag x))) + (str "\33[31m#" (pr-str (:tag x)) "\33[m")) + te/space] + (spans (:form x)) [te/kv-close]) + (concat [kv-open (str "#" (pr-str (:tag x))) te/space] (spans (:form x)) [te/kv-close])) + (vector? x) (concat [(delims "[")] (coll-spans x) [(delims "]")]) + (set? x) (concat [(delims "#{")] + (coll-spans (if-some [e (some #(when (instance? unravel.tags/Ellipsis %) %) x)] + (concat (disj x e) [e]) + x)) + [(delims "}")]) + (seq? x) (concat [(delims "(")] (coll-spans x) [(delims ")")]) + (instance? unravel.tags.Ellipsis x) [(let [s (if-some [id (:id x)] (str "/" id) "/\u29B0")] + (ansi s (str "\33[4m" s "\33[24m")))] + (instance? unravel.tags.ClojureVar x) [(str "#'" (:name x))] + (map? x) (if-some [kv (find x tags/unreachable)] + (concat [(delims "{")] (coll-spans (concat (dissoc x tags/unreachable) [kv]) [comma te/space] kv-spans) [(delims "}")]) + (concat [(delims "{")] (coll-spans x [comma te/space] kv-spans) [(delims "}")])) + :else [(pr-str x)]))] + (spans x)))) + +(defmethod core/spans [:text :unrepl/edn] [x to-as opts] + (spans x opts)) + diff --git a/src/unravel/tags.cljs b/src/unravel/tags.cljs index 78522ab..76ee275 100644 --- a/src/unravel/tags.cljs +++ b/src/unravel/tags.cljs @@ -5,26 +5,40 @@ (defonce ellipsis-store (atom {})) -(defrecord Ellipsis [get]) +(defrecord Ellipsis [get id]) + +(def unreachable (Ellipsis. nil nil)) + +(defn ellipsis [m] + (if (:get m) + (let [counter (swap! ellipsis-counter inc)] + (swap! ellipsis-store assoc counter (assoc m :unravel/source :unrepl)) + (Ellipsis. (:get m) counter)) + unreachable)) + +(defn elide [value] + (let [counter (swap! ellipsis-counter inc)] + (swap! ellipsis-store assoc counter {:unravel/source :unravel :value value}) + counter)) (defrecord ClojureVar [name]) (extend-protocol IPrintWithWriter Ellipsis (-pr-writer [v writer _] - (let [counter (swap! ellipsis-counter inc)] - (swap! ellipsis-store assoc counter (:get v)) - (write-all writer "#__" counter))) + (if-some [id (:id v)] + (write-all writer "/" id) + (write-all writer "/\u29B0" (:id v)))) ClojureVar (-pr-writer [v writer _] (write-all writer "#'" (:name v)))) (def tag-map - {'unrepl/... map->Ellipsis + {'unrepl/... ellipsis 'clojure/var ->ClojureVar}) (defn register-tag-parsers [] (cljs.reader/register-default-tag-parser! tagged-literal) - (cljs.reader/register-tag-parser! 'unrepl/... map->Ellipsis) - (cljs.reader/register-tag-parser! 'clojure/var ->ClojureVar)) + (doseq [[tag parser] tag-map] + (cljs.reader/register-tag-parser! tag parser))) diff --git a/yarn.lock b/yarn.lock index 45a3603..a1a0363 100644 --- a/yarn.lock +++ b/yarn.lock @@ -133,10 +133,6 @@ duplexer2@~0.1.4: dependencies: readable-stream "^2.0.2" -earcut@2.1.2: - version "2.1.2" - resolved "https://registry.yarnpkg.com/earcut/-/earcut-2.1.2.tgz#542add0ca3a7b713452720e1d053937d3daf3784" - ecc-jsbn@~0.1.1: version "0.1.1" resolved "https://registry.yarnpkg.com/ecc-jsbn/-/ecc-jsbn-0.1.1.tgz#0fc73a9ed5f0d53c38193398523ef7e543777505" @@ -320,10 +316,6 @@ listenercount@~1.0.1: version "1.0.1" resolved "https://registry.yarnpkg.com/listenercount/-/listenercount-1.0.1.tgz#84c8a72ab59c4725321480c975e6508342e70937" -lodash@4.17.4: - version "4.17.4" - resolved "https://registry.yarnpkg.com/lodash/-/lodash-4.17.4.tgz#78203a4d1c328ae1d86dca6460e369b57f4055ae" - lumo-cljs@1.7.0: version "1.7.0" resolved "https://registry.yarnpkg.com/lumo-cljs/-/lumo-cljs-1.7.0.tgz#d9d70185b22683b4aa5e53c4189e26c22d51b609" @@ -332,14 +324,6 @@ lumo-cljs@1.7.0: progress "^2.0.0" request "2.81.0" -lumo@^0.20.6: - version "0.20.7" - resolved "https://registry.yarnpkg.com/lumo/-/lumo-0.20.7.tgz#a1cf61be6fa1bb235d05493ea849529c7c48289a" - dependencies: - earcut "2.1.2" - lodash "4.17.4" - rbush "2.0.1" - mime-db@~1.27.0: version "1.27.0" resolved "https://registry.yarnpkg.com/mime-db/-/mime-db-1.27.0.tgz#820f572296bbd20ec25ed55e5b5de869e5436eb1" @@ -380,6 +364,10 @@ os-homedir@^1.0.2: version "1.0.2" resolved "https://registry.yarnpkg.com/os-homedir/-/os-homedir-1.0.2.tgz#ffbc4988336e0e833de0c168c7ef152121aa7fb3" +packed-printer@^0.3.0: + version "0.3.0" + resolved "https://registry.yarnpkg.com/packed-printer/-/packed-printer-0.3.0.tgz#7176be03879ba4f248f8f302e5489f234694cdb2" + pako@~1.0.2: version "1.0.5" resolved "https://registry.yarnpkg.com/pako/-/pako-1.0.5.tgz#d2205dfe5b9da8af797e7c163db4d1f84e4600bc" @@ -408,16 +396,6 @@ qs@~6.4.0: version "6.4.0" resolved "https://registry.yarnpkg.com/qs/-/qs-6.4.0.tgz#13e26d28ad6b0ffaa91312cd3bf708ed351e7233" -quickselect@^1.0.0: - version "1.0.0" - resolved "https://registry.yarnpkg.com/quickselect/-/quickselect-1.0.0.tgz#02630818f9aae4ecab26f0103f98d061c17c58f3" - -rbush@2.0.1: - version "2.0.1" - resolved "https://registry.yarnpkg.com/rbush/-/rbush-2.0.1.tgz#4cfaca28c3064bc0ee75431a1b79990e875eefa9" - dependencies: - quickselect "^1.0.0" - readable-stream@^2.0.2: version "2.3.3" resolved "https://registry.yarnpkg.com/readable-stream/-/readable-stream-2.3.3.tgz#368f2512d79f9d46fdfc71349ae7878bbc1eb95c"