elements could unbalance the tags, @@ -183,141 +178,136 @@ {:type "text" :content "\n"}) -(def nbsp " ") - -(defmethod process-node ParamTree [^ParamTree node stack found-closing-tags-types] - (let [{:keys [stack result]} (reduce node-reducer - {:stack stack - :result [] - :found-closing-tags-types found-closing-tags-types} - (.getDescription node))] - [stack - (reduce into [] [[newline-fragment - {:type "html" - :content (format "Param%s
%s:%s" nbsp (.getName node) nbsp)}] - result])])) - -(defmethod process-node ReturnTree [^ReturnTree node stack found-closing-tags-types] - (let [{:keys [stack result]} (reduce node-reducer - {:stack stack - :result [] - :found-closing-tags-types found-closing-tags-types} - (.getDescription node))] - [stack - (reduce into [] [[newline-fragment - {:type "html" - :content (format "Returns:%s" nbsp)}] - result])])) - -(defmethod process-node ThrowsTree [^ThrowsTree node stack found-closing-tags-types] - (let [{:keys [stack result]} (reduce node-reducer - {:stack stack - :result [] - :found-closing-tags-types found-closing-tags-types} - (.getDescription node))] +(extend-protocol NodeProcessor + ParamTree + (process-node [^ParamTree node stack found-closing-tags-types] + (let [{:keys [stack result]} (reduce node-reducer + {:stack stack + :result [] + :found-closing-tags-types found-closing-tags-types} + (.getDescription node))] + [stack + (into [newline-fragment + {:type "html" + :content (format "Param
%s: " (.getName node))}] + result)])) + + ReturnTree + (process-node [^ReturnTree node stack found-closing-tags-types] + (let [{:keys [stack result]} (reduce node-reducer + {:stack stack + :result [] + :found-closing-tags-types found-closing-tags-types} + (.getDescription node))] + [stack + (into [newline-fragment + {:type "html" + :content "Returns: "}] + result)])) + + ThrowsTree + (process-node [^ThrowsTree node stack found-closing-tags-types] + (let [{:keys [stack result]} (reduce node-reducer + {:stack stack + :result [] + :found-closing-tags-types found-closing-tags-types} + (.getDescription node))] + [stack + (into [newline-fragment + {:type "html" + :content (format "Throws:
%s: " + (.getExceptionName node))}] + result)])) + + BlockTagTree + (process-node [_node stack _] + ;; omit the tag - it makes the docstring larger on docstring UIs: + [stack []]) + + LiteralTree + (process-node [^LiteralTree node stack _] + (let [body (-> node .getBody .getBody)] + [stack + (if (= (-> node .getKind .tagName) "code") + [{:type "html" + :content (format "
%s" body)}] + [{:type "text" + :content body}])])) + + StartElementTree + (process-node [^StartElementTree node stack found-closing-tags-types] + (let [v (str (.getName node)) + self-closing? (or (.isSelfClosing node) + (and (#{"p" "hr" "li"} v) + (not (contains? found-closing-tags-types v))))] + [(cond-> stack + (not self-closing?) (conj v)) + (cond + (and (= v "p") self-closing?) + [{:type "text" + :content "\n"}] + + (= v "a") ;; turn links into code + [{:type "html" + :content "
"}]
+
+ :else
+ [{:type "html"
+ :content (str node)}])]))
+
+ EndElementTree
+ (process-node [^EndElementTree node stack _]
+ [(cond-> stack
+ (seq stack) pop)
+ [{:type "html"
+ :content (if (= (str (.getName node)) "a")
+ ""
+ (str node))}]])
+
+ TextTree
+ (process-node [^TextTree node stack _]
+ [stack [{:type (if (empty? stack) "text" "html")
+ :content (str node)}]])
+
+ LinkTree
+ (process-node [^LinkTree node stack _]
[stack
- (reduce into [] [[newline-fragment
- {:type "html"
- :content (format "Throws:%s%s:%s" nbsp (.getExceptionName node) nbsp)}] - result])])) - -(defmethod process-node BlockTagTree [_node stack _] - ;; omit the tag - it makes the docstring larger on docstring UIs: - [stack []]) - -(defmethod process-node LiteralTree [^LiteralTree node stack _] - (let [^String tag-name (-> node .getKind .tagName) - body (-> node .getBody .getBody)] + [{:type "html" + :content (format "
%s" (-> node .getReference .getSignature))}]]) + + ;; Default + Object + (process-node [node stack _] [stack - (if (-> tag-name (.equals "code")) - [{:type "html" - :content (format "
%s" body)}] - [{:type "text" - :content body}])])) - -(defmethod process-node StartElementTree [^StartElementTree node stack found-closing-tags-types] - (let [v (-> node .getName str) - self-closing? (or (.isSelfClosing node) - (and (#{"p" "hr" "li"} v) - (not (contains? found-closing-tags-types v))))] - [(cond-> stack - (not self-closing?) - (conj v)) - (cond - (and (= v "p") - self-closing?) - [{:type "text" - :content "\n"}] - - (= v "a") ;; turn links into code - [{:type "html" - :content "
"}]
-
- :else
- [{:type "html"
- :content (str node)}])]))
-
-(defmethod process-node EndElementTree [^EndElementTree node stack _]
- [(cond-> stack
- (seq stack) pop)
- [(if (-> node .getName str (.equals "a"))
- {:type "html"
- :content ""}
- {:type "html"
- :content (str node)})]])
-
-(defmethod process-node TextTree [^TextTree node stack _]
- [stack (if (empty? stack)
- [{:type "text"
- :content (str node)}]
- [{:type "html"
- :content (str node)}])])
-
-(defmethod process-node LinkTree [^LinkTree node stack _]
- [stack
- [{:type "html"
- :content (format "%s" (-> node .getReference .getSignature))}]]) + [{:type "html" + :content (str node)}]])) (defn coalesce [xs] (reduce (fn [acc {next-type :type next-content :content :as next-item}] - (let [{prev-type :type} (peek acc)] + (let [{prev-type :type, prev-content :content :as prev} (peek acc)] (if (= prev-type next-type) - (update-in acc - [(dec (count acc)) :content] - str - (if (= prev-type "text") - "\n\n" - " ") - next-content) + (conj (pop acc) (assoc prev + :content (str prev-content + (if (= prev-type "text") + "\n\n" + " ") + next-content))) (conj acc next-item)))) - [] - xs)) - -(defn remove-left-margin [s] - (->> (str/split s #"\r?\n" -1) ;; split-lines without losing trailing newlines - (map-indexed (fn [i s] - (let [first? (zero? i) - blank? (str/blank? s)] - (cond-> s - (and (not first?) - (not blank?)) - (str/replace #"^ +" ""))))) - (str/join "\n"))) + [] xs)) (defn cleanup-whitespace [fragments] - (into [] - (map (fn [{:keys [content] - content-type :type - :as x}] - (let [text? (= content-type "text")] - (assoc x :content (-> content - (str/replace #"^ +" " ") - (str/replace #" +$" " ") - (str/replace #"\s*\n+\s*\n+\s*" "\n\n") - (str/replace #"\n +$" "\n") - (cond-> text? remove-left-margin - text? (str/replace #"^ +\." ".") - text? (str/replace #"^ +," ","))))))) + (mapv (fn [{:keys [content] + content-type :type + :as x}] + (let [text? (= content-type "text")] + (assoc x :content (-> content + (str/replace #"^ +" " ") + (str/replace #" +$" " ") + (str/replace #"\s*\n+\s*\n+\s*" "\n\n") + (str/replace #"\n +$" "\n") + (cond-> text? (str/replace #"\n +" "\n") + text? (str/replace #"^ +\." ".") + text? (str/replace #"^ +," ",")))))) fragments)) (defn docstring @@ -326,8 +316,8 @@ (let [^DocCommentTree comment-tree (some-> env .getDocTrees (.getDocCommentTree e)) - full-body-raw (some->> comment-tree .getFullBody) - block-tags-raw (some->> comment-tree .getBlockTags) + full-body-raw (some-> comment-tree .getFullBody) + block-tags-raw (some-> comment-tree .getBlockTags) found-closing-tags-types (into #{} (keep #(when (instance? EndElementTree %) (str (.getName ^EndElementTree %)))) diff --git a/test/orchard/eldoc_test.clj b/test/orchard/eldoc_test.clj index d20b0504..aa77a732 100644 --- a/test/orchard/eldoc_test.clj +++ b/test/orchard/eldoc_test.clj @@ -2,65 +2,59 @@ (:require [clojure.test :refer [deftest is testing]] [orchard.eldoc :as eldoc] - [orchard.info :as info])) - -;; test data -(def test-eldoc-info {:arglists '([x] [x y])}) - -(def test-eldoc-info-special-form {:forms ['(.instanceMember instance args*) - '(.instanceMember Classname args*) - '(Classname/staticMethod args*) - 'Classname/staticField] - :special-form true}) - -(def test-eldoc-info-candidates - {:candidates '{X {:arglists ([x])} - Y {:arglists ([x] [x y z])} - Z {:arglists ([])}}}) + [orchard.info :as info] + [orchard.test.util :refer [is+]])) (deftest test-eldoc (testing "arglist extraction" - (is (= (:eldoc (eldoc/eldoc test-eldoc-info)) '(["x"] ["x" "y"]))) - (is (= (:eldoc (eldoc/eldoc test-eldoc-info-candidates)) - '([] ["x"] ["x" "y" "z"]))) - (is (= (:eldoc (eldoc/eldoc test-eldoc-info-special-form)) - '([".instanceMember" "instance" "args*"] - [".instanceMember" "Classname" "args*"] - ["Classname/staticMethod" "args*"] - ["Classname/staticField"]))) + (is+ {:eldoc '(["x"] ["x" "y"])} + (eldoc/eldoc {:arglists '([x] [x y])})) + (is+ {:eldoc '([] ["x"] ["x" "y" "z"])} + (eldoc/eldoc {:candidates '{X {:arglists ([x])} + Y {:arglists ([x] [x y z])} + Z {:arglists ([])}}})) + (is+ {:eldoc '([".instanceMember" "instance" "args*"] + [".instanceMember" "Classname" "args*"] + ["Classname/staticMethod" "args*"] + ["Classname/staticField"])} + (eldoc/eldoc {:forms ['(.instanceMember instance args*) + '(.instanceMember Classname args*) + '(Classname/staticMethod args*) + 'Classname/staticField] + :special-form true})) ;; sanity checks and special cases (is (:eldoc (eldoc/eldoc (info/info 'clojure.core 'map)))) (is (:eldoc (eldoc/eldoc (info/info 'clojure.core '.toString)))) (is (:eldoc (eldoc/eldoc (info/info 'clojure.core '.)))) - (is (not (:eldoc (eldoc/eldoc (info/info 'clojure.core (gensym "non-existing"))))))) + (is (nil? (:eldoc (eldoc/eldoc (info/info 'clojure.core 'non-existing)))))) (testing "Clojure result structure" - (let [result (eldoc/eldoc (info/info 'clojure.core 'map))] - (is (:ns result)) - (is (:name result)) - (is (:type result)) - (is (:eldoc result)) - (is (:docstring result)))) + (is+ {:ns some? + :name some? + :type some? + :eldoc some? + :docstring some?} + (eldoc/eldoc (info/info 'clojure.core 'map)))) (testing "Clojure special form" - (let [result (eldoc/eldoc (info/info 'clojure.core 'if))] - (is (= (:type result) "special-form")))) + (is+ {:type "special-form"} + (eldoc/eldoc (info/info 'clojure.core 'if)))) (testing "Clojure macro" - (let [result (eldoc/eldoc (info/info 'clojure.core 'when))] - (is (= (:type result) "macro")))) + (is+ {:type "macro"} + (eldoc/eldoc (info/info 'clojure.core 'when)))) (testing "Clojure function" - (let [result (eldoc/eldoc (info/info 'clojure.core 'inc))] - (is (= (:type result) "function")))) + (is+ {:type "function"} + (eldoc/eldoc (info/info 'clojure.core 'inc)))) (testing "Java result structure" - (let [result (eldoc/eldoc (info/info-java 'java.lang.String 'toLowerCase))] - (is (:class result)) - (is (:member result)) - (is (:type result)) - (is (:eldoc result))))) + (is+ {:class some? + :member some? + :type some? + :eldoc some?} + (eldoc/eldoc (info/info-java 'java.lang.String 'toLowerCase))))) ;;;; eldoc datomic query (def testing-datomic-query '[:find ?x @@ -70,21 +64,21 @@ (deftest datomic-query-test (testing "eldoc of inline datomic query" - (let [response (eldoc/datomic-query "user" "'[:find ?x :in $ % ?person-id]")] - (is (= (:inputs response) '(["$" "%" "?person-id"]))))) + (is+ {:inputs '(["$" "%" "?person-id"])} + (eldoc/datomic-query "user" "'[:find ?x :in $ % ?person-id]"))) (testing "eldoc of inline datomic query as map" - (let [response (eldoc/datomic-query "user" "'{:find [?x] :in [$ % ?person-id]}")] - (is (= (:inputs response) '(["$" "%" "?person-id"]))))) + (is+ {:inputs '(["$" "%" "?person-id"])} + (eldoc/datomic-query "user" "'{:find [?x] :in [$ % ?person-id]}"))) (testing "eldoc of datomic query defined as symbol" - (let [response (eldoc/datomic-query "orchard.eldoc-test" "testing-datomic-query")] - (is (= (:inputs response) '(["$" "?name"]))))) + (is+ {:inputs '(["$" "?name"])} + (eldoc/datomic-query "orchard.eldoc-test" "testing-datomic-query"))) (testing "eldoc of inline datomic query without :in" - (let [response (eldoc/datomic-query "user" "'[:find ?x]")] - (is (= (:inputs response) '(["$"]))))) + (is+ {:inputs '(["$"])} + (eldoc/datomic-query "user" "'[:find ?x]"))) (testing "eldoc of inline datomic query as map without :in" - (let [response (eldoc/datomic-query "user" "'{:find ?x}")] - (is (= (:inputs response) '(["$"])))))) + (is+ {:inputs '(["$"])} + (eldoc/datomic-query "user" "'{:find ?x}")))) diff --git a/test/orchard/java_test.clj b/test/orchard/java_test.clj index 5acdb15e..1b5c2f42 100644 --- a/test/orchard/java_test.clj +++ b/test/orchard/java_test.clj @@ -51,25 +51,23 @@ {:post [(> (count %) 50)]} (->> (util/imported-classes 'clojure.core) - (into ['java.util.Map 'java.io.File]) + (into ['java.util.Map 'java.io.File 'clojure.lang.Compiler]) (into (util/imported-classes (-> ::_ namespace symbol))) ;; Remove classes without methods: - (remove (some-fn - #{`ThreadDeath - `Void - `RuntimePermission - 'clojure.core.Vec - 'clojure.core.VecNode - 'clojure.core.VecSeq - 'clojure.core.ArrayChunk - 'clojure.core.Eduction - ;; Currently doesn't work for LruMap. - 'mx.cider.orchard.LruMap} - (fn [s] - (or (-> s str Class/forName .isInterface) - (-> s str Class/forName .isEnum))) - (fn [s] - (->> s str (re-find #"(Exception|Error)$"))))))) + (remove #(or (#{`ThreadDeath + `Void + `RuntimePermission + 'clojure.core.Vec + 'clojure.core.VecNode + 'clojure.core.VecSeq + 'clojure.core.ArrayChunk + 'clojure.core.Eduction + ;; Currently doesn't work for LruMap. + 'mx.cider.orchard.LruMap} %) + (-> % str Class/forName .isInterface) + (-> % str Class/forName .isEnum) + (re-find #"(Exception|Error)$" (str %)))) + vec)) (defn extract-method-arities [class-symbol info] {:pre [(symbol? class-symbol)]} @@ -85,7 +83,7 @@ (when (and jdk11+? util/jdk-sources-present?) (deftest map-structure-test (testing "Parsed map structure = reflected map structure" - (doseq [class-sym (conj (class-corpus) 'clojure.lang.Compiler)] + (doseq [class-sym (class-corpus)] (testing class-sym (let [excluded-cols #{:file :line :column :doc :argnames :non-generic-argtypes :annotated-arglists :doc-first-sentence-fragments :doc-fragments :doc-block-tags-fragments :argtypes :path :resource-url} @@ -444,10 +442,8 @@ (is (nil? (resolve-symbol (*ns) '.random.bunch/of$junk)))))) (defn- replace-last-dot [^String s] - (if (re-find #"(.*\.)" s) - (str (second (re-matches #"(.*)(\..*)" s)) - "$" - (subs s (inc (.lastIndexOf s ".")))) + (if (str/includes? s ".") + (str/replace s #"\.([^\.]+)$" "\\$$1") s)) (when (and util/jdk-sources-present? jdk11+?)