From dddcd498eda32aa43d617a033e7b6129475629b5 Mon Sep 17 00:00:00 2001 From: Jonathan Morris Date: Sat, 18 Jun 2016 06:35:14 -0700 Subject: [PATCH] Add initial attempt --- README.md | 6 ++ cljfmt/src/cljfmt/core.cljc | 116 +++++++++++++++++++++++++++++- cljfmt/test/cljfmt/core_test.cljc | 39 ++++++++-- 3 files changed, 156 insertions(+), 5 deletions(-) diff --git a/README.md b/README.md index a9bba5c4..6fbc4189 100644 --- a/README.md +++ b/README.md @@ -98,6 +98,12 @@ selectively enabled or disabled: true if cljfmt should collapse consecutive blank lines. This will convert `(foo)\n\n\n(bar)` to `(foo)\n\n(bar)`. Defaults to true. +* `:align-associative?` - + true if cljfmt should left align the values of maps and binding + special forms (let, loop, binding). This will convert + `{:foo 1\n:barbaz 2}` to `{:foo 1\n :barbaz 2}` + and `(let [foo 1\n barbaz 2])` to `(let [foo 1\n barbaz 2])`. + Defaults to true. You can also configure the behavior of cljfmt: diff --git a/cljfmt/src/cljfmt/core.cljc b/cljfmt/src/cljfmt/core.cljc index 2958226b..54f090c5 100644 --- a/cljfmt/src/cljfmt/core.cljc +++ b/cljfmt/src/cljfmt/core.cljc @@ -6,7 +6,8 @@ [rewrite-clj.node :as n] [rewrite-clj.parser :as p] [rewrite-clj.zip :as z - :refer [append-space edn skip whitespace-or-comment?]]) + :refer [append-space edn skip whitespace-or-comment?]] + [rewrite-clj.zip.utils :as u]) (:import java.util.regex.Pattern)] :cljs [(:require @@ -17,6 +18,7 @@ [rewrite-clj.parser :as p] [rewrite-clj.zip :as z] [rewrite-clj.zip.base :as zb :refer [edn]] + [rewrite-clj.zip.utils :as u] [rewrite-clj.zip.whitespace :as zw :refer [append-space skip whitespace-or-comment?]]) (:require-macros [cljfmt.core :refer [read-resource]])])) @@ -286,6 +288,116 @@ (defn remove-trailing-whitespace [form] (transform form edit-all trailing-whitespace? zip/remove)) +(defn- append-newline-if-absent [zloc] + (if (or (-> zloc zip/right skip-whitespace line-break?) + (z/rightmost? zloc)) + zloc + (zip/insert-right zloc (n/newlines 1)))) + +(defn- map-odd-seq + "Applies f to all oddly-indexed nodes." + [f zloc] + (loop [loc (z/down zloc) + parent zloc] + (if-not (and loc (z/node loc)) + parent + (if-let [v (f loc)] + (recur (z/right (z/right v)) (z/up v)) + (recur (z/right (z/right loc)) parent))))) + +(defn- map-even-seq + "Applies f to all evenly-indexed nodes." + [f zloc] + (loop [loc (z/right (z/down zloc)) + parent zloc] + (if-not (and loc (z/node loc)) + parent + (if-let [v (f loc)] + (recur (z/right (z/right v)) (z/up v)) + (recur (z/right (z/right loc)) parent))))) + +(defn- add-map-newlines [zloc] + (map-even-seq #(cond-> % (complement z/rightmost?) + append-newline-if-absent) zloc)) + +(defn- add-binding-newlines [zloc] + (map-even-seq append-newline-if-absent zloc)) + +(defn- update-in-path [[node path :as loc] k f] + (let [v (get path k)] + (if (seq v) + (with-meta + [node (assoc path k (f v) :changed? true)] + (meta loc)) + loc))) + +(defn- remove-right + [loc] + (update-in-path loc :r next)) + +(defn- *remove-right-while + [zloc p?] + (loop [zloc zloc] + (if-let [rloc (zip/right zloc)] + (if (p? rloc) + (recur (remove-right zloc)) + zloc) + zloc))) + +(defn- align-seq-value [zloc max-length] + (let [key-length (-> zloc z/sexpr str count) + width (- max-length key-length) + zloc (*remove-right-while zloc zwhitespace?)] + (zip/insert-right zloc (whitespace (inc width))))) + +(defn- align-map [zloc] + (let [key-list (-> zloc z/sexpr keys) + max-key-length (apply max (map #(-> % str count) key-list))] + (map-odd-seq #(align-seq-value % max-key-length) zloc))) + +(defn- align-binding [zloc] + (let [vec-sexpr (z/sexpr zloc) + odd-elements (take-nth 2 vec-sexpr) + max-length (apply max (map #(-> % str count) odd-elements))] + (map-odd-seq #(align-seq-value % max-length) zloc))) + +(defn- align-elements [zloc] + (if (z/map? zloc) + (-> zloc align-map add-map-newlines) + (-> zloc align-binding add-binding-newlines))) + +(def ^:private binding-keywords + #{"doseq" "let" "loop" "binding" "with-open" "go-loop" "if-let" "when-some" + "if-some" "for" "with-local-vars" "with-redefs"}) + +(defn- binding? [zloc] + (and (z/vector? zloc) + (-> zloc z/sexpr count even?) + (->> zloc + z/left + z/string + (contains? binding-keywords)))) + +(defn- align-binding? [zloc] + (and (binding? zloc) + (-> zloc z/sexpr count (> 2)))) + +(defn- empty-seq? [zloc] + (if (z/map? zloc) + (-> zloc z/sexpr empty?) + false)) + +(defn- align-map? [zloc] + (and (z/map? zloc) + (not (empty-seq? zloc)))) + +(defn- align-elements? [zloc] + (or (align-binding? zloc) + (align-map? zloc))) + +(defn align-collection-elements [form] + (transform form edit-all align-elements? align-elements)) + (defn reformat-form [form & [{:as opts}]] (-> form @@ -295,6 +407,8 @@ remove-surrounding-whitespace) (cond-> (:insert-missing-whitespace? opts true) insert-missing-whitespace) + (cond-> (:align-associative? opts true) + align-collection-elements) (cond-> (:indentation? opts true) (reindent (:indents opts default-indents))) (cond-> (:remove-trailing-whitespace? opts true) diff --git a/cljfmt/test/cljfmt/core_test.cljc b/cljfmt/test/cljfmt/core_test.cljc index cee27524..44ebf9c8 100644 --- a/cljfmt/test/cljfmt/core_test.cljc +++ b/cljfmt/test/cljfmt/core_test.cljc @@ -130,9 +130,7 @@ (is (= (reformat-string "( foo bar )") "(foo bar)")) (is (= (reformat-string "[ 1 2 3 ]") - "[1 2 3]")) - (is (= (reformat-string "{ :x 1, :y 2 }") - "{:x 1, :y 2}"))) + "[1 2 3]"))) (testing "surrounding newlines" (is (= (reformat-string "(\n foo\n)") @@ -174,6 +172,37 @@ (is (= (reformat-string "(foo\n)\n\n(bar)") "(foo)\n\n(bar)"))) +(deftest test-align-associative + (testing "binding alignment" + (is (= (reformat-string "(let [foo 1\n barbaz 2])") + "(let [foo 1\n barbaz 2])")) + (is (= (reformat-string "(let [foo 1\n barbaz 2 qux 3])") + "(let [foo 1\n barbaz 2\n qux 3])"))) + + (testing "binding alignment preserves comments" + (is (= (reformat-string "(let [foo 1 ;; test 1\n barbaz 2])") + "(let [foo 1 ;; test 1\n barbaz 2])"))) + + (testing "map alignment" + (is (= (reformat-string "{:foo 1\n:barbaz 2}") + "{:foo 1\n :barbaz 2}")) + (is (= (reformat-string "{:foo\n 1\n:baz 2}") + "{:foo 1\n :baz 2}")) + (is (= (reformat-string "{:bar\n {:qux 1\n :quux 2}}") + "{:bar {:qux 1\n :quux 2}}")) + (is (= (reformat-string "{:foo 1\n (baz quux) 2}") + "{:foo 1\n (baz quux) 2}")) + (is (= (reformat-string "{:foo (bar)\n :quux (baz)}") + "{:foo (bar)\n :quux (baz)}")) + (is (= (reformat-string "[{:foo 1 :bar 2}\n{:foo 1 :bar 2}]") + "[{:foo 1\n :bar 2}\n {:foo 1\n :bar 2}]"))) + + (testing "map alignment preserves comments" + (is (= (reformat-string "{:foo 1 ;; test 1\n:barbaz 2}") + "{:foo 1 ;; test 1\n :barbaz 2}")) + (is (= (reformat-string "{:foo 1 ;; test 1\n:barbaz 2\n:fuz 1}") + "{:foo 1 ;; test 1\n :barbaz 2\n :fuz 1}")))) + (deftest test-trailing-whitespace (testing "trailing-whitespace" (is (= (reformat-string "(foo bar) ") @@ -192,7 +221,7 @@ "( foo bar )\n")) (is (= (reformat-string "( foo bar ) \n( foo baz )\n" {:remove-surrounding-whitespace? false}) - "( foo bar )\n( foo baz )\n")))) + "( foo bar )\n( foo baz )\n")))) (deftest test-options (is (= (reformat-string "(foo)\n\n\n(bar)" {:remove-consecutive-blank-lines? false}) @@ -201,6 +230,8 @@ "( foo )")) (is (= (reformat-string "(foo(bar))" {:insert-missing-whitespace? false}) "(foo(bar))")) + (is (= (reformat-string "{:foo 1\n:barbaz 2}" {:align-associative? false}) + "{:foo 1\n :barbaz 2}")) (is (= (reformat-string "(foo\nbar)" {:indents '{foo [[:block 0]]}}) "(foo\n bar)")) (is (= (reformat-string "(do\nfoo\nbar)" {:indents {}})