├── .lein-classpath
├── deps.edn
├── .gitignore
├── project.clj
├── src
    └── unrepl
    │   ├── core.clj
    │   ├── blob-template.clj
    │   ├── make_blob.clj
    │   ├── shade_libs.clj
    │   ├── printer.clj
    │   └── repl.clj
├── UPGRADE.md
├── README.md
└── SPEC.md


/.lein-classpath:
--------------------------------------------------------------------------------
1 | tasks


--------------------------------------------------------------------------------
/deps.edn:
--------------------------------------------------------------------------------
1 | {:deps
2 |  {org.clojure/tools.namespace {:mvn/version "0.2.11"}
3 |   compliment {:mvn/version "0.3.6"}}}
4 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
 1 | /target
 2 | /classes
 3 | /checkouts
 4 | pom.xml
 5 | pom.xml.asc
 6 | *.jar
 7 | *.class
 8 | .lein-deps-sum
 9 | .lein-repl-history
10 | .lein-plugins/
11 | .lein-failures
12 | .nrepl-port
13 | .hgignore
14 | .hg/
15 | resources
16 | 


--------------------------------------------------------------------------------
/project.clj:
--------------------------------------------------------------------------------
 1 | (defproject net.cgrand/unrepl "0.1.0-SNAPSHOT"
 2 |   :description "FIXME: write description"
 3 |   :url "http://example.com/FIXME"
 4 |   :license {:name "Eclipse Public License"
 5 |             :url "http://www.eclipse.org/legal/epl-v10.html"}
 6 |   :dependencies [[org.clojure/clojure "1.8.0"]
 7 |                  [org.clojure/tools.nrepl "0.2.12"]]
 8 |   :plugins [[lein-cljfmt "0.5.7"]]
 9 |   :profiles {:dev {:dependencies [[com.taoensso/timbre "4.8.0"]]}})
10 | 


--------------------------------------------------------------------------------
/src/unrepl/core.clj:
--------------------------------------------------------------------------------
 1 | (ns unrepl.core
 2 |   (:refer-clojure :exclude [read eval print]))
 3 | 
 4 | (def ^:once ^:private loaded-by "unrepl.repl")
 5 | 
 6 | (def ^:once ^:dynamic *string-length* 80)
 7 | (def ^:once ^:dynamic ^{:arglists '([x]) :doc "Atomically machine-prints its input (a triple) to the output stream."} write)
 8 | 
 9 | (defn ^:once non-eliding-write "use with care" [x]
10 |   (binding [*print-length* Long/MAX_VALUE
11 |             *print-level* Long/MAX_VALUE
12 |             *string-length* Long/MAX_VALUE]
13 |     (write x)))
14 | 
15 | 
16 | (declare ^:once ^:dynamic read ^:once ^:dynamic print ^:once ^:dynamic eval)


--------------------------------------------------------------------------------
/src/unrepl/blob-template.clj:
--------------------------------------------------------------------------------
 1 | (clojure.core/let [nop (clojure.core/constantly nil)
 2 |                    done (promise)
 3 |                    e (clojure.core/atom eval)]
 4 |   (-> (create-ns 'unrepl.repl)
 5 |     (intern '-init-done)
 6 |     (alter-var-root
 7 |       (fn [v]
 8 |         (if (instance? clojure.lang.IDeref v)
 9 |           (do ; another thread created the var, wait for it to be finished
10 |             (reset! e (if-some [ex @v]
11 |                         (fn [_] (throw ex))
12 |                         nop))
13 |             v)
14 |           done))))
15 |   (clojure.main/repl
16 |     :read #(let [x (clojure.core/read)] (clojure.core/case x <<<FIN (do (deliver done nil) %2) x))
17 |     :prompt nop
18 |     :eval #(@e %)
19 |     :print nop
20 |     :caught #(do (set! *e %) (reset! e nop) (prn [:unrepl.upgrade/failed %]))))
21 | <BLOB-PAYLOAD>
22 | <<<FIN
23 | (clojure.core/ns user)
24 | (unrepl.repl/start (clojure.edn/read {:default tagged-literal} *in*))
25 | 


--------------------------------------------------------------------------------
/UPGRADE.md:
--------------------------------------------------------------------------------
 1 | # How to upgrade a repl to unrepl 
 2 | 
 3 | (Audience: repl client authors)
 4 | 
 5 | Once you have a connection to a REPL, you send the content of the resource file `unrepl/blob.clj` to it (the file is not present in the repository but should be present in the artifact, it's generated by `clj -m unrepl.make-blob`).
 6 | 
 7 | Either you get `[:unrepl.upgrade/failed]` or `[:unrepl/hello ...]` on the repl output. Upon failure you are back in the repl you started from.
 8 | 
 9 | Each use of the blob creates gensymed namespaces.
10 | 
11 | You can customize the blob: enter `clj -m unrepl.make-blob -o <target-file> -a <session actions map>`. Where the session actions map can be either a string or a `.edn` file. For example:
12 | 
13 | ```
14 | # As a string
15 | $> clj -m unrepl.make-blob -o foo-blob.clj -a '{:my.own/action (foo/bar #unrepl/param :baz)}'
16 | # As a file
17 | $> clj -m unrepl.make-blob -o foo-blob.clj -a custom-actions.edn
18 | ```
19 | 
20 | If a custom action has a qualified symbol as the first element (function symbol) for its topmost form, this qualified symbol's namespace will automatically be required on the first use of the action.
21 | 
22 | Shading of the blob may be optionally turned of with the `--noshade` option.
23 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
 1 | # unrepl
 2 | 
 3 | A REPL-centric approach to tooling, by means of a general purpose stream-based REPL protocol.
 4 | 
 5 | Unrepl is the common base for a set of REPL protocols.  It is meant as an upgrade-path from a more basic [nREPL](https://nrepl.xyz) or [Socket REPL](https://clojure.org/reference/repl_and_main#_launching_a_socket_server), and allows different Unrepl-based clients to implement their own extensions to the REPL protocol (e.g. for IDE integration).  Such Unrepl-based clients would send their own server payload ("blob") through the basic REPL connection into the target process, to upgrade the server side of this connection with the desired features.  After this upgrade, the client could use the new features on the existing REPL connection.
 6 | 
 7 | The benefit of this process is, that the target process does not need to include REPL code beyond Socket REPL, which is already included in Clojure 1.8+.  Everything else is loaded only when needed and can be extended according to the needs of the client.  Due to the shared common base, it should be easy to share parts of the server implementation between different Unrepl derivatives.
 8 | 
 9 | Thus Unrepl is intended for toolsmiths and not something a regular user will usually come in direct contact with.  Assuming someone uses "MyIDE", they would setup a "MyIDE REPL" connection to their program from the "MyIDE" UI, and "MyIDE" would transparently upgrade the REPL connection to something they could brand as the "MyIDE REPL" experience, without the user noticing that something like Unrepl even exists.
10 | 
11 | Unrepl is really a meant as a foundation for derivative private works used by clients.
12 | 
13 | ## What's "the blob"?
14 | 
15 | The blob is a piece of clojure code sent to bootstrap an unrepl implementation. It's expected to be static and opaque.
16 | 
17 | ## Why this hypermedia nonsense if the unrepl implementation is private to the client?
18 | 
19 | Well it decouples the client and its unrepl implementation, making it easier for the client maintainer to reuse or share code of their server implementation with other tools maintainers.
20 | 
21 | Furthermore if you start considering that a client may ship several blobs (eg one for Clojure, one for Clojurescript) then it allows the client to behave properly independently on the nature of the endpoint. 
22 | 
23 | ## Usage
24 | 
25 | If you are a simple user, you don't need to care about unrepl proper, not even add it to your project deps. Just use one of the existing clients:
26 | 
27 |  * [Unravel](https://github.com/Unrepl/unravel) a command-line client,
28 |  * [Spiral](https://github.com/Unrepl/spiral) an Emacs one.
29 |  * [Vimpire](https://bitbucket.org/kotarak/vimpire) ([git](https://github.com/kotarak/vimpire)) for Vim
30 | 
31 | If you want to develop a client or just understand better what's happening under the hood then try:
32 | 
33 | ```sh
34 | git clone https://github.com/Unrepl/unrepl.git
35 | cd unrepl
36 | # start a plain repl (non unrepl, non nrepl), so using the clojure command line tools:
37 | clojure -J-Dclojure.server.repl="{:port 5555,:accept clojure.core.server/repl,:server-daemon false}" & 
38 | # generate the blob
39 | clj -m unrepl.make-blob
40 | # connect, upgrade and enjoy!
41 | rlwrap cat resources/unrepl/blob.clj - | nc localhost 5555
42 | ```
43 | 
44 | ## Background
45 | 
46 | Imagine a protocol so flexible that you can upgrade it to anything you want.
47 | 
48 | This protocol exists, it's a REPL. A standard repl (clojure.main or the socket repl) is not perfect for tooling but it provides a common minimal ground: an input and output streams of characters. Both can be hijacked to install your own handler, including another REPL better suited for its client.
49 | 
50 | REPL: the ultimate content negotiation protocol!
51 | 
52 | The present repository suggests representations for machine-to-machine REPLs and provides a reference implementation.
53 | 
54 | A REPL is, by nature, a very sequential process: it reads, then evals, then prints, and then starts over. One REPL = One thread. Concurrency is achieved by having several REPLs.
55 | 
56 | A REPL is also stateful, it is a connected protocol, so the context doesn't need to be transferred constantly.
57 | 
58 | A REPL is meant for evaluating code.
59 | 
60 | Some tooling needs (e.g. autocompletion) may be better serviced by a separate connection, which should not necessarily be a REPL (but may have started as a REPL upgraded to something else.)
61 | 
62 | Parts of this specification assumes two REPLs: the main (or user) REPL and the control (or client) REPL.
63 | 
64 | 


--------------------------------------------------------------------------------
/src/unrepl/make_blob.clj:
--------------------------------------------------------------------------------
  1 | (ns unrepl.make-blob
  2 |   (:require
  3 |     [clojure.java.io :as io]
  4 |     [clojure.edn :as edn]
  5 |     [clojure.string :as str]
  6 |     [unrepl.shade-libs :as shade]))
  7 | 
  8 | (defn- strip-spaces-and-comments [s]
  9 |   #_(I had this nice #"(?s)(?:\s|;[^\n\r]*)+|((?:[^;\"\\\s]|\\.|\"(?:[^\"\\]|\\.)*\")+)"
 10 |       but it generates stack overflows...
 11 |       so let's write the state machine!)
 12 |   (let [sb (StringBuilder.)]
 13 |     (letfn [(regular [c]
 14 |               (case c
 15 |                 \; comment
 16 |                 \# dispatch
 17 |                 \" (do (.append sb c) string)
 18 |                 \\ (do (.append sb c) regular-esc)
 19 |                 (\newline \return) strip-nl
 20 |                 (\tab \space \,) strip
 21 |                 (do (.append sb c) regular)))
 22 |             (strip [c]
 23 |               (case c
 24 |                 (\newline \return) strip-nl
 25 |                 (\tab \space \,) strip
 26 |                 \; comment
 27 |                 (do (.append sb " ") (regular c))))
 28 |             (strip-nl [c]
 29 |               (case c
 30 |                 (\newline \return \tab \space \,) strip-nl
 31 |                 \; comment
 32 |                 (do (.append sb "\n") (regular c))))
 33 |             (dispatch [c]
 34 |               (case c
 35 |                 \! comment
 36 |                 \" (do (.append sb "#\"") string)
 37 |                 (do (-> sb (.append "#") (.append c)) regular)))
 38 |             (comment [c]
 39 |               (case c
 40 |                 \newline strip-nl
 41 |                 comment))
 42 |             (string [c]
 43 |               (.append sb c)
 44 |               (case c
 45 |                 \" regular
 46 |                 \\ string-esc
 47 |                 string))
 48 |             (string-esc [c]
 49 |               (.append sb c)
 50 |               string)
 51 |             (regular-esc [c]
 52 |               (.append sb c)
 53 |               regular)]
 54 |       (reduce
 55 |         #(%1 %2)
 56 |         regular s))
 57 |     (str sb)))
 58 | 
 59 | (defn- gen-blob [session-actions required-libs options]
 60 |   (let [template (slurp (io/resource "unrepl/blob-template.clj"))
 61 |         shaded-code-sb (StringBuilder.)
 62 |         shaded-libs (shade/shade 'unrepl.repl
 63 |                       (into options
 64 |                         {:writer (fn [_ ^String code] (.append shaded-code-sb code))}))
 65 |         shaded-libs
 66 |         (reduce (fn [shaded-libs required-lib]
 67 |                   (into shaded-libs
 68 |                     (shade/shade-to-dir required-lib (:libs-dir options)
 69 |                       (assoc options
 70 |                         :provided [#"clojure\..*" shaded-libs]))))
 71 |           shaded-libs required-libs)
 72 |         code (-> template
 73 |                (str/replace "unrepl.repl" (str (shaded-libs 'unrepl.repl)))
 74 |                (str/replace "<BLOB-PAYLOAD>" (str shaded-code-sb)))]
 75 |     (str (strip-spaces-and-comments code) "\n" (shade/shade-code session-actions shaded-libs) "\n"))) ; newline to force eval by the repl
 76 | 
 77 | (defn -main
 78 |   ([& args]
 79 |    (let [options (loop [args    (seq args)
 80 |                         options {:except ['unrepl.core]
 81 |                                  :provided [#"clojure\..*"]
 82 |                                  :session-actions "{}"
 83 |                                  :target "resources/unrepl/blob.clj"
 84 |                                  :libs-dir "resources/blob-libs"}]
 85 |                    (if args
 86 |                      (condp contains? (first args)
 87 |                        #{"--noshade"}       (recur (next args)  (assoc options :except [#".+"]))
 88 |                        #{"-e" "--except"}   (recur (nnext args)
 89 |                                                    (if-let [args (next args)]
 90 |                                                      (update-in options [:except] conj (read-string (first args)))
 91 |                                                      (throw (ex-info (str "Missing argument for --except")))))
 92 |                        #{"-p" "--provided"} (recur (nnext args)
 93 |                                                    (if-let [args (next args)]
 94 |                                                      (update-in options [:provided] conj (read-string (first args)))
 95 |                                                      (throw (ex-info (str "Missing argument for --provided")))))
 96 |                        #{"-o" "--output"}   (recur (nnext args) (assoc options :target (fnext args)))
 97 |                        #{"-a" "--actions"}  (recur (nnext args) (assoc options :session-actions (fnext args)))
 98 |                        #{"-h" "--help"}     (do
 99 |                                               (println "clj -m unrepl.make-blob [--noshade] [-e <exception>]* [-p <provided>]* [--output|-o <file>] [--actions|-a <map-or-file>]")
100 |                                               (System/exit 1))
101 |                        (throw (ex-info (str "Unknown argument: " (first args)) {:arg (first args)})))
102 |                      options))
103 |          session-actions-source (if (re-find #"^\s*\{" (:session-actions options)) (:session-actions options) (slurp (:session-actions options)))
104 |          session-actions-map (edn/read-string {:default tagged-literal} session-actions-source)]
105 |      (-> options :target io/file .getAbsoluteFile .getParentFile .mkdirs)
106 |      (if (map? session-actions-map)
107 |        (let [required-libs (into #{}
108 |                              (keep (fn [[k v]]
109 |                                      (when (seq? v) (symbol? (first v)) (some-> (namespace (first v)) symbol))))
110 |                              session-actions-map)]
111 |          (spit (:target options) (gen-blob (pr-str session-actions-map) required-libs options)))
112 |        (println "The arguments must be: a target file name and an EDN map.")))))
113 | 


--------------------------------------------------------------------------------
/src/unrepl/shade_libs.clj:
--------------------------------------------------------------------------------
  1 | (ns unrepl.shade-libs
  2 |   (:require [clojure.tools.namespace.parse :as nsp]
  3 |     [clojure.java.io :as io]
  4 |     [clojure.string :as str]
  5 |     [clojure.pprint :as pp]))
  6 | 
  7 | (defn ns-reader [ns-name]
  8 |   (let [base (str/replace (name ns-name) #"[.-]" {"." "/" "-" "_"})]
  9 |     (some-> (or (io/resource (str base ".clj")) (io/resource (str base ".cljc"))) io/reader)))
 10 | 
 11 | (defn deps [ns-name]
 12 |   (when-some [rdr (ns-reader ns-name)]
 13 |     (with-open [rdr (-> rdr java.io.PushbackReader.)]
 14 |       (nsp/deps-from-ns-decl (nsp/read-ns-decl rdr)))))
 15 | 
 16 | (defn- base64-encode
 17 |   "Non-standard base64 to avoid name munging"
 18 |   [^java.io.InputStream in]
 19 |   (let [table "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789_$"
 20 |         sb (StringBuilder.)]
 21 |     (loop [shift 4 buf 0]
 22 |       (let [got (.read in)]
 23 |         (if (neg? got)
 24 |           (do
 25 |             (when-not (= shift 4)
 26 |               (let [n (bit-and (bit-shift-right buf 6) 63)]
 27 |                 (.append sb (.charAt table n))))
 28 |             #_(cond
 29 |                (= shift 2) (.append sb "==")
 30 |                (= shift 0) (.append sb \=))
 31 |             (str sb))
 32 |           (let [buf (bit-or buf (bit-shift-left got shift))
 33 |                 n (bit-and (bit-shift-right buf 6) 63)]
 34 |             (.append sb (.charAt table n))
 35 |             (let [shift (- shift 2)]
 36 |               (if (neg? shift)
 37 |                 (do
 38 |                   (.append sb (.charAt table (bit-and buf 63)))
 39 |                   (recur 4 0))
 40 |                 (recur shift (bit-shift-left buf 6))))))))))
 41 | 
 42 | (defn- sha1 [^bytes bytes]
 43 |   (.digest (java.security.MessageDigest/getInstance "SHA-1") bytes))
 44 | 
 45 | (defn hash64 [s]
 46 |   (-> s (.getBytes "UTF-8") sha1 java.io.ByteArrayInputStream. base64-encode))
 47 | 
 48 | (defn- libspec? ; taken from clojure
 49 |   "Returns true if x is a libspec"
 50 |   [x]
 51 |   (or (symbol? x)
 52 |       (and (vector? x)
 53 |            (or
 54 |             (nil? (second x))
 55 |             (keyword? (second x))))))
 56 | 
 57 | (defn unfold-ns [ns-form]
 58 |   (map
 59 |     (fn [x]
 60 |       (case (when (sequential? x) (first x))
 61 |         (:require :use)
 62 |         (let [[op & flags] (filter keyword? x)
 63 |               libspecs-or-prefixlists (remove keyword? x)]
 64 |           (concat
 65 |             [op] 
 66 |             (mapcat (fn [libspec-or-prefixlist]
 67 |                       (if (libspec? libspec-or-prefixlist)
 68 |                         [libspec-or-prefixlist]
 69 |                         (let [[prefix & libspecs] libspec-or-prefixlist]
 70 |                           (for [libspec libspecs]
 71 |                             (if (symbol? libspec)
 72 |                               (symbol (str prefix "." libspec))
 73 |                               (assoc libspec 0 (symbol (str prefix "." (libspec 0)))))))))
 74 |               libspecs-or-prefixlists)
 75 |             flags))
 76 |         :import (let [[op & classes-or-lists] x]
 77 |                   (cons op
 78 |                     (mapcat
 79 |                       (fn [class-or-list]
 80 |                         (if (symbol? class-or-list)
 81 |                           [class-or-list]
 82 |                           (let [[prefix & classes] class-or-list]
 83 |                             (for [class classes]
 84 |                               (symbol (str prefix "." class))))))
 85 |                       classes-or-lists)))
 86 |         x))
 87 |     ns-form))
 88 | 
 89 | (defn slurp-ns [ns-name]
 90 |   (let [r (-> ns-name ns-reader clojure.lang.LineNumberingPushbackReader.)
 91 |         w (java.io.StringWriter.)
 92 |         ns-form (read r)]
 93 |     (when-not (and (seq? ns-form) (= 'ns (first ns-form)))
 94 |       (throw (ex-info (str "Unexpected first form for ns " ns-name)
 95 |                {:ns ns-name :form ns-form})))
 96 |     (binding [*out* w] (pp/pprint (unfold-ns ns-form)))
 97 |     (io/copy r w)
 98 |     (str w)))
 99 | 
100 | (defn make-pattern [nses]
101 |   (->> nses (map name) (sort-by (comp - count))
102 |     (map #(java.util.regex.Pattern/quote %))
103 |     (str/join "|")
104 |     re-pattern))
105 | 
106 | (defn shade-code [src shaded-nses]
107 |   (str/replace src (make-pattern (keys shaded-nses)) #(name (shaded-nses (symbol %)))))
108 | 
109 | (defn shade
110 |   "Shade all namespaces (transitively) required by ns-name.
111 |    Shaded code is written using the writer function: a function of two arguments:
112 |    the shaded ns name (a symbol), the shaded code (a string).
113 |    Exceptions to shading are specified under the :except option, but are still written out.
114 |    Provided namespaces won't be shaded nor included.
115 |    This option can be a regex, a symbol, a map (for explicit renames), or a
116 |    collection of such exceptions.
117 |    The default exceptions are empty and provided is #\"clojure\\..*\", don't forget to reassert that if
118 |    you specify your own provided libs."
119 |   [ns-name {:keys [writer except provided] :or {provided #"clojure\..*"}}]
120 |   (letfn [(rename
121 |             ([ns-name] (rename ns-name except))
122 |             ([ns-name except]
123 |               (cond
124 |                 (nil? except) nil
125 |                 (or (map? except) (set? except)) (except ns-name)
126 |                 (symbol? except) (when (= except ns-name) ns-name)
127 |                 (instance? java.util.regex.Pattern except) (when (re-matches except (name ns-name)) ns-name)
128 |                 (coll? except) (some #(rename ns-name %) except)
129 |                 :else (throw (ex-info (str "Unexpected shading exception rule: " except) {:except except})))))
130 |           (provided-alias [ns-name] (rename ns-name provided))
131 |           (shade [shaded-nses ns-name]
132 |             (cond
133 |               (shaded-nses ns-name)
134 |               shaded-nses
135 |               (provided-alias ns-name)
136 |               (assoc shaded-nses ns-name (provided-alias ns-name))
137 |               :else
138 |               (let [shaded-nses (reduce shade shaded-nses (deps ns-name))
139 |                     shaded-nses (assoc shaded-nses ns-name ns-name) ; temporary map the current name to itself to prevent rewrite
140 |                     almost-shaded-code (shade-code (slurp-ns ns-name) shaded-nses)
141 |                     h64 (hash64 almost-shaded-code)
142 |                     shaded-ns-name (or (rename ns-name) (symbol (str ns-name "$" h64)))
143 |                     preserve-shaded-nses (assoc (zipmap (vals shaded-nses) (vals shaded-nses))
144 |                                            ns-name shaded-ns-name) ; avoid rewriting already rewritten nses
145 |                     shaded-code (shade-code almost-shaded-code preserve-shaded-nses)]
146 |                 (writer shaded-ns-name shaded-code)
147 |                 (assoc shaded-nses ns-name shaded-ns-name))))]
148 |    (shade {} ns-name)))
149 | 
150 | (defn shade-to-dir
151 |   ([ns-name dir] (shade-to-dir ns-name dir {}))
152 |   ([ns-name dir options]
153 |     (shade ns-name
154 |       (assoc options
155 |         :writer
156 |         (fn [ns-name code]
157 |           (let [filename (str (str/replace (name ns-name) #"[.-]" {"." "/" "-" "_"}) ".clj")
158 |                 file (java.io.File. dir filename)]
159 |             (-> file .getParentFile .mkdirs)
160 |             (spit file code :encoding "UTF-8"))))))
161 |   ([ns-name dir optk optv & {:as options}] (shade-to-dir ns-name dir (assoc options optk optv))))
162 | 
163 | (defn -main
164 |   ([ns-name]
165 |     (-main ns-name "resources"))
166 |   ([ns-name dir]
167 |     (shade-to-dir (symbol ns-name) dir)))
168 | 


--------------------------------------------------------------------------------
/SPEC.md:
--------------------------------------------------------------------------------
  1 | # unrepl specification
  2 | 
  3 | ## Status
  4 | 
  5 | This document is a work in progress but is mostly stable at this point (few breakings change to expect). A companion implementation is available in the `unrepl.repl` namespace.
  6 | 
  7 | You can ask questions and share feedback on the `#unrepl` channel on the Clojurians Slack.
  8 | 
  9 | ## Breaking Changes
 10 | 
 11 | 2017-11-23: change in map elisions, now the key is always `#unrepl/... nil` and the value contains the actual elision.
 12 | 
 13 | ## Interaction model
 14 | 
 15 | The client may setup several connections with the server.
 16 | 
 17 | Connections usually starts as plain REPLs and are subsequently upgraded to something else.
 18 | 
 19 | The first connection created is typically meant for user input (and exclusively for user input, it must not be used for commands) and is upgraded by sending a piece of code colloquially referred to as "the blob". Upon successful upgrade the client receives a `:unrepl/hello` message which describes how to set up other connections. This connection is generally called the user connection or the user repl or even just `user`.
 20 | 
 21 | There are two other common types of connections:
 22 |  * repl connections meant for control of the user repls, most often referred to as `aux` or auxiliary/ancillary connections;
 23 |  * sideloader connections meant to allow the client to provide local clojure code, resources and java classes for dynamic loading by the (potentially remote) server.
 24 | 
 25 | ## Spec
 26 | 
 27 | ### Reserved keywords and extensions
 28 | 
 29 | All simple (not qualified) keywords, the `unrepl` namespace, and all namespaces starting by `unrepl.` are reserved.
 30 | 
 31 | This protocol is designed to be extended, extensions just have to be namespaced and designed in a way that a client can ignore messages from unknown extensions.
 32 | 
 33 | ### Streams format
 34 | 
 35 | The input is expected to be free form (a character stream)
 36 | 
 37 | The output is a stream of EDN datastructures.
 38 | 
 39 | To be more precise it's a stream of 2/3-item tuples, e.g. `[:read {:some :payload} 1]`, where:
 40 | 
 41 | 1. First component is a tag (keyword). Its purpose is to allow demultiplexing things that are usually intermingled in a repl display.
 42 | 2. Second component is the payload.
 43 | 3. Third (optional) component is a group id, meant to group together messages.
 44 | 
 45 | Ten core tags are defined: `:unrepl/hello`, `:prompt`, `:read`, `:started-eval`, `:eval`, `:out`, `:err`, `:log`, and `:exception`. More tags are defined in standard [actions](#actions).
 46 | 
 47 | | Tag | Payload |
 48 | |-----|---------|
 49 | |`:unrepl/hello`|A map or nil|
 50 | |`:prompt`|A map or nil|
 51 | |`:read` | A map |
 52 | |`:started-eval`|A map or nil|
 53 | |`:eval`|The evaluation result|
 54 | |`:out`|A string|
 55 | |`:err`|A string|
 56 | |`:log`|A log vector|
 57 | |`:exception`|A map|
 58 | 
 59 | Messages not understood by a client should be ignored.
 60 | 
 61 | #### `:unrepl/hello`
 62 | 
 63 | The first message must be a `:unrepl/hello`. It's the only message whose tag is qualified. It's namespaced to make sniffing the protocol easier. For example, when connecting to a socket you may either get an existing unrepl repl or a standard repl that you are going to upgrade.
 64 | 
 65 | Its payload is a map which may have a `:actions` key mapping to another map of [action ids](#actions) (keywords) to [template messages](#message-templates). All those actions should be specific to the session.
 66 | 
 67 | This is how an unrepl implementation advertises its capabilities: by listing them along a machine-readable specification of the message needed to be sent to trigger them.
 68 | 
 69 | The hello map may also have a `:session` key which is just an identifier (any type) allowing a client to recognize a session it has already visited.
 70 | 
 71 | The hello map may also have a `:about` key mapped to a map. The intent of the `:about` map is to contain information about the REPL implementation, supported language, running environment (VM, OS etc.).
 72 | 
 73 | #### `:prompt`
 74 | 
 75 | `:prompt` messages constitute the main punctuation of the output stream: each `:prompt` is the header of an iteration of the REP loop. There can't be an evaluation without a `:prompt`. `:prompt` messages are the most basic way of synchronizing the client states with the REPL.
 76 | 
 77 | The payload provides general information about the unrepl session, covering two topics:
 78 | 
 79 |  * Information about the current input state.
 80 |  * Qualified symbols (var names) mapped to their respective values.
 81 | 
 82 | e.g.
 83 | 
 84 | ```clj
 85 | [:prompt {:file "unrepl-session", :line 1, :column 1, :offset 0, clojure.core/*warn-on-reflection* nil, clojure.core/*ns* #unrepl/ns user} 42]
 86 | ```
 87 | 
 88 | Where `:offset` is the number of characters (well UTF-16 code units) from the start of the unrepl session. *Line-delimiting sequences are normalized to one character* (`\n`) -- so if the client sends a `CRLF` the offset is only increased by 1.
 89 | 
 90 | The group-id is the one that will be used for the next evaluation, if any.
 91 | 
 92 | It's possible to get iterations with no evaluation (for example after skippable top-level input: comment and whitespace).
 93 | 
 94 | Clients willing to display a user prompt in the way traditionally done by `clojure.main` should only consider `:prompt` message whose `:column` is `1`. 
 95 | 
 96 | #### `:exception`
 97 | 
 98 | The payload is a map with a required key `:ex` which maps to the exception, and a second optional key `:phase` which can take 5 values:
 99 | 
100 |  * `:unknown`, (default) no indication on the source of the exception.
101 |  * `:read`, the exception occured during `read` and is more likely a syntax error. (May be an IO or any exception when `*read-eval*` is used.)
102 |  * `:eval`, the exception occured during `eval`.
103 |  * `:print`, the exception occured during `print`.
104 |  * `:repl`, the exception occured in the repl code itself, fill an issue.
105 | 
106 | #### `:log`
107 | 
108 | ```clj
109 | (spec/def :unrepl/log-msg
110 |   (spec/cat :level keyword? :key string? :inst inst? :args (spec/* any?)))
111 | ```
112 | 
113 | The arguments will be machine-printed and as such could be elided.
114 | 
115 | #### `:read`
116 | 
117 | Similar to `:prompt`, `:read` is meant to help tools to relate outputs to inputs by providing information regarding the latest stream sent to the reader. It can be especially useful when several forms are sent in a batch or when syntax errors happen and the reader resumes reading.
118 | 
119 | ```clj
120 | [:read {:from [line col] :to [line col] :offset N :len N} 1]
121 | ```
122 | 
123 | `:offset` works exactly as in `:prompt`.
124 | 
125 | ### Machine printing
126 | Pretty printing is meant for humans and should be performed on the client.
127 | 
128 | Clojure values are machine-printed to EDN.
129 | 
130 | #### Filling the gap
131 | 
132 |  * Vars (e.g. `#'map`) are printed as `#clojure/var clojure.core/map`.
133 |  * Ratios (e.g. `4/3`) are printed as `#unrepl/ratio [4 3]`.
134 |  * Classes are printed as `#unrepl.java/class ClassName` or `#unrepl.java/class [ClassName]` for arrays (with no bounds on the nesting).
135 |  * Namespaces are printed as `#unrepl/ns name.sp.ace`.
136 |  * Metadata is printed as `#unrepl/meta [{meta data} value]`.
137 |  * Patterns (regexes) are printed as `#unrepl/pattern "[0-9]+"`.
138 |  * Objects are printed as `#unrepl/object [class "id" representation]`. The representation is implementation dependent. One may use an elided map representation to allow browsing the object graph.
139 |  * Unreadable keywords and symbols are printed as `#unrepl/bad-keyword ["ns-or-nil" "name"]"` (resp. `unrepl/bad-symbol`).
140 | 
141 | #### Ellipsis or elisions
142 | 
143 | Printing should be bound in length and depth. When the printer decides to elide a sequence of values, it should emit a tagged literal `#unrepl/... m`, where `m` is either `nil` or a map. This map may contain a `:get` key associated to a [template message](#message-templates). All simple (non qualified) keywords (and those with `unrepl` namespace) are reserved for future revisions of these specification.
144 | 
145 | Example: machine printing `(range)`
146 | 
147 | ```clj
148 | (0 1 2 3 4 5 6 7 8 9 #unrepl/... {:get (tmp1234/get :G__8391)})
149 | ```
150 | 
151 | ##### Rendering
152 | Clients may render a `#unrepl/... {}` literal as `...` and when `:get` is present offers the user the ability to expand this elision.
153 | 
154 | ##### Expansion
155 | To expand the elision the client send to the repl the value associated to the `:get` key. The repl answers (in the `:eval` channel)  with either:
156 | 
157 |  * a collection that should be spliced in lieu of the `...`
158 |  * a `#unrepl/...` value with no `:get` key (for example when the elided values are not reachable anymore), including (but not limited to) `#unrepl/... nil`.
159 | 
160 | So continuing the `(range)` example:
161 | 
162 | ```clj
163 | > (range)
164 | < (0 1 2 3 4 5 6 7 8 9 #unrepl/... {:get (tmp1234/get :G__8391)})
165 | > (tmp1234/get :G__8391)
166 | < (10 11 12 13 14 15 16 17 18 19 #unrepl/... {:get (tmp1234/get :G__8404)})
167 | ```
168 | 
169 | ##### Long strings
170 | Strings too long should be cut off by the printer. In which case `#unrepl/string [prefix #unrepl/... m]` is emitted with prefix being an actual prefix of the cut off repl with the following restriction: the cut can't occur in the middle of a surrogate pair; this restriction only holds for well-formed strings.
171 | 
172 | ##### Caveats
173 | ###### Position
174 | The elision should always be at the end of the collection.
175 | 
176 | ###### Padding maps
177 | Elided maps representations must still have an even number of entries, so a second elision marker `#unrepl/... nil` is added *as key* to pad the representation. All data (if any) is supported by the elision in value position. When splicing the expansion both markers are replaced.
178 | 
179 | ###### Identity and value
180 | These maps may also have an `:id` key to keep elided values different when used in sets or as keys in maps. So either each elision get a unique id or the id may be value-based (that is: when two elisions ids are equal, their elided values are equal). When `:get` is provided there's no need for `:id` (because by definition the `:get` value will be unique or at least value-based).
181 | 
182 | Example: printing the set `#{[1] [2]}` with a very shallow print depth and a (broken) printer that doesn't assign `:id` nor `:get` returns:
183 | 
184 | ```clj
185 | #{[#unrepl/... nil] [#unrepl/... nil]}
186 | ```
187 | 
188 | which is not readable. Hence the necessity of `:id` or `:get` to provide unique ids.
189 | 
190 | #### Lazy-seq errors
191 | 
192 | When realization of a lazy sequence throws an exception, the exception is inlined in the sequence representation and tagged with `unrepl/lazy-error`.
193 | 
194 | For example, the value of `(map #(/ %) (iterate dec 3))` prints as:
195 | 
196 | ```clj
197 | (#unrepl/ratio [1 3] #unrepl/ratio [1 2] 1 #unrepl/lazy-error #error {:cause "Divide by zero", :via [{:type #unrepl.java/class java.lang.ArithmeticException, :message "Divide by zero", :at #unrepl/object [#unrepl.java/class java.lang.StackTraceElement "0x272298a" "clojure.lang.Numbers.divide(Numbers.java:158)"]}], :trace [#unrepl/... nil]})
198 | ```
199 | 
200 | #### MIME Attachments
201 | 
202 | Some values may print to `#unrepl/mime m` where m is a map with keys:
203 | 
204 | - `:content-type`: optional, string, defaults to "application/octet-stream".
205 | - `:content-length`: optional, number.
206 | - `:filename`: optional, string.
207 | - `:details`: optional, anything, a representation of the object (e.g. for a `java.io.File` instance it could be the path and the class).
208 | - `:content` optional base64-encoded string (e.g. `#unrepl/base64 "..."`), or an elision.
209 | 
210 | ### Message Templates
211 | 
212 | A message template is an executable description of the expected message. It's a parametrized edn form: all keywords tagged by `#unrepl/param` are to be substituted by their value. The resulting form is serialized as edn and sent to a repl.
213 | 
214 | ### Actions
215 | 
216 | All actions are optional.
217 | 
218 | #### Session actions
219 | 
220 | (Advertised in `:unrepl/hello` messages.)
221 | 
222 | ##### `:set-source`
223 | 
224 | Three parameters: 
225 | 
226 | ```clj
227 | (spec/def :unrepl/filename string?)
228 | (spec/def :unrepl/line integer?)
229 | (spec/def :unrepl/column integer?)
230 | ```
231 | 
232 | Sets the filename, line and column numbers for subsequent evaluations. The change will take effect at next prompt display.
233 | 
234 | ##### `:print-limits`
235 | 
236 | Set print limits (pass `nil` to leave a limit unchanged). Returns a map of param names to original values.
237 | 
238 | ##### `:start-aux`
239 | 
240 | Upgrades another connection as an auxilliary (for tooling purpose) unREPL session.
241 | 
242 | ##### `:unrepl.jvm/start-side-loader`
243 | 
244 | Upgrades the plain repl connection where it is issued to a sideloading session.
245 | 
246 | When a sideloading session is started, the JVM will ask the client for classes or resources it does not have. Basically, this allows the extension of the classpath.
247 | 
248 | A sideloading session is a very simple edn-protocol.
249 | 
250 | It's a sequence of request/responses initiated by the server: the client waits for messages `[:resource "resource/name"]` or `[:class "some.class.name"]` and replies either `nil` or a base64-encoded string representation of the file.
251 | 
252 | The only way to terminate a sideloading session is to close the connection.
253 | 
254 | ##### `:log-eval` and `:log-all`
255 | 
256 | No parameters.
257 | 
258 | `:log-eval` returns a function of one argument (`msg` conforming to `:unrepl/log-msg`) that will print `[:log msg group-id]` only when called (directly or not) from evaluated code.
259 | 
260 | `:log-all` returns a function of one argument (`msg` conforming to `:unrepl/log-msg`) that will print `[:log msg nil]`.
261 | 
262 | Client software should use these values to hook up appenders for the user log facilities. For example, assuming `Timbre` as the logging library and a value of `(clojure.core/some-> :session329  unrepl.repl/session :log-eval)]` for `:log-eval` then the client can send this form to the `aux` repl:
263 | 
264 | ```clj
265 | (let [w (clojure.core/some-> :session329  unrepl.repl/session :log-eval)]
266 |   (timbre/merge-config!
267 |     {:appenders
268 |      {:println {:enabled? false} ; disabled because it tries to force print lazyseqs
269 |       :unrepl
270 |       {:enabled? true
271 |        :fn (fn [{:keys [level instant ?ns-str vargs]}]
272 |              (w (into [level ?ns-str instant] vargs)))}}}))
273 | ```
274 | 
275 | (Namespaces have been omitted or aliased, however this form should be built using syntax-quote to ensure proper qualification of symbols.)
276 | 
277 | Once the above expression evaluated, we have the following interactions:
278 | 
279 | ```clj
280 | (timbre/log :info "a" (range))
281 | [:read {:from [14 1], :to [15 1], :offset 342, :len 31} 12]
282 | [:started-eval {:actions {:interrupt (unrepl.repl/interrupt! :session329 12), :background (unrepl.repl/background! :session329 12)}} 12]
283 | [:log [:info "user" #inst "2017-04-04T14:56:56.574-00:00" "a" (0 1 2 3 4 5 6 7 8 9 #unrepl/... {:get (unrepl.repl/fetch :G__3948)})] 12]
284 | [:eval nil 12]
285 | ```
286 | 
287 | Hence a client UI can render log messages as navigable.
288 | 
289 | #### Eval actions
290 | (Advertised in `:started-eval` messages.)
291 | 
292 | ##### `:interrupt`
293 | 
294 | No parameter. Aborts the current running evaluation. Upon success a `[:interrupted nil id]` message is written (where `id` is the group id (if any) of the current evaluation).
295 | 
296 | ##### `:background`
297 | 
298 | No parameter. Transforms the current running evaluation in a Future. Upon success returns true (on `aux`) and the evaluation (on `user`) immediatly returns `[:eval a-future id]`.
299 | 
300 | Upon completion of the future a `[:bg-eval value id]` is sent (on the main repl).
301 | 
302 | ## License
303 | 
304 | Copyright © 2017 Christophe Grand
305 | 
306 | Distributed under the Eclipse Public License either version 1.0 or (at
307 | your option) any later version.
308 | 


--------------------------------------------------------------------------------
/src/unrepl/printer.clj:
--------------------------------------------------------------------------------
  1 | (ns unrepl.printer
  2 |   (:require [clojure.string :as str]
  3 |             [clojure.edn :as edn]
  4 |             [clojure.main :as main]
  5 |             [unrepl.core :as unrepl]))
  6 | 
  7 | (def ^:dynamic *print-budget*)
  8 | (def ^:dynamic *elide*
  9 |   "Function of 1 argument which returns the elision."
 10 |   (constantly nil))
 11 | 
 12 | (def defaults {#'*print-length* 10
 13 |                #'*print-level* 8
 14 |                #'unrepl/*string-length* 72})
 15 | 
 16 | (defn- bump [n m]
 17 |   (if (< n (- Long/MAX_VALUE m))
 18 |     (+ n m)
 19 |     Long/MAX_VALUE))
 20 | 
 21 | (defn ensure-defaults [bindings]
 22 |   (let [bindings (merge-with #(or %1 %2) bindings defaults)]
 23 |     (assoc bindings #'*print-budget*
 24 |       (long (min (* 1N (bindings #'*print-level*) (bindings #'*print-length*)) Long/MAX_VALUE)))))
 25 | 
 26 | (defprotocol MachinePrintable
 27 |   (-print-on [x write rem-depth]))
 28 | 
 29 | ;; clojure 1.10 support
 30 | (defn- really-satisfies? [protocol x]
 31 |   (when (class x)
 32 |     (let [default (get (:impls protocol) Object)
 33 |           impl (find-protocol-impl protocol x)]
 34 |       (not (identical? impl default)))))
 35 | 
 36 | (def ^:private datafiable?
 37 |   (if-some [Datafiable (some-> 'clojure.core.protocols/Datafiable resolve)]
 38 |     #(or (get (meta %) 'clojure.core.protocols/datafy) (really-satisfies? (deref Datafiable) %))
 39 |     (constantly false)))
 40 | 
 41 | (def ^:private datafy
 42 |   (or (some-> 'clojure.core.protocols/datafy resolve deref)
 43 |       (clojure.lang.Var$Unbound. #'datafy)))
 44 | 
 45 | (def ^:private navigable?
 46 |   (if-some [Navigable (some-> 'clojure.core.protocols/Navigable resolve)]
 47 |     #(or (get (meta %) 'clojure.core.protocols/nav) (really-satisfies? (deref Navigable) %))
 48 |     (constantly false)))
 49 | 
 50 | (def ^:private nav
 51 |   (or (some-> 'clojure.core.protocols/nav resolve deref)
 52 |       (clojure.lang.Var$Unbound. #'nav)))
 53 | 
 54 | (when (bound? #'datafy)
 55 |   (require 'clojure.datafy))
 56 | 
 57 | (defn- browsify
 58 |   "only for datafiables"
 59 |   [x]
 60 |   (let [d (datafy x)]
 61 |     (if (and (navigable? x) (or (map? d) (vector? d)))
 62 |       (reduce-kv (fn [d k v] (assoc d k (tagged-literal 'unrepl/browsable [v #(nav x k v)]))) d d)
 63 |       d)))
 64 | ;; end of 1.10
 65 | 
 66 | (defn print-on
 67 |   [write x rem-depth]
 68 |   (let [rem-depth (dec rem-depth)
 69 |         budget (set! *print-budget* (dec *print-budget*))]
 70 |     (if (and (or (neg? rem-depth) (neg? budget)) (pos? (or *print-length* 1)))
 71 |       ; the (pos? (or *print-length* 1)) is here to prevent stack overflows
 72 |       (binding [*print-length* 0]
 73 |         (print-on write x 0))
 74 | 
 75 |       (do
 76 |         (when (datafiable? x)
 77 |           (write "#unrepl/browsable ["))
 78 |         (when (and *print-meta* (meta x))
 79 |           (write "#unrepl/meta [")
 80 |           (-print-on (meta x) write rem-depth)
 81 |           (write " "))
 82 |         (-print-on x write rem-depth)
 83 |         (when (and *print-meta* (meta x))
 84 |           (write "]"))
 85 |         (when (datafiable? x)
 86 |           (write " ")
 87 |           (set! *print-budget* (bump *print-budget* 1))
 88 |           (print-on write (tagged-literal 'unrepl/... (*elide* (lazy-seq [(list (browsify x))]))) (inc rem-depth))
 89 |           (write "]"))))))
 90 | 
 91 | (defn base64-encode [^java.io.InputStream in]
 92 |   (let [table "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
 93 |         sb (StringBuilder.)]
 94 |     (loop [shift 4 buf 0]
 95 |       (let [got (.read in)]
 96 |         (if (neg? got)
 97 |           (do
 98 |             (when-not (= shift 4)
 99 |               (let [n (bit-and (bit-shift-right buf 6) 63)]
100 |                 (.append sb (.charAt table n))))
101 |             (cond
102 |               (= shift 2) (.append sb "==")
103 |               (= shift 0) (.append sb \=))
104 |             (str sb))
105 |           (let [buf (bit-or buf (bit-shift-left got shift))
106 |                 n (bit-and (bit-shift-right buf 6) 63)]
107 |             (.append sb (.charAt table n))
108 |             (let [shift (- shift 2)]
109 |               (if (neg? shift)
110 |                 (do
111 |                   (.append sb (.charAt table (bit-and buf 63)))
112 |                   (recur 4 0))
113 |                 (recur shift (bit-shift-left buf 6))))))))))
114 | 
115 | (defn base64-decode [^String s]
116 |   (let [table "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
117 |         in (java.io.StringReader. s)
118 |         bos (java.io.ByteArrayOutputStream.)]
119 |     (loop [bits 0 buf 0]
120 |       (let [got (.read in)]
121 |         (when-not (or (neg? got) (= 61 #_\= got))
122 |           (let [buf (bit-or (.indexOf table got) (bit-shift-left buf 6))
123 |                 bits (+ bits 6)]
124 |             (if (<= 8 bits)
125 |               (let [bits (- bits 8)]
126 |                 (.write bos (bit-shift-right buf bits))
127 |                 (recur bits (bit-and 63 buf)))
128 |               (recur bits buf))))))
129 |     (.toByteArray bos)))
130 | 
131 | (def ^:dynamic *max-colls* 100) ; TODO
132 | 
133 | (def ^:dynamic *realize-on-print*
134 |   "Set to false to avoid realizing lazy sequences."
135 |   true)
136 | 
137 | (defmacro ^:private blame-seq [& body]
138 |   `(try (seq ~@body)
139 |         (catch Throwable t#
140 |           (list (tagged-literal 'unrepl/lazy-error t#)))))
141 | 
142 | (defn- may-print? [s]
143 |   (or *realize-on-print* (not (instance? clojure.lang.IPending s)) (realized? s)))
144 | 
145 | (declare ->ElidedKVs)
146 | 
147 | (defn- print-kvs
148 |   [write kvs rem-depth]
149 |   (let [print-length *print-length*]
150 |     (loop [kvs kvs i 0]
151 |       (if (and (< i print-length) (pos? *print-budget*))
152 |         (when-some [[[k v] & kvs] (seq kvs)]
153 |           (when (pos? i) (write ", "))
154 |           (print-on write k rem-depth)
155 |           (write " ")
156 |           (print-on write v rem-depth)
157 |           (recur kvs (inc i)))
158 |         (when (seq kvs)
159 |           (when (pos? i) (write ", "))
160 |           (write "#unrepl/... nil ")
161 |           (print-on write (tagged-literal 'unrepl/... (*elide* (->ElidedKVs kvs))) rem-depth))))))
162 | 
163 | (defn- print-vs
164 |   [write vs rem-depth]
165 |   (let [print-length *print-length*]
166 |     (loop [vs vs i 0]
167 |       (when-some [[v :as vs] (blame-seq vs)]
168 |         (when (pos? i) (write " "))
169 |         (if (and (< i print-length) (pos? *print-budget*) (may-print? vs))
170 |           (if (and (tagged-literal? v) (= (:tag v) 'unrepl/lazy-error))
171 |             (print-on write v rem-depth)
172 |             (do
173 |               (print-on write v rem-depth)
174 |               (recur (rest vs) (inc i))))
175 |           (print-on write (tagged-literal 'unrepl/... (*elide* vs)) rem-depth))))))
176 | 
177 | (defrecord WithBindings [bindings x]
178 |   MachinePrintable
179 |   (-print-on [_ write rem-depth]
180 |     (with-bindings (ensure-defaults bindings)
181 |       (-print-on x write *print-level*))))
182 | 
183 | (defrecord ElidedKVs [s]
184 |   MachinePrintable
185 |   (-print-on [_ write rem-depth]
186 |     (write "{")
187 |     (print-kvs write s rem-depth)
188 |     (write "}")))
189 | 
190 | (def atomic? (some-fn nil? true? false? char? string? symbol? keyword? #(and (number? %) (not (ratio? %)))))
191 | 
192 | (defn- roundtrippable? [x]
193 |   (try
194 |     (= x (-> x pr-str read-string))
195 |     (catch Exception e
196 |       false)))
197 | 
198 | (defn- as-str
199 |   "Like pr-str but escapes all ASCII control chars."
200 |   [x]
201 |   ;hacky
202 |   (cond
203 |     (string? x) (str/replace (pr-str x) #"\p{Cntrl}"
204 |                              #(format "\\u%04x" (int (.charAt ^String % 0))))
205 |     (char? x) (str/replace (pr-str x) #"\p{Cntrl}"
206 |                            #(format "u%04x" (int (.charAt ^String % 0))))
207 |     (and (or (symbol? x) (keyword? x)) (not (roundtrippable? x)))
208 |     (str (if (keyword? x) "#unrepl/bad-keyword [" "#unrepl/bad-symbol [")
209 |          (as-str (namespace x)) " " (as-str (name x)) "]") ; as-str in case they are really really bad
210 |     :else (pr-str x)))
211 | 
212 | (defmacro ^:private latent-fn [& fn-body]
213 |   `(let [d# (delay (binding [*ns* (find-ns '~(ns-name *ns*))] (eval '(fn ~@fn-body))))]
214 |      (fn
215 |        ([] (@d#))
216 |        ([x#] (@d# x#))
217 |        ([x# & xs#] (apply @d# x# xs#)))))
218 | 
219 | (defrecord MimeContent [mk-in]
220 |   MachinePrintable
221 |   (-print-on [_ write rem-depth]
222 |     (with-open [in (mk-in)]
223 |       (write "#unrepl/base64 \"")
224 |       (write (base64-encode in))
225 |       (write "\""))))
226 | 
227 | (defn- mime-content [mk-in]
228 |   (when-some [e (*elide* (MimeContent. mk-in))]
229 |     {:content (tagged-literal 'unrepl/... e)}))
230 | 
231 | (def ^:dynamic *object-representations*
232 |   "map of classes to functions returning their representation component (3rd item in #unrepl/object [class id rep])"
233 |   {clojure.lang.IDeref
234 |    (fn [x]
235 |      (let [pending? (and (instance? clojure.lang.IPending x) ; borrowed from https://github.com/brandonbloom/fipp/blob/8df75707e355c1a8eae5511b7d73c1b782f57293/src/fipp/ednize.clj#L37-L51
236 |                          (not (.isRealized ^clojure.lang.IPending x)))
237 |            [ex val] (when-not pending?
238 |                       (try [false @x]
239 |                            (catch Throwable e
240 |                              [true e])))
241 |            failed? (or ex (and (instance? clojure.lang.Agent x)
242 |                                (agent-error x)))
243 |            status (cond
244 |                     failed? :failed
245 |                     pending? :pending
246 |                     :else :ready)]
247 |        {:unrepl.ref/status status :unrepl.ref/val val}))
248 | 
249 |    clojure.lang.AFn
250 |    (fn [x]
251 |      (-> x class .getName main/demunge))
252 | 
253 |    java.io.File (fn [^java.io.File f]
254 |                   (into {:path (.getPath f)}
255 |                         (when (.isFile f)
256 |                           {:attachment (tagged-literal 'unrepl/mime
257 |                                                        (into {:content-type "application/octet-stream"
258 |                                                               :content-length (.length f)}
259 |                                                              (mime-content #(java.io.FileInputStream. f))))})))
260 | 
261 |    java.awt.Image (latent-fn [^java.awt.Image img]
262 |                              (let [w (.getWidth img nil)
263 |                                    h (.getHeight img nil)]
264 |                                (into {:width w, :height h}
265 |                                      {:attachment
266 |                                       (tagged-literal 'unrepl/mime
267 |                                                       (into {:content-type "image/png"}
268 |                                                             (mime-content #(let [bos (java.io.ByteArrayOutputStream.)]
269 |                                                                              (when (javax.imageio.ImageIO/write
270 |                                                                                     (doto (java.awt.image.BufferedImage. w h java.awt.image.BufferedImage/TYPE_INT_ARGB)
271 |                                                                                       (-> .getGraphics (.drawImage img 0 0 nil)))
272 |                                                                                     "png" bos)
273 |                                                                                (java.io.ByteArrayInputStream. (.toByteArray bos)))))))})))
274 | 
275 |    Object (fn [x]
276 |             (if (-> x class .isArray)
277 |               (seq x)
278 |               (str x)))})
279 | 
280 | (defn- object-representation [x]
281 |   (reduce-kv (fn [_ class f]
282 |                (when (instance? class x) (reduced (f x)))) nil *object-representations*)) ; todo : cache
283 | 
284 | (defn- class-form [^Class x]
285 |   (if (.isArray x) [(-> x .getComponentType class-form)] (symbol (.getName x))))
286 | 
287 | (def unreachable (tagged-literal 'unrepl/... nil))
288 | 
289 | (defn- print-tag-lit-on [write tag form rem-depth]
290 |   (write (str "#" tag " "))
291 |   (print-on write form rem-depth))
292 | 
293 | (defn- sat-inc [n]
294 |   (if (= Long/MAX_VALUE n)
295 |     n
296 |     (unchecked-inc n)))
297 | 
298 | (defn- print-trusted-tag-lit-on [write tag form rem-depth]
299 |   (print-tag-lit-on write tag form (sat-inc rem-depth)))
300 | 
301 | ;; --
302 | ;; Throwable->map backport from Clojure 1.9
303 | ;;
304 | ;; The behavior of clojure.core/Throwable->map changed from 1.8 to 1.9.
305 | ;; We need the (more correct) behavior in 1.9.
306 | ;;
307 | ;; https://github.com/clojure/clojure/blob/master/changes.md#33-other-fixes
308 | 
309 | (defn StackTraceElement->vec'
310 |   "Constructs a data representation for a StackTraceElement"
311 |   {:added "1.9"}
312 |   [^StackTraceElement o]
313 |   [(symbol (.getClassName o)) (symbol (.getMethodName o)) (.getFileName o) (.getLineNumber o)])
314 | 
315 | (defn Throwable->map'
316 |   "Constructs a data representation for a Throwable."
317 |   {:added "1.7"}
318 |   [^Throwable o]
319 |   (let [base (fn [^Throwable t]
320 |                (merge {:type (symbol (.getName (class t)))
321 |                        :message (.getLocalizedMessage t)}
322 |                       (when-let [ed (ex-data t)]
323 |                         {:data ed})
324 |                       (let [st (.getStackTrace t)]
325 |                         (when (pos? (alength st))
326 |                           {:at (StackTraceElement->vec' (aget st 0))}))))
327 |         via (loop [via [], ^Throwable t o]
328 |               (if t
329 |                 (recur (conj via t) (.getCause t))
330 |                 via))
331 |         ^Throwable root (peek via)
332 |         m {:cause (.getLocalizedMessage root)
333 |            :via (vec (map base via))
334 |            :trace (vec (map StackTraceElement->vec'
335 |                             (.getStackTrace ^Throwable (or root o))))}
336 |         data (ex-data root)]
337 |     (if data
338 |       (assoc m :data data)
339 |       m)))
340 | 
341 | ;; use standard implementation if running in Clojure 1.9 or above,
342 | ;; backported version otherwise
343 | 
344 | (def Throwable->map''
345 |   (if (neg? (compare (mapv *clojure-version* [:major :minor]) [1 9]))
346 |     Throwable->map'
347 |     Throwable->map))
348 | 
349 | ;; --
350 | 
351 | 
352 | (extend-protocol MachinePrintable
353 |   clojure.lang.TaggedLiteral
354 |   (-print-on [x write rem-depth]
355 |     (case (:tag x)
356 |       unrepl/... (binding ; don't elide the elision
357 |                   [*print-length* Long/MAX_VALUE
358 |                    *print-level* Long/MAX_VALUE
359 |                    *print-budget* Long/MAX_VALUE
360 |                    unrepl/*string-length* Long/MAX_VALUE]
361 |                    (write (str "#" (:tag x) " "))
362 |                    (print-on write (:form x) Long/MAX_VALUE))
363 |       unrepl/browsable (let [[v thunk] (:form x)
364 |                              rem-depth (inc rem-depth)]
365 |                          (set! *print-budget* (bump *print-budget* 2))
366 |                          (write (str "#" (:tag x) " ["))
367 |                          (print-on write v rem-depth)
368 |                          (write " ")
369 |                          (print-on write (tagged-literal 'unrepl/... (*elide* (lazy-seq [(thunk)]))) rem-depth)
370 |                          (write "]"))
371 |       (print-tag-lit-on write (:tag x) (:form x) rem-depth)))
372 | 
373 |   clojure.lang.Ratio
374 |   (-print-on [x write rem-depth]
375 |     (print-trusted-tag-lit-on write "unrepl/ratio"
376 |                               [(.numerator x) (.denominator x)] rem-depth))
377 | 
378 |   clojure.lang.Var
379 |   (-print-on [x write rem-depth]
380 |     (print-tag-lit-on write "clojure/var"
381 |                       (when-some [ns (:ns (meta x))] ; nil when local var
382 |                         (symbol (name (ns-name ns)) (name (:name (meta x)))))
383 |                       rem-depth))
384 | 
385 |   Throwable
386 |   (-print-on [t write rem-depth]
387 |     (print-tag-lit-on write "error" (Throwable->map'' t) rem-depth))
388 | 
389 |   Class
390 |   (-print-on [x write rem-depth]
391 |     (print-tag-lit-on write "unrepl.java/class" (class-form x) rem-depth))
392 | 
393 |   java.util.Date (-print-on [x write rem-depth] (write (pr-str x)))
394 |   java.util.Calendar (-print-on [x write rem-depth] (write (pr-str x)))
395 |   java.sql.Timestamp (-print-on [x write rem-depth] (write (pr-str x)))
396 |   clojure.lang.Namespace
397 |   (-print-on [x write rem-depth]
398 |     (print-tag-lit-on write "unrepl/ns" (ns-name x) rem-depth))
399 |   java.util.regex.Pattern
400 |   (-print-on [x write rem-depth]
401 |     (print-tag-lit-on write "unrepl/pattern" (str x) rem-depth))
402 |   String
403 |   (-print-on [x write rem-depth]
404 |     (if (<= (count x) unrepl/*string-length*)
405 |       (write (as-str x))
406 |       (let [i (if (and (Character/isHighSurrogate (.charAt ^String x (dec unrepl/*string-length*)))
407 |                        (Character/isLowSurrogate (.charAt ^String x unrepl/*string-length*)))
408 |                 (inc unrepl/*string-length*) unrepl/*string-length*)
409 |             prefix (subs x 0 i)
410 |             rest (subs x i)]
411 |         (if (= rest "")
412 |           (write (as-str x))
413 |           (do
414 |             (write "#unrepl/string [")
415 |             (write (as-str prefix))
416 |             (write " ")
417 |             (print-on write (tagged-literal 'unrepl/... (*elide* rest)) rem-depth)
418 |             (write "]")))))))
419 | 
420 | (defn- print-coll [open close write x rem-depth]
421 |   (write open)
422 |   (print-vs write x rem-depth)
423 |   (write close))
424 | 
425 | (extend-protocol MachinePrintable
426 |   nil
427 |   (-print-on [_ write _] (write "nil"))
428 |   Object
429 |   (-print-on [x write rem-depth]
430 |     (cond
431 |       (atomic? x) (write (as-str x))
432 |       (map? x)
433 |       (do
434 |         (when (record? x)
435 |           (write "#") (write (.getName (class x))) (write " "))
436 |         (write "{")
437 |         (print-kvs write x rem-depth)
438 |         (write "}"))
439 |       (vector? x) (print-coll "[" "]" write x rem-depth)
440 |       (seq? x) (print-coll "(" ")" write x rem-depth)
441 |       (set? x) (print-coll "#{" "}" write x rem-depth)
442 |       :else
443 |       (print-trusted-tag-lit-on write "unrepl/object"
444 |                                 [(class x) (format "0x%x" (System/identityHashCode x)) (object-representation x)
445 |                                  {:bean {unreachable (tagged-literal 'unrepl/... (*elide* (ElidedKVs. (bean x))))}}]
446 |                                 (sat-inc rem-depth))))) ; is very trusted
447 | 
448 | (defn edn-str [x]
449 |   (let [out (java.io.StringWriter.)
450 |         write (fn [^String s] (.write out s))
451 |         bindings (select-keys (get-thread-bindings) [#'*print-length* #'*print-level* #'unrepl/*string-length*])]
452 |     (with-bindings (into (ensure-defaults bindings) {#'*print-readably* true})
453 |       (print-on write x *print-level*))
454 |     (str out)))
455 | 
456 | (defn full-edn-str [x]
457 |   (binding [*print-length* Long/MAX_VALUE
458 |             *print-level* Long/MAX_VALUE
459 |             unrepl/*string-length* Integer/MAX_VALUE]
460 |     (edn-str x)))
461 | 


--------------------------------------------------------------------------------
/src/unrepl/repl.clj:
--------------------------------------------------------------------------------
  1 | (ns unrepl.repl
  2 |   (:require [clojure.main :as m]
  3 |             [unrepl.core :as unrepl]
  4 |             [unrepl.printer :as p]
  5 |             [clojure.edn :as edn]
  6 |             [clojure.java.io :as io]))
  7 | 
  8 | (defn classloader
  9 |   "Creates a classloader that obey standard delegating policy.
 10 |    Takes two arguments: a parent classloader and a function which
 11 |    takes a keyword (:resource or :class) and a string (a resource or a class name) and returns an array of bytes
 12 |    or nil."
 13 |   [parent f]
 14 |   (proxy [clojure.lang.DynamicClassLoader] [parent]
 15 |     (findResource [name]
 16 |       (when-some  [bytes (f :resource name)]
 17 |         (let [file (doto (java.io.File/createTempFile "unrepl-sideload-" (str "-" (re-find #"[^/]*$" name)))
 18 |                      .deleteOnExit)]
 19 |           (io/copy bytes file)
 20 |           (-> file .toURI .toURL))))
 21 |     (findClass [name]
 22 |       (if-some  [bytes (f :class name)]
 23 |         (.defineClass ^clojure.lang.DynamicClassLoader this name bytes nil)
 24 |         (throw (ClassNotFoundException. name))))))
 25 | 
 26 | (defn ^java.io.Writer tagging-writer
 27 |   ([write]
 28 |    (proxy [java.io.Writer] []
 29 |      (close []) ; do not cascade
 30 |      (flush []) ; atomic always flush
 31 |      (write
 32 |        ([x]
 33 |         (write (cond
 34 |                  (string? x) x
 35 |                  (integer? x) (str (char x))
 36 |                  :else (String. ^chars x))))
 37 |        ([string-or-chars off len]
 38 |         (when (pos? len)
 39 |           (write (subs (if (string? string-or-chars) string-or-chars (String. ^chars string-or-chars))
 40 |                        off (+ off len))))))))
 41 |   ([tag write]
 42 |    (tagging-writer (fn [s] (write [tag s]))))
 43 |   ([tag group-id write]
 44 |    (tagging-writer (fn [s] (write [tag s group-id])))))
 45 | 
 46 | (defn blame-ex [phase ex]
 47 |   (if (::phase (ex-data ex))
 48 |     ex
 49 |     (ex-info (str "Exception during " (name phase) " phase.")
 50 |              {::ex ex ::phase phase} ex)))
 51 | 
 52 | (defmacro blame [phase & body]
 53 |   `(try ~@body
 54 |         (catch Throwable t#
 55 |           (throw (blame-ex ~phase t#)))))
 56 | 
 57 | (defn atomic-write [^java.io.Writer w]
 58 |   (fn [x]
 59 |     (if (and (vector? x) (= (count x) 3))
 60 |       (let [[tag payload id] x
 61 |             s (blame :print (str "[" (p/edn-str tag)
 62 |                               " " (p/edn-str payload)
 63 |                               " " (p/edn-str id) "]"))] ; was pr-str, must occur outside of the locking form to avoid deadlocks
 64 |         (locking w
 65 |           (.write w s)
 66 |           (.write w "\n")
 67 |           (.flush w)))
 68 |       (let [s (blame :print (p/edn-str x))] ; was pr-str, must occur outside of the locking form to avoid deadlocks
 69 |         (locking w
 70 |           (.write w s)
 71 |           (.write w "\n")
 72 |           (.flush w))))))
 73 | 
 74 | (definterface ILocatedReader
 75 |   (setCoords [coords-map]))
 76 | 
 77 | (defn unrepl-reader [^java.io.Reader r]
 78 |   (let [offset (atom 0)
 79 |         last-reset (volatile! {:col-off 0 :line 0 :file (str (gensym "unrepl-reader-"))})
 80 |         offset! #(swap! offset + %)]
 81 |     (proxy [clojure.lang.LineNumberingPushbackReader clojure.lang.ILookup ILocatedReader] [r]
 82 |       (getColumnNumber []
 83 |         (let [{:keys [line col-off]} @last-reset
 84 |               off (if (= (.getLineNumber this) line) col-off 0)]
 85 |           (+ off (proxy-super getColumnNumber))))
 86 |       (setCoords [{:keys [line col name]}]
 87 |         (locking this
 88 |           (when line (.setLineNumber this line))
 89 |           (let [line (.getLineNumber this)
 90 |                 col-off (if col (- col (.getColumnNumber this)) 0)
 91 |                 name (or name (:file @last-reset))]
 92 |             (vreset! last-reset {:line line :col-off col-off :file name})))
 93 |         (:coords this))
 94 |       (valAt
 95 |         ([k] (get this k nil))
 96 |         ([k not-found] (case k
 97 |                          :offset @offset
 98 |                          :coords {:offset @offset
 99 |                                   :line (.getLineNumber this)
100 |                                   :col (.getColumnNumber this)
101 |                                   :file (:file @last-reset)}
102 |                          not-found)))
103 |       (read
104 |         ([]
105 |          (let [c (proxy-super read)]
106 |            (when-not (neg? c) (offset! 1))
107 |            c))
108 |         ([cbuf]
109 |          (let [n (proxy-super read cbuf)]
110 |            (when (pos? n) (offset! n))
111 |            n))
112 |         ([cbuf off len]
113 |          (let [n (proxy-super read cbuf off len)]
114 |            (when (pos? n) (offset! n))
115 |            n)))
116 |       (unread
117 |         ([c-or-cbuf]
118 |          (if (integer? c-or-cbuf)
119 |            (when-not (neg? c-or-cbuf) (offset! -1))
120 |            (offset! (- (alength c-or-cbuf))))
121 |          (proxy-super unread c-or-cbuf))
122 |         ([cbuf off len]
123 |          (offset! (- len))
124 |          (proxy-super unread cbuf off len)))
125 |       (skip [n]
126 |         (let [n (proxy-super skip n)]
127 |           (offset! n)
128 |           n))
129 |       (readLine []
130 |         (when-some [s (proxy-super readLine)]
131 |           (offset! (count s))
132 |           s)))))
133 | 
134 | (defn ensure-unrepl-reader 
135 |   ([rdr]
136 |     (if (instance? ILocatedReader rdr)
137 |       rdr
138 |       (unrepl-reader rdr)))
139 |   ([rdr name]
140 |     (if (instance? ILocatedReader rdr)
141 |       rdr
142 |       (doto (unrepl-reader rdr)
143 |         (.setCoords {:file name})))))
144 | 
145 | (defn soft-store [make-action]
146 |   (let [ids-to-session+refs (atom {})
147 |         refs-to-ids (atom {})
148 |         refq (java.lang.ref.ReferenceQueue.)
149 |         NULL (Object.)]
150 |     (.start (Thread. (fn []
151 |                        (let [ref (.remove refq)]
152 |                          (let [id (@refs-to-ids ref)]
153 |                            (swap! refs-to-ids dissoc ref)
154 |                            (swap! ids-to-session+refs dissoc id)))
155 |                        (recur))))
156 |     {:put (fn [session-id x]
157 |             (let [x (if (nil? x) NULL x)
158 |                   id (keyword (gensym))
159 |                   ref (java.lang.ref.SoftReference. x refq)]
160 |               (swap! refs-to-ids assoc ref id)
161 |               (swap! ids-to-session+refs assoc id [session-id ref])
162 |               {:get (make-action id)}))
163 |      :get (fn [id]
164 |             (when-some [[session-id  ^java.lang.ref.Reference r] (@ids-to-session+refs id)]
165 |               (let [x (.get r)]
166 |                 [session-id (if (= NULL x) nil x)])))}))
167 | 
168 | (defonce ^:private sessions (atom {}))
169 | 
170 | (defn session [id]
171 |   (some-> @sessions (get id) deref))
172 | 
173 | (defonce ^:private elision-store (soft-store #(list `fetch %)))
174 | (defn fetch [id]
175 |   (if-some [[session-id x] ((:get elision-store) id)]
176 |     (unrepl.printer.WithBindings.
177 |       (select-keys (some-> session-id session :bindings) [#'*print-length* #'*print-level* #'unrepl/*string-length* #'p/*elide*])
178 |       (cond
179 |         (instance? unrepl.printer.ElidedKVs x) x
180 |         (string? x) x
181 |         (instance? unrepl.printer.MimeContent x) x
182 |         :else (seq x)))
183 |     p/unreachable))
184 | 
185 | (defn interrupt! [session-id eval]
186 |   (let [{:keys [^Thread thread eval-id promise]}
187 |         (some-> session-id session :current-eval)]
188 |     (when (and (= eval eval-id)
189 |                (deliver promise
190 |                         {:ex (doto (ex-info "Evaluation interrupted" {::phase :eval})
191 |                                (.setStackTrace (.getStackTrace thread)))
192 |                          :bindings {}}))
193 |       (.stop thread)
194 |       true)))
195 | 
196 | (defn background! [session-id eval]
197 |   (let [{:keys [eval-id promise future]}
198 |         (some-> session-id session :current-eval)]
199 |     (boolean
200 |      (and
201 |       (= eval eval-id)
202 |       (deliver promise
203 |                {:eval future
204 |                 :bindings {}})))))
205 | 
206 | (defn attach-sideloader! [session-id]
207 |   (prn '[:unrepl.jvm.side-loader/hello])
208 |   (some-> session-id session :side-loader
209 |           (reset!
210 |            (let [out *out*
211 |                  in *in*]
212 |              (fn self [k name]
213 |                (binding [*out* out]
214 |                  (locking self
215 |                    (prn [k name])
216 |                    (some-> (edn/read {:eof nil} in) p/base64-decode)))))))
217 |   (let [o (Object.)] (locking o (.wait o))))
218 | 
219 | (defn enqueue [session-id f]
220 |   (some-> session-id session ^java.util.concurrent.BlockingQueue (:actions-queue) (.put f)))
221 | 
222 | (defn set-file-line-col [session-id file line col]
223 |   (enqueue session-id #(when-some [in (some-> session-id session :in)]
224 |                          (set! *file* file)
225 |                          (set! *source-path* file)
226 |                          (.setCoords ^ILocatedReader in {:line line :col col :file file}))))
227 | 
228 | (def schedule-flushes!
229 |   (let [thread-pool (java.util.concurrent.Executors/newScheduledThreadPool 1)
230 |         max-latency-ms 20] ; 50 flushes per second
231 |     (fn [w]
232 |       (let [wr (java.lang.ref.WeakReference. w)
233 |             vfut (volatile! nil)]
234 |         (vreset! vfut
235 |           (.scheduleAtFixedRate
236 |             thread-pool
237 |             (fn []
238 |               (if-some [^java.io.Writer w (.get wr)]
239 |                 (.flush w)
240 |                 (.cancel ^java.util.concurrent.Future @vfut)))
241 |             max-latency-ms max-latency-ms java.util.concurrent.TimeUnit/MILLISECONDS))))))
242 | 
243 | (defn scheduled-writer [& args]
244 |   (-> (apply tagging-writer args)
245 |     java.io.BufferedWriter.
246 |     (doto schedule-flushes!)))
247 | 
248 | (defmacro ^:private flushing [bindings & body]
249 |   `(binding ~bindings
250 |      (try ~@body
251 |           (finally ~@(for [v (take-nth 2 bindings)]
252 |                        `(.flush ~(vary-meta v assoc :tag 'java.io.Writer)))))))
253 | 
254 | (def ^:dynamic eval-id)
255 | 
256 | (def ^:dynamic interrupted? (constantly false))
257 | 
258 | (defn seek-readable
259 |   "Skips whitespace and comments on stream s. Returns true when a form may be read,
260 |   false otherwise.
261 |   Note that returning true does not guarantee that the next read will yield something.
262 |   (It may be EOF, or a discard #_ or a non-matching conditional...)"
263 |   [s]
264 |   (loop [comment false]
265 |     (let [c (.read s)]
266 |       (cond
267 |         (interrupted?) (do (.unread s c) false)
268 |         (= c (int \newline)) false
269 |         comment (recur comment)
270 |         (= c -1) true
271 |         (= c (int \;)) (recur true)
272 |         (or (Character/isWhitespace (char c)) (= c (int \,))) (recur comment)
273 |         :else (do (.unread s c) true)))))
274 | 
275 | (defn unrepl-read [request-prompt request-exit]
276 |   (blame :read 
277 |     (if (seek-readable *in*)
278 |       (let [coords (:coords *in*)]
279 |         (try 
280 |           (read {:read-cond :allow :eof request-exit} *in*)
281 |           (finally
282 |             (let [coords' (:coords *in*)]
283 |               (unrepl/write [:read {:file (:file coords)
284 |                                     :from [(:line coords) (:col coords)] :to [(:line coords') (:col coords')]
285 |                                     :offset (:offset coords)
286 |                                     :len (- (:offset coords') (:offset coords))}
287 |                              eval-id])))))
288 |       request-prompt)))
289 | 
290 | (defn start [ext-session-actions]
291 |   (with-local-vars [prompt-vars #{#'*ns* #'*warn-on-reflection*}
292 |                     current-eval-future nil]
293 |     (let [ext-session-actions
294 |           (into {}
295 |             (map (fn [[k v]]
296 |                    [k (if (and (seq? v) (symbol? (first v)) (namespace (first v)))
297 |                         (list `ensure-ns v)
298 |                         v)]))
299 |             ext-session-actions)
300 |           session-id (keyword (gensym "session"))
301 |           raw-out *out*
302 |           in (ensure-unrepl-reader *in* (str "unrepl-" (name session-id)))
303 |           actions-queue (java.util.concurrent.LinkedBlockingQueue.)
304 |           session-state (atom {:current-eval {}
305 |                                :in in
306 |                                :log-eval (fn [msg]
307 |                                            (when (bound? eval-id)
308 |                                              (unrepl/write [:log msg eval-id])))
309 |                                :log-all (fn [msg]
310 |                                           (unrepl/write [:log msg nil]))
311 |                                :side-loader (atom nil)
312 |                                :prompt-vars #{#'*ns* #'*warn-on-reflection*}
313 |                                :actions-queue actions-queue})
314 |           current-eval-thread+promise (atom nil)
315 |           say-hello
316 |           (fn []
317 |             (unrepl/non-eliding-write
318 |               [:unrepl/hello {:session session-id
319 |                               :actions (into
320 |                                          {:start-aux `(start-aux ~session-id)
321 |                                           :log-eval
322 |                                           `(some-> ~session-id session :log-eval)
323 |                                           :log-all
324 |                                           `(some-> ~session-id session :log-all)
325 |                                           :print-limits
326 |                                           `(let [bak# {:unrepl.print/string-length unrepl/*string-length*
327 |                                                        :unrepl.print/coll-length *print-length*
328 |                                                        :unrepl.print/nesting-depth *print-level*}]
329 |                                              (some->> ~(tagged-literal 'unrepl/param :unrepl.print/string-length) (set! unrepl/*string-length*))
330 |                                              (some->> ~(tagged-literal 'unrepl/param :unrepl.print/coll-length) (set! *print-length*))
331 |                                              (some->> ~(tagged-literal 'unrepl/param :unrepl.print/nesting-depth) (set! *print-level*))
332 |                                              bak#)
333 |                                           :set-source
334 |                                           `(set-file-line-col ~session-id
335 |                                              ~(tagged-literal 'unrepl/param :unrepl/sourcename)
336 |                                              ~(tagged-literal 'unrepl/param :unrepl/line)
337 |                                              ~(tagged-literal 'unrepl/param :unrepl/column))
338 |                                           :unrepl.jvm/start-side-loader
339 |                                           `(attach-sideloader! ~session-id)}
340 |                                          ext-session-actions)}]))
341 | 
342 |           interruptible-eval
343 |           (fn [form]
344 |             (try
345 |               (let [original-bindings (get-thread-bindings)
346 |                     p (promise)
347 |                     f
348 |                     (future
349 |                       (swap! session-state update :current-eval
350 |                              assoc :thread (Thread/currentThread))
351 |                       (with-bindings original-bindings
352 |                         (try
353 |                           (unrepl/non-eliding-write
354 |                             [:started-eval
355 |                              {:actions
356 |                               {:interrupt (list `interrupt! session-id eval-id)
357 |                                :background (list `background! session-id eval-id)}}
358 |                              eval-id])
359 |                           (let [v (blame :eval (eval form))]
360 |                             (deliver p {:eval v :bindings (get-thread-bindings)})
361 |                             v)
362 |                           (catch Throwable t
363 |                             (deliver p {:ex t :bindings (get-thread-bindings)})
364 |                             (throw t)))))]
365 |                 (swap! session-state update :current-eval
366 |                        into {:eval-id eval-id :promise p :future f})
367 |                 (let [{:keys [ex eval bindings]} @p]
368 |                   (swap! session-state assoc :bindings bindings)
369 |                   (doseq [[var val] bindings
370 |                           :when (not (identical? val (original-bindings var)))]
371 |                     (var-set var val))
372 |                   (if ex
373 |                     (throw ex)
374 |                     eval)))
375 |               (finally
376 |                 (swap! session-state assoc :current-eval {}))))
377 |           cl (.getContextClassLoader (Thread/currentThread))
378 |           slcl (classloader cl
379 |                             (fn [k x]
380 |                               (when-some [f (some-> session-state deref :side-loader deref)]
381 |                                 (f k x))))]
382 |       (swap! session-state assoc :class-loader slcl)
383 |       (swap! sessions assoc session-id session-state)
384 |       (binding [*out* (scheduled-writer :out unrepl/non-eliding-write)
385 |                 *err* (tagging-writer :err unrepl/non-eliding-write)
386 |                 *in* in
387 |                 *file* (-> in :coords :file)
388 |                 *source-path* *file*
389 |                 *default-data-reader-fn* tagged-literal
390 |                 p/*elide* (partial (:put elision-store) session-id)
391 |                 unrepl/*string-length* unrepl/*string-length*
392 |                 unrepl/write (atomic-write raw-out)
393 |                 unrepl/read unrepl-read
394 |                 eval-id 0
395 |                 interrupted? #(.peek actions-queue)]
396 |         (.setContextClassLoader (Thread/currentThread) slcl)
397 |         (with-bindings {clojure.lang.Compiler/LOADER slcl}
398 |           (try
399 |             (m/repl
400 |              :init #(do
401 |                       (swap! session-state assoc :bindings (get-thread-bindings))
402 |                       (say-hello))
403 |              :need-prompt (constantly true)
404 |              :prompt (fn []
405 |                        (when-some [f (.poll actions-queue)] (f))
406 |                        (unrepl/non-eliding-write [:prompt (into {:file *file*
407 |                                                                  :line (.getLineNumber *in*)
408 |                                                                  :column (.getColumnNumber *in*)
409 |                                                                  :offset (:offset *in*)}
410 |                                                             (map (fn [v]
411 |                                                                    (let [m (meta v)]
412 |                                                                      [(symbol (name (ns-name (:ns m))) (name (:name m))) @v])))
413 |                                                             (:prompt-vars @session-state))
414 |                                                   (set! eval-id (inc eval-id))]))
415 |              :read unrepl/read
416 |              :eval (fn [form]
417 |                      (flushing [*err* (tagging-writer :err eval-id unrepl/non-eliding-write)
418 |                                 *out* (scheduled-writer :out eval-id unrepl/non-eliding-write)]
419 |                        (interruptible-eval form)))
420 |              :print (fn [x]
421 |                       (unrepl/write [:eval x eval-id]))
422 |              :caught (fn [e]
423 |                        (let [{:keys [::ex ::phase]
424 |                               :or {ex e phase :repl}} (ex-data e)]
425 |                          (unrepl/write [:exception {:ex ex :phase phase} eval-id]))))
426 |             (finally
427 |               (.setContextClassLoader (Thread/currentThread) cl))))))))
428 | 
429 | (defn start-aux [session-id]
430 |   (let [cl (.getContextClassLoader (Thread/currentThread))]
431 |     (try
432 |       (some->> session-id session :class-loader (.setContextClassLoader (Thread/currentThread)))
433 |       (start {})
434 |       (finally
435 |         (.setContextClassLoader (Thread/currentThread) cl)))))
436 | 
437 | (defmacro ensure-ns [[fully-qualified-var-name & args :as expr]]
438 |   `(do
439 |      (require '~(symbol (namespace fully-qualified-var-name)))
440 |      ~expr))


--------------------------------------------------------------------------------