From 5de38233cd43360fea207fe4921091cdf1f00584 Mon Sep 17 00:00:00 2001 From: Daniel Barreto Date: Sat, 23 Dec 2017 11:29:38 +0100 Subject: [PATCH 1/5] Add `:print-settings` to session state --- src/unrepl/repl.clj | 49 ++++++++++++++++++++++++++++++++++----------- 1 file changed, 37 insertions(+), 12 deletions(-) diff --git a/src/unrepl/repl.clj b/src/unrepl/repl.clj index 8ce4811..9ed84d0 100644 --- a/src/unrepl/repl.clj +++ b/src/unrepl/repl.clj @@ -1,8 +1,9 @@ (ns unrepl.repl (:require [clojure.main :as m] - [unrepl.print :as p] [clojure.edn :as edn] - [clojure.java.io :as io])) + [clojure.java.io :as io] + [clojure.set :refer [rename-keys]] + [unrepl.print :as p])) (defn classloader "Creates a classloader that obey standard delegating policy. @@ -211,6 +212,27 @@ (some-> (edn/read {:eof nil} in) p/base64-decode))))))) (let [o (Object.)] (locking o (.wait o)))) +(defn default-print-settings [sl] + "Return print settings with clojure.core's `*print-length*` and + `*print-level*` global vars as default." + {:string-length sl + :coll-length *print-length* + :nesting-depth *print-level*}) + +(defn update-print-settings! [session-id context string-length coll-length nesting-depth] + "Update session's print settings for `context` and return its previous state as a backup." + (let [session-atom (some-> @sessions (get session-id)) + backup-settings (-> @session-atom + :print-settings + context + (rename-keys {:string-length :unrepl.print/string-length + :coll-length :unrepl.print/coll-length + :nesting-depth :unrepl.print/nesting-depth}))] + (swap! session-atom assoc-in [:print-settings context :string-length] string-length) + (swap! session-atom assoc-in [:print-settings context :coll-length] coll-length) + (swap! session-atom assoc-in [:print-settings context :nesting-depth] nesting-depth) + backup-settings)) + (defn set-file-line-col [session-id file line col] (when-some [^java.lang.reflect.Field field (->> clojure.lang.LineNumberingPushbackReader @@ -268,6 +290,11 @@ session-state (atom {:current-eval {} :in in :write-atom aw + :print-settings (merge + (zipmap [:eval :log] + (repeat (default-print-settings 80))) + (zipmap [:out :err :exception] + (repeat (default-print-settings Long/MAX_VALUE)))) :log-eval (fn [msg] (when (bound? eval-id) (write [:log msg @eval-id]))) @@ -285,6 +312,7 @@ *print-level* Long/MAX_VALUE p/*string-length* Long/MAX_VALUE] (write [:unrepl/hello {:session session-id + :print-settings (:print-settings @session-state) :actions (into {:exit `(exit! ~session-id) :start-aux `(start-aux ~session-id) @@ -292,14 +320,12 @@ `(some-> ~session-id session :log-eval) :log-all `(some-> ~session-id session :log-all) - :print-limits - `(let [bak# {:unrepl.print/string-length p/*string-length* - :unrepl.print/coll-length *print-length* - :unrepl.print/nesting-depth *print-level*}] - (some->> ~(tagged-literal 'unrepl/param :unrepl.print/string-length) (set! p/*string-length*)) - (some->> ~(tagged-literal 'unrepl/param :unrepl.print/coll-length) (set! *print-length*)) - (some->> ~(tagged-literal 'unrepl/param :unrepl.print/nesting-depth) (set! *print-level*)) - bak#) + :print-settings + `(update-print-settings! ~session-id + ~(tagged-literal 'unrepl/param :unrepl.print/context) + ~(tagged-literal 'unrepl/param :unrepl.print/string-length) + ~(tagged-literal 'unrepl/param :unrepl.print/coll-length) + ~(tagged-literal 'unrepl/param :unrepl.print/nesting-depth)) :set-source `(unrepl/do (set-file-line-col ~session-id @@ -309,7 +335,6 @@ :unrepl.jvm/start-side-loader `(attach-sideloader! ~session-id)} #_ext-session-actions)}])))) - interruptible-eval (fn [form] (try @@ -425,4 +450,4 @@ (defmacro ensure-ns [[fully-qualified-var-name & args :as expr]] `(do (require '~(symbol (namespace fully-qualified-var-name))) - ~expr)) \ No newline at end of file + ~expr)) From cc5c1c8cf66126eb4e7eb1fa7c251cb53adaf001 Mon Sep 17 00:00:00 2001 From: Daniel Barreto Date: Sat, 23 Dec 2017 11:30:15 +0100 Subject: [PATCH 2/5] Make the writter bind print settings for tagged messages If the writter function cannot find print settings for the given message, it uses global print settings. --- src/unrepl/repl.clj | 33 ++++++++++++++++++++------------- 1 file changed, 20 insertions(+), 13 deletions(-) diff --git a/src/unrepl/repl.clj b/src/unrepl/repl.clj index 9ed84d0..681b2c0 100644 --- a/src/unrepl/repl.clj +++ b/src/unrepl/repl.clj @@ -64,13 +64,12 @@ (.write w "\n") (.flush w))))) -(defn fuse-write [awrite] - (fn [x] - (when-some [w @awrite] - (try - (w x) - (catch Throwable t - (reset! awrite nil)))))) +(defn fuse-write [awrite x] + (when-some [w @awrite] + (try + (w x) + (catch Throwable t + (reset! awrite nil))))) (def ^:dynamic write) @@ -219,6 +218,10 @@ :coll-length *print-length* :nesting-depth *print-level*}) +(defn- get-print-settings [session-id context] + "Return the `context` print settings for the given `session-id`." + (some-> session-id session :print-settings context)) + (defn update-print-settings! [session-id context string-length coll-length nesting-depth] "Update session's print settings for `context` and return its previous state as a backup." (let [session-atom (some-> @sessions (get session-id)) @@ -272,13 +275,19 @@ (let [session-id (keyword (gensym "session")) raw-out *out* aw (atom (atomic-write raw-out)) - write-here (fuse-write aw) + write-here (fn [x] + (let [settings (or (some->> x first (get-print-settings session-id)) + (default-print-settings 80))] + (binding [p/*string-length* (:string-length settings) + *print-length* (:coll-length settings) + *print-level* (:nesting-depth settings)] + (fuse-write aw x)))) schedule-writer-flush! (writers-flushing-repo 50) ; 20 fps (flushes per second) scheduled-writer (fn [& args] (-> (apply tagging-writer args) java.io.BufferedWriter. (doto schedule-writer-flush!))) - edn-out (scheduled-writer :out (fn [x] (binding [p/*string-length* Integer/MAX_VALUE] (write-here x)))) + edn-out (scheduled-writer :out write-here) ensure-raw-repl (fn [] (when (and @in-eval @unrepl) ; reading from eval! (var-set unrepl false) @@ -382,7 +391,6 @@ *file* "unrepl-session" *source-path* "unrepl-session" p/*elide* (:put elision-store) - p/*string-length* p/*string-length* write write-here] (.setContextClassLoader (Thread/currentThread) slcl) (with-bindings {clojure.lang.Compiler/LOADER slcl} @@ -411,15 +419,14 @@ :len (- offset' offset)} id]) (if (and (seq? r) (= (first r) 'unrepl/do)) - (let [write #(binding [p/*string-length* Integer/MAX_VALUE] (write %))] + (do (flushing [*err* (tagging-writer :err id write) *out* (scheduled-writer :out id write)] (eval (cons 'do (next r)))) request-prompt) r)))) :eval (fn [form] - (let [id @eval-id - write #(binding [p/*string-length* Integer/MAX_VALUE] (write %))] + (let [id @eval-id] (flushing [*err* (tagging-writer :err id write) *out* (scheduled-writer :out id write)] (interruptible-eval form)))) From 378ab7bb73c64dca40f260a133fcdc113b3dea5a Mon Sep 17 00:00:00 2001 From: Daniel Barreto Date: Sat, 23 Dec 2017 11:44:11 +0100 Subject: [PATCH 3/5] Allow attaching a `parent-session-id` when starting a new session This helps us use print settings of parent sessions when needed. --- src/unrepl/repl.clj | 357 ++++++++++++++++++++++---------------------- 1 file changed, 180 insertions(+), 177 deletions(-) diff --git a/src/unrepl/repl.clj b/src/unrepl/repl.clj index 681b2c0..fb9ca4e 100644 --- a/src/unrepl/repl.clj +++ b/src/unrepl/repl.clj @@ -266,189 +266,192 @@ (finally ~@(for [v (take-nth 2 bindings)] `(.flush ~(vary-meta v assoc :tag 'java.io.Writer))))))) -(defn start [] - (with-local-vars [in-eval false - unrepl false - eval-id 0 - prompt-vars #{#'*ns* #'*warn-on-reflection*} - current-eval-future nil] - (let [session-id (keyword (gensym "session")) - raw-out *out* - aw (atom (atomic-write raw-out)) - write-here (fn [x] - (let [settings (or (some->> x first (get-print-settings session-id)) - (default-print-settings 80))] - (binding [p/*string-length* (:string-length settings) - *print-length* (:coll-length settings) - *print-level* (:nesting-depth settings)] - (fuse-write aw x)))) - schedule-writer-flush! (writers-flushing-repo 50) ; 20 fps (flushes per second) - scheduled-writer (fn [& args] - (-> (apply tagging-writer args) - java.io.BufferedWriter. - (doto schedule-writer-flush!))) - edn-out (scheduled-writer :out write-here) - ensure-raw-repl (fn [] - (when (and @in-eval @unrepl) ; reading from eval! - (var-set unrepl false) - (write [:bye {:reason :upgrade :actions {}}]) - (flush) - ; (reset! aw (blocking-write)) - (set! *out* raw-out))) - in (unrepl-reader *in* ensure-raw-repl) - session-state (atom {:current-eval {} - :in in - :write-atom aw - :print-settings (merge - (zipmap [:eval :log] - (repeat (default-print-settings 80))) - (zipmap [:out :err :exception] - (repeat (default-print-settings Long/MAX_VALUE)))) - :log-eval (fn [msg] - (when (bound? eval-id) - (write [:log msg @eval-id]))) - :log-all (fn [msg] - (write [:log msg nil])) - :side-loader (atom nil) - :prompt-vars #{#'*ns* #'*warn-on-reflection*}}) - current-eval-thread+promise (atom nil) - ensure-unrepl (fn [] - (when-not @unrepl - (var-set unrepl true) - (flush) - (set! *out* edn-out) - (binding [*print-length* Long/MAX_VALUE - *print-level* Long/MAX_VALUE - p/*string-length* Long/MAX_VALUE] - (write [:unrepl/hello {:session session-id - :print-settings (:print-settings @session-state) - :actions (into - {:exit `(exit! ~session-id) - :start-aux `(start-aux ~session-id) - :log-eval - `(some-> ~session-id session :log-eval) - :log-all - `(some-> ~session-id session :log-all) - :print-settings - `(update-print-settings! ~session-id - ~(tagged-literal 'unrepl/param :unrepl.print/context) - ~(tagged-literal 'unrepl/param :unrepl.print/string-length) - ~(tagged-literal 'unrepl/param :unrepl.print/coll-length) - ~(tagged-literal 'unrepl/param :unrepl.print/nesting-depth)) - :set-source - `(unrepl/do - (set-file-line-col ~session-id - ~(tagged-literal 'unrepl/param :unrepl/sourcename) - ~(tagged-literal 'unrepl/param :unrepl/line) - ~(tagged-literal 'unrepl/param :unrepl/column))) - :unrepl.jvm/start-side-loader - `(attach-sideloader! ~session-id)} - #_ext-session-actions)}])))) - interruptible-eval - (fn [form] - (try - (let [original-bindings (get-thread-bindings) - p (promise) - f - (future - (swap! session-state update :current-eval - assoc :thread (Thread/currentThread)) - (with-bindings original-bindings - (try - (write [:started-eval - {:actions - {:interrupt (list `interrupt! session-id @eval-id) - :background (list `background! session-id @eval-id)}} - @eval-id]) - (let [v (with-bindings {in-eval true} - (blame :eval (eval form)))] - (deliver p {:eval v :bindings (get-thread-bindings)}) - v) - (catch Throwable t - (deliver p {:ex t :bindings (get-thread-bindings)}) - (throw t)))))] - (swap! session-state update :current-eval - into {:eval-id @eval-id :promise p :future f}) - (let [{:keys [ex eval bindings]} @p] - (doseq [[var val] bindings - :when (not (identical? val (original-bindings var)))] - (var-set var val)) - (if ex - (throw ex) - eval))) - (finally - (swap! session-state assoc :current-eval {})))) - cl (.getContextClassLoader (Thread/currentThread)) - slcl (classloader cl - (fn [k x] - (when-some [f (some-> session-state deref :side-loader deref)] - (f k x))))] - (swap! session-state assoc :class-loader slcl) - (swap! sessions assoc session-id session-state) - (binding [*out* raw-out - *err* (tagging-writer :err write) - *in* in - *file* "unrepl-session" - *source-path* "unrepl-session" - p/*elide* (:put elision-store) - write write-here] - (.setContextClassLoader (Thread/currentThread) slcl) - (with-bindings {clojure.lang.Compiler/LOADER slcl} - (try - (m/repl - :prompt (fn [] +(defn start + ([] (start nil)) + ([parent-session-id] + (with-local-vars [in-eval false + unrepl false + eval-id 0 + prompt-vars #{#'*ns* #'*warn-on-reflection*} + current-eval-future nil] + (let [session-id (keyword (gensym "session")) + raw-out *out* + aw (atom (atomic-write raw-out)) + write-here (fn [x] + (let [settings (or (some->> x first (get-print-settings (or parent-session-id session-id))) + (default-print-settings 80))] + (binding [p/*string-length* (:string-length settings) + *print-length* (:coll-length settings) + *print-level* (:nesting-depth settings)] + (fuse-write aw x)))) + schedule-writer-flush! (writers-flushing-repo 50) ; 20 fps (flushes per second) + scheduled-writer (fn [& args] + (-> (apply tagging-writer args) + java.io.BufferedWriter. + (doto schedule-writer-flush!))) + edn-out (scheduled-writer :out write-here) + ensure-raw-repl (fn [] + (when (and @in-eval @unrepl) ; reading from eval! + (var-set unrepl false) + (write [:bye {:reason :upgrade :actions {}}]) + (flush) + ; (reset! aw (blocking-write)) + (set! *out* raw-out))) + in (unrepl-reader *in* ensure-raw-repl) + session-state (atom {:parent-session-id parent-session-id + :current-eval {} + :in in + :write-atom aw + :print-settings (merge + (zipmap [:eval :log] + (repeat (default-print-settings 80))) + (zipmap [:out :err :exception] + (repeat (default-print-settings Long/MAX_VALUE)))) + :log-eval (fn [msg] + (when (bound? eval-id) + (write [:log msg @eval-id]))) + :log-all (fn [msg] + (write [:log msg nil])) + :side-loader (atom nil) + :prompt-vars #{#'*ns* #'*warn-on-reflection*}}) + current-eval-thread+promise (atom nil) + ensure-unrepl (fn [] + (when-not @unrepl + (var-set unrepl true) + (flush) + (set! *out* edn-out) + (binding [*print-length* Long/MAX_VALUE + *print-level* Long/MAX_VALUE + p/*string-length* Long/MAX_VALUE] + (write [:unrepl/hello {:session session-id + :print-settings (:print-settings @session-state) + :actions (into + {:exit `(exit! ~session-id) + :start-aux `(start-aux ~session-id) + :log-eval + `(some-> ~session-id session :log-eval) + :log-all + `(some-> ~session-id session :log-all) + :print-settings + `(update-print-settings! ~session-id + ~(tagged-literal 'unrepl/param :unrepl.print/context) + ~(tagged-literal 'unrepl/param :unrepl.print/string-length) + ~(tagged-literal 'unrepl/param :unrepl.print/coll-length) + ~(tagged-literal 'unrepl/param :unrepl.print/nesting-depth)) + :set-source + `(unrepl/do + (set-file-line-col ~session-id + ~(tagged-literal 'unrepl/param :unrepl/sourcename) + ~(tagged-literal 'unrepl/param :unrepl/line) + ~(tagged-literal 'unrepl/param :unrepl/column))) + :unrepl.jvm/start-side-loader + `(attach-sideloader! ~session-id)} + #_ext-session-actions)}])))) + interruptible-eval + (fn [form] + (try + (let [original-bindings (get-thread-bindings) + p (promise) + f + (future + (swap! session-state update :current-eval + assoc :thread (Thread/currentThread)) + (with-bindings original-bindings + (try + (write [:started-eval + {:actions + {:interrupt (list `interrupt! session-id @eval-id) + :background (list `background! session-id @eval-id)}} + @eval-id]) + (let [v (with-bindings {in-eval true} + (blame :eval (eval form)))] + (deliver p {:eval v :bindings (get-thread-bindings)}) + v) + (catch Throwable t + (deliver p {:ex t :bindings (get-thread-bindings)}) + (throw t)))))] + (swap! session-state update :current-eval + into {:eval-id @eval-id :promise p :future f}) + (let [{:keys [ex eval bindings]} @p] + (doseq [[var val] bindings + :when (not (identical? val (original-bindings var)))] + (var-set var val)) + (if ex + (throw ex) + eval))) + (finally + (swap! session-state assoc :current-eval {})))) + cl (.getContextClassLoader (Thread/currentThread)) + slcl (classloader cl + (fn [k x] + (when-some [f (some-> session-state deref :side-loader deref)] + (f k x))))] + (swap! session-state assoc :class-loader slcl) + (swap! sessions assoc session-id session-state) + (binding [*out* raw-out + *err* (tagging-writer :err write) + *in* in + *file* "unrepl-session" + *source-path* "unrepl-session" + p/*elide* (:put elision-store) + write write-here] + (.setContextClassLoader (Thread/currentThread) slcl) + (with-bindings {clojure.lang.Compiler/LOADER slcl} + (try + (m/repl + :prompt (fn [] + (ensure-unrepl) + (write [:prompt (into {:file *file* + :line (.getLineNumber *in*) + :column (.getColumnNumber *in*) + :offset (:offset *in*)} + (map (fn [v] + (let [m (meta v)] + [(symbol (name (ns-name (:ns m))) (name (:name m))) @v]))) + (:prompt-vars @session-state))])) + :read (fn [request-prompt request-exit] + (blame :read (let [id (var-set eval-id (inc @eval-id)) + line+col [(.getLineNumber *in*) (.getColumnNumber *in*)] + offset (:offset *in*) + r (m/repl-read request-prompt request-exit) + line+col' [(.getLineNumber *in*) (.getColumnNumber *in*)] + offset' (:offset *in*) + len (- offset' offset)] + (write [:read {:from line+col :to line+col' + :offset offset + :len (- offset' offset)} + id]) + (if (and (seq? r) (= (first r) 'unrepl/do)) + (do + (flushing [*err* (tagging-writer :err id write) + *out* (scheduled-writer :out id write)] + (eval (cons 'do (next r)))) + request-prompt) + r)))) + :eval (fn [form] + (let [id @eval-id] + (flushing [*err* (tagging-writer :err id write) + *out* (scheduled-writer :out id write)] + (interruptible-eval form)))) + :print (fn [x] (ensure-unrepl) - (write [:prompt (into {:file *file* - :line (.getLineNumber *in*) - :column (.getColumnNumber *in*) - :offset (:offset *in*)} - (map (fn [v] - (let [m (meta v)] - [(symbol (name (ns-name (:ns m))) (name (:name m))) @v]))) - (:prompt-vars @session-state))])) - :read (fn [request-prompt request-exit] - (blame :read (let [id (var-set eval-id (inc @eval-id)) - line+col [(.getLineNumber *in*) (.getColumnNumber *in*)] - offset (:offset *in*) - r (m/repl-read request-prompt request-exit) - line+col' [(.getLineNumber *in*) (.getColumnNumber *in*)] - offset' (:offset *in*) - len (- offset' offset)] - (write [:read {:from line+col :to line+col' - :offset offset - :len (- offset' offset)} - id]) - (if (and (seq? r) (= (first r) 'unrepl/do)) - (do - (flushing [*err* (tagging-writer :err id write) - *out* (scheduled-writer :out id write)] - (eval (cons 'do (next r)))) - request-prompt) - r)))) - :eval (fn [form] - (let [id @eval-id] - (flushing [*err* (tagging-writer :err id write) - *out* (scheduled-writer :out id write)] - (interruptible-eval form)))) - :print (fn [x] - (ensure-unrepl) - (write [:eval x @eval-id])) - :caught (fn [e] - (ensure-unrepl) - (let [{:keys [::ex ::phase] - :or {ex e phase :repl}} (ex-data e)] - (write [:exception {:ex ex :phase phase} @eval-id])))) - (finally - (.setContextClassLoader (Thread/currentThread) cl)))) - (write [:bye {:reason :disconnection - :outs :muted - :actions {:reattach-outs `(reattach-outs! ~session-id)}}]))))) + (write [:eval x @eval-id])) + :caught (fn [e] + (ensure-unrepl) + (let [{:keys [::ex ::phase] + :or {ex e phase :repl}} (ex-data e)] + (write [:exception {:ex ex :phase phase} @eval-id])))) + (finally + (.setContextClassLoader (Thread/currentThread) cl)))) + (write [:bye {:reason :disconnection + :outs :muted + :actions {:reattach-outs `(reattach-outs! ~session-id)}}])))))) (defn start-aux [session-id] (let [cl (.getContextClassLoader (Thread/currentThread))] (try (some->> session-id session :class-loader (.setContextClassLoader (Thread/currentThread))) - (start) + (start session-id) (finally (.setContextClassLoader (Thread/currentThread) cl))))) From bf813efb1fd54595d48a94a114c666fa5fcd4c3a Mon Sep 17 00:00:00 2001 From: Daniel Barreto Date: Sat, 23 Dec 2017 19:26:04 +0100 Subject: [PATCH 4/5] Reorganize function declarations to avoid compilation problems --- src/unrepl/repl.clj | 60 +++++++++++++++++++++++---------------------- 1 file changed, 31 insertions(+), 29 deletions(-) diff --git a/src/unrepl/repl.clj b/src/unrepl/repl.clj index fb9ca4e..5adc40e 100644 --- a/src/unrepl/repl.clj +++ b/src/unrepl/repl.clj @@ -25,6 +25,11 @@ (.invoke define-class this (to-array name bytes 0 (count bytes))) (throw (ClassNotFoundException. name))))))) +(defonce ^:private sessions (atom {})) + +(defn session [id] + (some-> @sessions (get id) deref)) + (defn ^java.io.Writer tagging-writer ([write] (proxy [java.io.Writer] [] @@ -73,6 +78,32 @@ (def ^:dynamic write) +(defn default-print-settings [sl] + "Return print settings with clojure.core's `*print-length*` and + `*print-level*` global vars as default." + {:string-length sl + :coll-length *print-length* + :nesting-depth *print-level*}) + +(defn- get-print-settings [session-id context] + "Return the `context` print settings for the given `session-id`." + (when-let [settings (some-> session-id session :print-settings context)] + (merge settings {:context context}))) + +(defn update-print-settings! [session-id context string-length coll-length nesting-depth] + "Update session's print settings for `context` and return its previous state as a backup." + (let [session-atom (some-> @sessions (get session-id)) + backup-settings (-> @session-atom + :print-settings + context + (rename-keys {:string-length :unrepl.print/string-length + :coll-length :unrepl.print/coll-length + :nesting-depth :unrepl.print/nesting-depth}))] + (swap! session-atom assoc-in [:print-settings context :string-length] string-length) + (swap! session-atom assoc-in [:print-settings context :coll-length] coll-length) + (swap! session-atom assoc-in [:print-settings context :nesting-depth] nesting-depth) + backup-settings)) + (defn unrepl-reader [^java.io.Reader r before-read] (let [offset (atom 0) offset! #(swap! offset + %)] @@ -148,8 +179,6 @@ (if (= NULL x) nil x) not-found))})) -(defonce ^:private sessions (atom {})) - (defonce ^:private elision-store (soft-store #(list `fetch %) p/unreachable)) (defn fetch [id] (let [x ((:get elision-store) id)] @@ -160,8 +189,6 @@ (instance? unrepl.print.MimeContent x) x :else (seq x)))) -(defn session [id] - (some-> @sessions (get id) deref)) (defn interrupt! [session-id eval] (let [{:keys [^Thread thread eval-id promise]} @@ -211,31 +238,6 @@ (some-> (edn/read {:eof nil} in) p/base64-decode))))))) (let [o (Object.)] (locking o (.wait o)))) -(defn default-print-settings [sl] - "Return print settings with clojure.core's `*print-length*` and - `*print-level*` global vars as default." - {:string-length sl - :coll-length *print-length* - :nesting-depth *print-level*}) - -(defn- get-print-settings [session-id context] - "Return the `context` print settings for the given `session-id`." - (some-> session-id session :print-settings context)) - -(defn update-print-settings! [session-id context string-length coll-length nesting-depth] - "Update session's print settings for `context` and return its previous state as a backup." - (let [session-atom (some-> @sessions (get session-id)) - backup-settings (-> @session-atom - :print-settings - context - (rename-keys {:string-length :unrepl.print/string-length - :coll-length :unrepl.print/coll-length - :nesting-depth :unrepl.print/nesting-depth}))] - (swap! session-atom assoc-in [:print-settings context :string-length] string-length) - (swap! session-atom assoc-in [:print-settings context :coll-length] coll-length) - (swap! session-atom assoc-in [:print-settings context :nesting-depth] nesting-depth) - backup-settings)) - (defn set-file-line-col [session-id file line col] (when-some [^java.lang.reflect.Field field (->> clojure.lang.LineNumberingPushbackReader From f675c74c8fc01b2c1096e757d7065e8c141c84d7 Mon Sep 17 00:00:00 2001 From: Daniel Barreto Date: Sat, 23 Dec 2017 19:26:56 +0100 Subject: [PATCH 5/5] Add `contextual-elision` function This function will elide content and will provide print-settings information for the execution context --- src/unrepl/repl.clj | 51 ++++++++++++++++++++++++++++++++------------- 1 file changed, 36 insertions(+), 15 deletions(-) diff --git a/src/unrepl/repl.clj b/src/unrepl/repl.clj index 5adc40e..178c349 100644 --- a/src/unrepl/repl.clj +++ b/src/unrepl/repl.clj @@ -78,27 +78,38 @@ (def ^:dynamic write) -(defn default-print-settings [sl] - "Return print settings with clojure.core's `*print-length*` and - `*print-level*` global vars as default." - {:string-length sl - :coll-length *print-length* - :nesting-depth *print-level*}) +(defn print-settings-map + "Return print settings map with clojure.core's `*print-length*` and + `*print-level*` global vars as default, and with the possibility to customize + `unrepl.print/*string-length*` to any value." + ([] (print-settings-map p/*string-length*)) + ([sl] + {:string-length sl + :coll-length *print-length* + :nesting-depth *print-level*})) -(defn- get-print-settings [session-id context] +(defn- print-settings-fully-qualify + "Rename keys in `settings-map` to have them as fully qualified keywords. + This function is meant to be used to return print settings to clients." + [settings-map] + (rename-keys settings-map {:string-length :unrepl.print/string-length + :coll-length :unrepl.print/coll-length + :nesting-depth :unrepl.print/nesting-depth})) + +(defn- get-print-settings "Return the `context` print settings for the given `session-id`." + [session-id context] (when-let [settings (some-> session-id session :print-settings context)] (merge settings {:context context}))) -(defn update-print-settings! [session-id context string-length coll-length nesting-depth] +(defn update-print-settings! "Update session's print settings for `context` and return its previous state as a backup." + [session-id context string-length coll-length nesting-depth] (let [session-atom (some-> @sessions (get session-id)) backup-settings (-> @session-atom :print-settings context - (rename-keys {:string-length :unrepl.print/string-length - :coll-length :unrepl.print/coll-length - :nesting-depth :unrepl.print/nesting-depth}))] + print-settings-fully-qualify)] (swap! session-atom assoc-in [:print-settings context :string-length] string-length) (swap! session-atom assoc-in [:print-settings context :coll-length] coll-length) (swap! session-atom assoc-in [:print-settings context :nesting-depth] nesting-depth) @@ -189,6 +200,16 @@ (instance? unrepl.print.MimeContent x) x :else (seq x)))) +(defn contextual-elision + "Return a function that puts its first argument into the elision store. The + returned function may also accept a second argument to be a printing context, + the elision-store result is extended with the print-settings for the given + `session-id` and context. If context is not provided, `:eval` is used as + default." + [x] + (merge + ((:put elision-store) x) + {:print-settings (print-settings-fully-qualify (print-settings-map))})) (defn interrupt! [session-id eval] (let [{:keys [^Thread thread eval-id promise]} @@ -281,7 +302,7 @@ aw (atom (atomic-write raw-out)) write-here (fn [x] (let [settings (or (some->> x first (get-print-settings (or parent-session-id session-id))) - (default-print-settings 80))] + (print-settings-map 80))] (binding [p/*string-length* (:string-length settings) *print-length* (:coll-length settings) *print-level* (:nesting-depth settings)] @@ -306,9 +327,9 @@ :write-atom aw :print-settings (merge (zipmap [:eval :log] - (repeat (default-print-settings 80))) + (repeat (print-settings-map 80))) (zipmap [:out :err :exception] - (repeat (default-print-settings Long/MAX_VALUE)))) + (repeat (print-settings-map Long/MAX_VALUE)))) :log-eval (fn [msg] (when (bound? eval-id) (write [:log msg @eval-id]))) @@ -395,7 +416,7 @@ *in* in *file* "unrepl-session" *source-path* "unrepl-session" - p/*elide* (:put elision-store) + p/*elide* contextual-elision write write-here] (.setContextClassLoader (Thread/currentThread) slcl) (with-bindings {clojure.lang.Compiler/LOADER slcl}