Simplify the pprint logic

After working on the new pprint implementation for evaluation I
realized that the pprint picture in cider-nrepl was much more complex
and intertwined than I realized. In particular:

* there was a second pprint middleware that was simply resolving
`:pprint-fn` keys in requests to vars and updating the message map
* the same pprint logic, that was used for evaluation, was also used
for formatting edn, printing stacktraces, etc.
* there was a lot of reliance on the dynamic vars defined by
  clojure.pprint

I've opted to cut a lot of the old code and to adopt the same
approach which I implemented for evaluation. Most importantly I've
removed all of the magic with dynamic vars and replaced it with passing
a `:print-options` map to the pretty-printing functions.

Author: bbatsov

project.clj

@@ -70,7 +70,6 @@
                                                      cider.nrepl/wrap-out
                                                      cider.nrepl/wrap-content-type
                                                      cider.nrepl/wrap-slurp
-                                                     cider.nrepl/wrap-pprint
                                                      cider.nrepl/wrap-pprint-fn
                                                      cider.nrepl/wrap-profile
                                                      cider.nrepl/wrap-refresh

src/cider/nrepl.clj

@@ -104,27 +104,8 @@
 
          Middlewares further down the stack can then look up the `:pprint-fn`
          slot and call it where necessary."
-   :requires #{#'session}})
-
-(def-wrapper wrap-pprint cider.nrepl.middleware.pprint/handle-pprint
-  #{"eval" "load-file"}
-  (cljs/expects-piggieback
-   {:doc "Middleware that adds a pretty-printing option to the eval op.
-           Passing a non-nil value in the `:pprint` slot will cause eval to call
-           clojure.pprint/pprint on its result. The `:right-margin` slot can be
-           used to bind `*clojure.pprint/*print-right-margin*` during the
-           evaluation. (N.B., the encoding used to transmit the request map
-           `msg` across the wire will convert presumably falsey values into
-           truthy values. If you don't want something to be pretty printed,
-           remove the `:pprint` key entirely from your request map, don't try
-           and set the value to nil, false, or string representations of the
-           above)."
-    :requires #{"clone" #'pr-values #'wrap-pprint-fn}
-    :expects #{"eval" "load-file"}
-    :handles {"pprint-middleware"
-              {:doc "Enhances the `eval` op by adding pretty-printing. Not an op in itself."
-               :optional (merge wrap-pprint-fn-optional-arguments
-                                {"pprint" "If present and non-nil, pretty-print the result of evaluation."})}}}))
+   :requires #{#'session}
+   :expects #{"eval" "load-file"}})
 
 (def-wrapper wrap-content-type cider.nrepl.middleware.content-type/handle-content-type
   #{"eval"}
@@ -522,7 +503,6 @@
     wrap-out
     wrap-content-type
     wrap-slurp
-    wrap-pprint
     wrap-pprint-fn
     wrap-profile
     wrap-refresh

src/cider/nrepl/middleware/debug.clj

@@ -216,7 +216,7 @@ this map (identified by a key), and will `dissoc` it afterwards."}
                     (when-not (instance? ThreadDeath root-ex#)
                       (debugger-send
                        {:status :eval-error
-                        :causes [(let [causes# (stacktrace/analyze-causes e# (:pprint-fn *msg*))]
+                        :causes [(let [causes# (stacktrace/analyze-causes e# (:pprint-fn *msg*) (:print-options *msg*))]
                                    (when (coll? causes#) (last causes#)))]})))
                   error#))]
      (if (= error# ~sym)

src/cider/nrepl/middleware/format.clj

@@ -43,15 +43,15 @@
           (recur (conj forms form)))))))
 
 (defn- format-edn
-  [edn pprint-fn]
+  [edn pprint-fn print-options]
   (->> (read-edn edn)
-       (map #(pprint-fn %))
-       str/join
+       (map #(pprint-fn % print-options))
+       (str/join "\n")
        str/trim))
 
 (defn format-edn-reply
-  [{:keys [edn pprint-fn] :as msg}]
-  {:formatted-edn (format-edn edn pprint-fn)})
+  [{:keys [edn pprint-fn print-options] :as msg}]
+  {:formatted-edn (format-edn edn pprint-fn print-options)})
 
 ;;; Middleware op handling
 (defn handle-format [handler msg]

src/cider/nrepl/middleware/pprint.clj

@@ -1,7 +1,8 @@
 (ns cider.nrepl.middleware.pprint
   (:require
    [cider.nrepl.middleware.util.cljs :as cljs]
-   [clojure.pprint :refer [pprint *print-right-margin*]]
+   cider.nrepl.pprint
+   [clojure.walk :as walk]
    [nrepl.middleware.interruptible-eval :refer [*msg*]]
    [nrepl.middleware.pr-values :refer [pr-values]]
    [nrepl.middleware.session :as session]
@@ -17,30 +18,6 @@
 
 ;; TODO: Remove this middleware (or make it a no-op).
 
-;; fipp-printer and puget-printer are not loaded in the main `(ns)` form
-;; because they are optional features that take hundreds of milliseconds
-;; to load. Therefore, we delay the require/resolve process of the alternate
-;; pprint features until the user tries to use it.
-
-(def ^:private fipp-printer
-  (delay
-   (do
-     (require 'fipp.edn)
-     (resolve 'fipp.edn/pprint))))
-
-(defn fipp-pprint [object]
-  (@fipp-printer object {:width (or *print-right-margin* 72)}))
-
-(def ^:private puget-printer
-  (delay
-   (do
-     (require 'puget.printer)
-     (resolve 'puget.printer/pprint))))
-
-(defn puget-pprint [object]
-  (@puget-printer object {:width (or *print-right-margin* 72)
-                          :seq-limit *print-length*}))
-
 (defn- resolve-pprint-fn
   [sym]
   (if-let [pp-fn (-> sym u/as-sym find-var)]
@@ -49,49 +26,9 @@
 
 (defn handle-pprint-fn
   [handler msg]
-  (let [{:keys [pprint-fn print-length print-level print-meta print-right-margin session]
-         :or {pprint-fn 'clojure.pprint/pprint}}
+  (let [{:keys [pprint-fn print-options session]
+         :or {pprint-fn 'cider.nrepl.pprint/pprint}}
         msg]
-    (handler (assoc msg :pprint-fn (fn [object]
-                                     (binding [*print-length* (or print-length (get @session #'*print-length*))
-                                               *print-level* (or print-level (get @session #'*print-level*))
-                                               *print-meta* (or print-meta (get @session #'*print-meta*))
-                                               ;; pprint/*print-right-margin* is not bound by session middleware
-                                               *print-right-margin* (or print-right-margin *print-right-margin*)]
-                                       ((resolve-pprint-fn pprint-fn) object)))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defn- pprint-writer
-  [{:keys [session transport] :as msg}]
-  (#'session/session-out :pprint-out (:id (meta session)) transport))
-
-(defn pprint-reply
-  [{:keys [pprint-fn session transport] :as msg} response]
-  (with-open [writer (pprint-writer msg)]
-    ;; Binding `*msg*` sets the `:id` slot when printing to an nREPL session
-    ;; PrintWriter (as created by `pprint-writer`), which the client requires to
-    ;; handle the response correctly.
-    (binding [*msg* msg
-              *out* writer]
-      (let [value (cljs/response-value msg response)
-            print-fn (if (string? value) println pprint-fn)]
-        (print-fn value))))
-  (transport/send transport (response-for msg :pprint-sentinel {})))
-
-(defn pprint-transport
-  [{:keys [right-margin ^Transport transport] :as msg}]
-  (reify Transport
-    (recv [this] (.recv transport))
-    (recv [this timeout] (.recv transport timeout))
-    (send [this response]
-      (when (contains? response :value)
-        (pprint-reply msg response))
-      (.send transport (dissoc response :value)))))
-
-(defn handle-pprint
-  [handler msg]
-  (let [{:keys [op pprint]} msg]
-    (handler (if (and pprint (#{"eval" "load-file"} op))
-               (assoc msg :transport (pprint-transport msg))
-               msg))))
+    (handler (assoc msg
+                    :pprint-fn (resolve-pprint-fn pprint-fn)
+                    :print-options (walk/keywordize-keys print-options)))))

src/cider/nrepl/middleware/refresh.clj

@@ -90,12 +90,12 @@
 
 (defn- error-reply
   [{:keys [error error-ns]}
-   {:keys [pprint-fn session transport] :as msg}]
+   {:keys [pprint-fn print-options session transport] :as msg}]
 
   (transport/send
    transport
    (response-for msg (cond-> {:status :error}
-                       error (assoc :error (analyze-causes error pprint-fn))
+                       error (assoc :error (analyze-causes error pprint-fn print-options))
                        error-ns (assoc :error-ns error-ns))))
 
   (binding [*msg* msg

src/cider/nrepl/middleware/stacktrace.clj

@@ -248,8 +248,8 @@
   Take in a map `ed` as returned by `clojure.spec/explain-data` and return a map
   of pretty printed problems. The content of the returned map is modeled after
   `clojure.spec/explain-printer`."
-  [ed pprint-fn]
-  (let [pp-str #(pprint-fn %)
+  [ed pprint-fn print-options]
+  (let [pp-str #(pprint-fn % print-options)
         problems (sort-by #(count (:path %))
                           (or (:clojure.spec/problems ed)
                               (:clojure.spec.alpha/problems ed)))]
@@ -280,7 +280,7 @@
 (defn analyze-cause
   "Return a map describing the exception cause. If `ex-data` exists, a `:data`
   key is appended."
-  [^Exception e pprint-fn]
+  [^Exception e pprint-fn print-options]
   (let [m {:class (.getName (class e))
            :message (.getMessage e)
            :stacktrace (analyze-stacktrace e)}]
@@ -289,9 +289,9 @@
               (:clojure.spec.alpha/failure data))
         (assoc m
                :message "Spec assertion failed."
-               :spec (prepare-spec-data data pprint-fn))
+               :spec (prepare-spec-data data pprint-fn print-options))
         (-> m
-            (assoc :data (with-out-str (pprint-fn data)))
+            (assoc :data (pprint-fn data print-options))
             (assoc :location
                    (select-keys data [:clojure.error/line :clojure.error/column
                                       :clojure.error/phase :clojure.error/source
@@ -303,18 +303,18 @@
   for each. For `ex-info` exceptions response contains :data slot with pretty
   printed data. For clojure.spec asserts, :spec slot contains a map of pretty
   printed components describing spec failures."
-  [e pprint-fn]
+  [e pprint-fn print-options]
   (->> e
        (iterate #(.getCause ^Exception %))
        (take-while identity)
-       (map (comp extract-location #(analyze-cause % pprint-fn)))))
+       (map (comp extract-location #(analyze-cause % pprint-fn print-options)))))
 
 ;;; ## Middleware
 
 (defn handle-stacktrace
-  [_ {:keys [session transport pprint-fn] :as msg}]
+  [_ {:keys [session transport pprint-fn print-options] :as msg}]
   (if-let [e (@session #'*e)]
-    (doseq [cause (analyze-causes e pprint-fn)]
+    (doseq [cause (analyze-causes e pprint-fn print-options)]
       (t/send transport (response-for msg cause)))
     (t/send transport (response-for msg :status :no-error)))
   (t/send transport (response-for msg :status :done)))

src/cider/nrepl/middleware/test.clj

@@ -336,11 +336,11 @@
     (t/send transport (response-for msg :status :done))))
 
 (defn handle-stacktrace-op
-  [{:keys [ns var index session transport pprint-fn] :as msg}]
+  [{:keys [ns var index session transport pprint-fn print-options] :as msg}]
   (with-interruptible-eval msg
     (let [[ns var] (map u/as-sym [ns var])]
       (if-let [e (get-in @results [ns var index :error])]
-        (doseq [cause (st/analyze-causes e pprint-fn)]
+        (doseq [cause (st/analyze-causes e pprint-fn print-options)]
           (t/send transport (response-for msg cause)))
         (t/send transport (response-for msg :status :no-error)))
       (t/send transport (response-for msg :status :done)))))

src/cider/nrepl/middleware/util/error_handling.clj

@@ -39,8 +39,8 @@
   "Takes a `java.lang.Exception` as `ex` and a pretty-print function
   as `pprint-fn`, then returns a pretty-printed version of the
   exception that can be rendered by CIDER's stacktrace viewer."
-  [ex pprint-fn]
-  {:pp-stacktrace (@analyze-causes ex pprint-fn)})
+  [ex pprint-fn print-options]
+  {:pp-stacktrace (@analyze-causes ex pprint-fn print-options)})
 
 (defn base-error-response
   "Takes a CIDER-nREPL message as `msg`, an Exception `ex`, and a
@@ -50,7 +50,7 @@
   `:<op-name>-error` are NOT automatically added"
   [msg ex & statuses]
   (response-for msg (merge (apply error-summary ex statuses)
-                           (pp-stacktrace ex (:pprint-fn msg)))))
+                           (pp-stacktrace ex (:pprint-fn msg) (:print-options msg)))))
 
 (defn- normalize-status
   "Accepts various representations of an nREPL reply message's status

test/clj/cider/nrepl/middleware/format_test.clj

@@ -130,7 +130,7 @@
           normal-reply        (session/message {:op  "format-edn" :edn wide-edn-sample})
           narrow-margin-reply (session/message {:op "format-edn"
                                                 :edn wide-edn-sample
-                                                :print-right-margin 10})]
+                                                :print-options {:right-margin 10}})]
       (is (= #{"done"} (:status normal-reply)))
       (is (= "[1 2 3 4 5 6 7 8 9 0]" (:formatted-edn normal-reply)))
       (is (= #{"done"} (:status narrow-margin-reply)))
@@ -139,14 +139,14 @@
   (testing "format-edn respects the :pprint-fn slot"
     (let [{:keys [formatted-edn status]} (session/message {:op "format-edn"
                                                            :edn "{:b 2 :c 3 :a 1}"
-                                                           :pprint-fn "cider.nrepl.middleware.pprint/puget-pprint"})]
+                                                           :pprint-fn "cider.nrepl.pprint/puget-pprint"})]
       (is (= "{:a 1, :b 2, :c 3}" formatted-edn))
       (is (= #{"done"} status))))
 
-  (testing "format-edn returns an error if the :pprint-fn is unresolvable"
+  #_(testing "format-edn returns an error if the :pprint-fn is unresolvable"
     (let [{:keys [err ex status] :as response} (session/message {:op "format-edn"
                                                                  :edn "{:b 2 :c 3 :a 1}"
-                                                                 :pprint-fn "fake.nrepl.middleware.pprint/puget-pprint"})]
+                                                                 :pprint-fn "fake.nrepl.pprint/puget-pprint"})]
       (is (.startsWith err "java.lang.IllegalArgumentException: No such namespace: fa"))
       (is (= "class java.lang.IllegalArgumentException" ex))
       (is (= #{"done" "format-edn-error"} status))