Repository: greglook/puget
Pull request #52 (2020-04-12 12:21:05)

Add support for :coll-limit
This pull request adds support for :coll-limit, as described and discussed in issue 50. :coll-limit keeps backwards compatibility with :seq-limit in the way that :seq-limit has higher precedence than :coll-limit when both are set.

https://github.com/greglook/puget/issues/50

niclasnilsson: I can't seem to make the "ci/circleci: style" fully happy. I fixed a few formatting things where the style message was obvious, but I don't think I understand the format it wants on the remaining style errors.
niclasnilsson: Found that it blew up on MapEntry instances, so I changed the delimiter implementation. After the change is both safer and simpler.

Patch:
diff --git a/.circleci/config.yml b/.circleci/config.yml
index ec52131..07c99d4 100644
--- a/.circleci/config.yml
+++ b/.circleci/config.yml
@@ -17,7 +17,7 @@ jobs:
       - run:
           name: Install cljstyle
           environment:
-            CLJSTYLE_VERSION: 0.10.1
+            CLJSTYLE_VERSION: 0.12.1
           command: |
             wget https://github.com/greglook/cljstyle/releases/download/${CLJSTYLE_VERSION}/cljstyle_${CLJSTYLE_VERSION}_linux.tar.gz
             tar -xzf cljstyle_${CLJSTYLE_VERSION}_linux.tar.gz
diff --git a/CHANGELOG.md b/CHANGELOG.md
index e45c26d..784e697 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,10 +5,18 @@ All notable changes to this project will be documented in this file, which
 follows the conventions of [keepachangelog.com](http://keepachangelog.com/).
 This project adheres to [Semantic Versioning](http://semver.org/).
 
-## [1.0.1] - 2016-08-23
+
+## [Unreleased]
 
 ...
 
+
+## [1.2.1] - 2020-04-19
+
+### Changed
+- Minor version upgrades
+
+
 ## [1.2.0] - 2019-10-11
 
 ### Fixed
@@ -20,6 +28,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Update CI configuration to support style checks and separate coverage check.
 - Switch to cljdoc for documentation.
 
+
 ## [1.1.2] - 2019-04-04
 
 ### Fixed
@@ -28,6 +37,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - The `:html-inline` color markup now defaults to assuming a style value is a
   color, allowing use of any CSS color name.
 
+
 ## [1.1.1] - 2019-03-17
 
 ### Changed
@@ -35,6 +45,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Upgrade to clj-arrangement 1.2.0 for a ~3x speedup when sorting complex
   collections for canonical printing.
 
+
 ## [1.1.0] - 2018-12-16
 
 ### Added
@@ -49,18 +60,21 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Empty collections now omit child document nodes, so they are slightly more
   efficient to render.
 
+
 ## [1.0.3] - 2018-10-30
 
 ### Changed
 - Upgrade to fipp 0.6.13 for Java 11 compatibility.
   [#38](//github.com/greglook/puget/pull/38)
 
+
 ## [1.0.2] - 2017-11-04
 
 ### Changed
 - Upgrade to CircleCI 2.0
 - Upgrade various minor dependency versions
 
+
 ## [1.0.1] - 2016-08-23
 
 ### Added
@@ -71,6 +85,7 @@ This project adheres to [Semantic Versioning](http://semver.org/).
 - Upgraded fipp to 0.6.6
   [#33](//github.com/greglook/puget/pull/33)
 
+
 ## [1.0.0] - 2015-10-29
 
 Finally decided it was time to recognize that this is a stable library!
@@ -83,6 +98,7 @@ Finally decided it was time to recognize that this is a stable library!
 - Move pattern and var printing back into `PrettyPrinter` visitor protocol.
 - Improve class name parsing of inner function names.
 
+
 ## [0.9.2] - 2015-10-20
 
 ### Added
@@ -92,6 +108,7 @@ Finally decided it was time to recognize that this is a stable library!
 ### Changed
 - Line-break tagged literals when the form is a collection.
 
+
 ## [0.9.1] - 2015-10-17
 
 ### Added
@@ -107,6 +124,7 @@ Finally decided it was time to recognize that this is a stable library!
 - Fix rendering of lazy sequences.
   [#26](//github.com/greglook/puget/issues/26)
 
+
 ## [0.9.0] - 2015-10-13
 
 This version involves a major update to the printer internals with the upgrade
@@ -128,12 +146,14 @@ to fipp and Clojure 1.7.
 ### Removed
 - Remove `:escape-types` functionality in favor of `:print-handlers`.
 
+
 ## [0.8.1] - 2015-04-25
 
 ### Removed
 - Remove `tagged-literal` code which conflicts with the built-in `clojure.core`
   functions in 1.7. [#20](//github.com/greglook/puget/issues/20)
 
+
 ## [0.8.0] - 2015-03-10
 
 ### Added
@@ -144,6 +164,7 @@ to fipp and Clojure 1.7.
 - Remove byte array and URI extension to Whidbey.
   [#16](//github.com/greglook/puget/issue/16)
 
+
 ## [0.7.1] - 2015-02-28
 
 ### Added
@@ -162,12 +183,14 @@ to fipp and Clojure 1.7.
 ### Fixed
 - Update documentation and clean up docstrings.
 
+
 ## [0.6.6] - 2014-12-28
 
 ### Added
 - Add `:sort-keys` option to allow bounded canonicalization.
   [#12](//github.com/greglook/puget/pull/12)
 
+
 ## [0.6.4] - 2014-09-23
 
 ### Added
@@ -181,7 +204,9 @@ to fipp and Clojure 1.7.
 - Maps default to using commas between entries.
 - Gave characters a separate syntax element than strings.
 
-[Unreleased]: https://github.com/greglook/puget/compare/1.2.0...HEAD
+
+[Unreleased]: https://github.com/greglook/puget/compare/1.2.1...HEAD
+[1.2.1]: https://github.com/greglook/puget/compare/1.2.0...1.2.1
 [1.2.0]: https://github.com/greglook/puget/compare/1.1.2...1.2.0
 [1.1.2]: https://github.com/greglook/puget/compare/1.1.1...1.1.2
 [1.1.1]: https://github.com/greglook/puget/compare/1.1.0...1.1.1
diff --git a/project.clj b/project.clj
index 956f95f..d3b39e5 100644
--- a/project.clj
+++ b/project.clj
@@ -1,4 +1,4 @@
-(defproject mvxcvi/puget "1.2.1-SNAPSHOT"
+(defproject mvxcvi/puget "1.2.1"
   :description "Colorizing canonical Clojure printer for EDN values."
   :url "https://github.com/greglook/puget"
   :license {:name "Public Domain"
@@ -11,6 +11,6 @@
   [[lein-cloverage "1.1.2"]]
 
   :dependencies
-  [[org.clojure/clojure "1.10.0"]
+  [[org.clojure/clojure "1.10.1"]
    [mvxcvi/arrangement "1.2.0"]
-   [fipp "0.6.21"]])
+   [fipp "0.6.22"]])
diff --git a/src/puget/printer.clj b/src/puget/printer.clj
index c0be50f..d38c7b1 100644
--- a/src/puget/printer.clj
+++ b/src/puget/printer.clj
@@ -43,6 +43,13 @@
   elements. This can help prevent unintentional realization of infinite lazy
   sequences.
 
+  `:coll-limit`
+
+  If set to a positive number, then collections will only render at most the 
+  first n elements. This can help prevent unintentional printing of large 
+  collections. Note: `:seq-limit` has higher precendence than `:coll-limit`
+  if both are set.
+
   #### Color Options
 
   `:print-color`
@@ -364,26 +371,32 @@
     [this]
     "nil")
 
+
   (visit-boolean
     [this value]
     (str value))
 
+
   (visit-number
     [this value]
     (pr-str value))
 
+
   (visit-character
     [this value]
     (pr-str value))
 
+
   (visit-string
     [this value]
     (pr-str value))
 
+
   (visit-keyword
     [this value]
     (str value))
 
+
   (visit-symbol
     [this value]
     (str value))
@@ -398,6 +411,7 @@
         [:group "(" [:align (interpose " " entries)] ")"])
       "()"))
 
+
   (visit-vector
     [this value]
     (if (seq value)
@@ -405,6 +419,7 @@
         [:group "[" [:align (interpose " " entries)] "]"])
       "[]"))
 
+
   (visit-set
     [this value]
     (if (seq value)
@@ -413,6 +428,7 @@
         [:group "#{" [:align (interpose " " entries)] "}"])
       "#{}"))
 
+
   (visit-map
     [this value]
     (if (seq value)
@@ -430,16 +446,19 @@
     ; Metadata is not printed for canonical rendering.
     (format-doc* this value))
 
+
   (visit-var
     [this value]
     ; Defer to unknown, cover with handler.
     (fv/visit-unknown this value))
 
+
   (visit-pattern
     [this value]
     ; Defer to unknown, cover with handler.
     (fv/visit-unknown this value))
 
+
   (visit-record
     [this value]
     ; Defer to unknown, cover with handler.
@@ -452,6 +471,7 @@
     [this value]
     [:span (str "#" (:tag value)) " " (format-doc this (:form value))])
 
+
   (visit-unknown
     [this value]
     (throw (IllegalArgumentException.
@@ -475,6 +495,39 @@
 
 ;; ## Pretty Printer Implementation
 
+(defn trim-coll?
+  "Returns true if a collection should be trimmed according to the 
+  :coll-limit config."
+  [coll coll-limit]
+  (and coll-limit (pos? coll-limit) (< coll-limit (count coll))))
+
+
+(defn visit-coll
+  "Helper function that supports the other visit functions.
+  order? should be false for ordered collection types like vector where any
+  rearrangement would mess up the data, but true for unordered collections like set,
+  that can safely be reordered for nicer output."
+  [this coll coll-limit order? sort-keys delimiter left-delimiter right-delimiter]
+  (if (seq coll)
+    (let [[values trimmed?] (if (trim-coll? coll coll-limit)
+                              [(take coll-limit coll) true]
+                              [coll false])
+          values (if order?
+                   (order-collection sort-keys values (partial sort order/rank))
+                   values)
+          elements
+          (cond-> (if (and (list? coll) (symbol? (first values)))
+                    (cons (color/document this :function-symbol (str (first values)))
+                          (map (partial format-doc this) (rest values)))
+                    (map (partial format-doc this) values))
+            trimmed? (concat [(color/document this :nil "...")]))]
+      [:group
+       (color/document this :delimiter left-delimiter)
+       [:align (interpose :line elements)]
+       (color/document this :delimiter right-delimiter)])
+    (color/document this :delimiter delimiter)))
+
+
 (defrecord PrettyPrinter
   [width
    print-meta
@@ -483,6 +536,7 @@
    map-coll-separator
    namespace-maps
    seq-limit
+   coll-limit
    print-color
    color-markup
    color-scheme
@@ -497,26 +551,32 @@
     [this]
     (color/document this :nil "nil"))
 
+
   (visit-boolean
     [this value]
     (color/document this :boolean (str value)))
 
+
   (visit-number
     [this value]
     (color/document this :number (pr-str value)))
 
+
   (visit-character
     [this value]
     (color/document this :character (pr-str value)))
 
+
   (visit-string
     [this value]
     (color/document this :string (pr-str value)))
 
+
   (visit-keyword
     [this value]
     (color/document this :keyword (str value)))
 
+
   (visit-symbol
     [this value]
     (color/document this :symbol (str value)))
@@ -527,57 +587,63 @@
   (visit-seq
     [this value]
     (if (seq value)
-      (let [[values trimmed?]
-            (if (and seq-limit (pos? seq-limit))
-              (let [head (take seq-limit value)]
-                [head (<= seq-limit (count head))])
-              [(seq value) false])
-            elements
-            (cond-> (if (symbol? (first values))
-                      (cons (color/document this :function-symbol (str (first values)))
-                            (map (partial format-doc this) (rest values)))
-                      (map (partial format-doc this) values))
-              trimmed? (concat [(color/document this :nil "...")]))]
-        [:group
-         (color/document this :delimiter "(")
-         [:align (interpose :line elements)]
-         (color/document this :delimiter ")")])
+      (if (list? value)
+        (visit-coll this value coll-limit false sort-keys "()" "(" ")")
+        (let [limit (cond
+                      (pos-int? seq-limit) seq-limit
+                      (pos-int? coll-limit) coll-limit)
+              [values trimmed?]
+              (if limit
+                (let [head (take limit value)]
+                  [head (<= limit (count head))])
+                [(seq value) false])
+              elements
+              (cond-> (if (symbol? (first values))
+                        (cons (color/document this :function-symbol (str (first values)))
+                              (map (partial format-doc this) (rest values)))
+                        (map (partial format-doc this) values))
+                trimmed? (concat [(color/document this :nil "...")]))]
+          [:group
+           (color/document this :delimiter "(")
+           [:align (interpose :line elements)]
+           (color/document this :delimiter ")")]))
       (color/document this :delimiter "()")))
 
+
   (visit-vector
     [this value]
-    (if (seq value)
-      [:group
-       (color/document this :delimiter "[")
-       [:align (interpose :line (map (partial format-doc this) value))]
-       (color/document this :delimiter "]")]
-      (color/document this :delimiter "[]")))
+    (visit-coll this value coll-limit false sort-keys "[]" "[" "]"))
+
 
   (visit-set
     [this value]
-    (if (seq value)
-      (let [entries (order-collection sort-keys value (partial sort order/rank))]
-        [:group
-         (color/document this :delimiter "#{")
-         [:align (interpose :line (map (partial format-doc this) entries))]
-         (color/document this :delimiter "}")])
-      (color/document this :delimiter "#{}")))
+    (visit-coll this value coll-limit true sort-keys "#{}" "#{" "}"))
+
 
   (visit-map
     [this value]
     (if (seq value)
-      (let [[common-ns stripped] (when namespace-maps (common-key-ns value))
-            kvs (order-collection sort-keys
-                                  (or stripped value)
-                                  (partial sort-by first order/rank))
-            entries (map (fn [[k v]]
-                           [:span
-                            (format-doc this k)
-                            (if (coll? v)
-                              map-coll-separator
-                              " ")
-                            (format-doc this v)])
-                         kvs)
+      (let [[values trimmed?]
+            (if (trim-coll? value coll-limit)
+              [(take coll-limit value) true]
+              [(order-collection sort-keys value (partial sort order/rank)) false])
+
+            [common-ns stripped] (when namespace-maps (common-key-ns values))
+            kvs (if trimmed?
+                  values
+                  (order-collection sort-keys
+                                    (or stripped values)
+                                    (partial sort-by first order/rank)))
+            entries (cond-> (map (fn [[k v]]
+                                   [:span
+                                    (format-doc this k)
+                                    (if (coll? v)
+                                      map-coll-separator
+                                      " ")
+                                    (format-doc this v)])
+                                 kvs)
+                      trimmed? (concat [(color/document this :nil "...")]))
+
             map-doc [:group
                      (color/document this :delimiter "{")
                      [:align (interpose [:span map-delimiter :line] entries)]
@@ -598,18 +664,21 @@
        :line (format-doc* this value)]
       (format-doc* this value)))
 
+
   (visit-var
     [this value]
     [:span
      (color/document this :delimiter "#'")
      (color/document this :symbol (subs (str value) 2))])
 
+
   (visit-pattern
     [this value]
     [:span
      (color/document this :delimiter "#")
      (color/document this :string (str \" value \"))])
 
+
   (visit-record
     [this value]
     (fv/visit-tagged
@@ -628,6 +697,7 @@
        (if (coll? form) :line " ")
        (format-doc this (:form value))]))
 
+
   (visit-unknown
     [this value]
     (case print-fallback


Test patch:
diff --git a/test/puget/printer_test.clj b/test/puget/printer_test.clj
index 713947b..5c40964 100644
--- a/test/puget/printer_test.clj
+++ b/test/puget/printer_test.clj
@@ -141,7 +141,8 @@
     {:foo 8 :bar 'baz}     "{:bar baz, :foo 8}"     ; gets sorted
     #{}                    "#{}"
     #{:omega :alpha :beta} "#{:alpha :beta :omega}" ; also sorted
-    (lazy-seq [:x])        "(:x)"))
+    (lazy-seq [:x])        "(:x)"
+    (first {:a 1})         "[:a 1]"))
 
 
 (deftest pretty-java-types
@@ -253,10 +254,36 @@
           "common ns should be qualified even with other ns keys")
       (is (= "{\"a/x\" 1, :a/y 2}" (pprint-str {"a/x" 1, :a/y 2}))
           "any non-ident keys should prevent namespacing")))
-  (testing "lazy seq limits"
-    (with-options {:seq-limit 4}
+  (testing "lazy - seq-limit only"
+    (with-options {:seq-limit 4 :coll-limit nil}
       (is (= "(1 2 3)" (pprint-str (map inc [0 1 2]))))
-      (is (= "(0 1 2 3 ...)" (pprint-str (range 100)))))))
+      (is (= "(0 1 2 3 ...)" (pprint-str (range 100))))))
+  (testing "lazy - coll-limit only"
+    (with-options {:seq-limit nil :coll-limit 4}
+      (is (= "(1 2 3)" (pprint-str (map inc [0 1 2]))))
+      (is (= "(0 1 2 3 ...)" (pprint-str (range 100))))))
+  (testing "lazy - seq-limit has higher precesence than coll-limit"
+    (with-options {:seq-limit 5 :coll-limit 4}
+      (is (= "(1 2 3)" (pprint-str (map inc [0 1 2]))))
+      (is (= "(0 1 2 3 4 ...)" (pprint-str (range 100))))))
+  (testing "coll-limit on lists"
+    (with-options {:coll-limit 4}
+      (is (= "(0 1 2)" (pprint-str '(0 1 2))))
+      (is (= "(0 1 2 3 ...)" (pprint-str '(0 1 2 3 4 5))))))
+  (testing "coll-limit on vectors"
+    (with-options {:coll-limit 4}
+      (is (= "[0 1 2]" (pprint-str [0 1 2])))
+      (is (= "[5 4 3 2 ...]" (pprint-str [5 4 3 2 1])))))
+  (testing "coll-limit on sets"
+    (with-options {:coll-limit 4}
+      (is (= "#{1 2 3}" (pprint-str #{3 2 1})))
+      (is (= "#{1 4 3 2 ...}" (pprint-str #{5 4 3 2 1})))))
+  (testing "coll-limit on maps"
+    (with-options {:coll-limit 3}
+      (is (= "{:a 1, :b 2, :c 3}" (pprint-str {:a 1 :b 2 :c 3})))
+      (is (= "{:a 1, :b 2, :c 3}" (pprint-str {:c 3 :b 2 :a 1})))
+      (is (= "{:a 1, :b 2, :c 3, ...}" (pprint-str {:a 1 :b 2 :c 3 :d 4})))
+      (is (= "{:d 4, :c 3, :b 2, ...}" (pprint-str {:d 4 :c 3 :b 2 :a 1}))))))
 
 
 (deftest pretty-color-options