[nongnu] elpa/cider d08609feb7 3/3: Add support for Clojure Spec 2

[ELPA Syncer]

branch: elpa/cider
commit d08609feb7141b8dbece6abb958bddd4ef0129d5
Author: Roman Scherer <roman@burningswell.com>
Commit: Bozhidar Batsov <bozhidar@batsov.dev>

    Add support for Clojure Spec 2
---
 CHANGELOG.md                                    |  4 ++
 cider-browse-spec.el                            | 87 ++++++++++++++++++++++++-
 doc/modules/ROOT/pages/usage/misc_features.adoc | 18 +++++
 test/cider-browse-spec-tests.el                 | 87 +++++++++++++++++++++++++
 4 files changed, 194 insertions(+), 2 deletions(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 7b7cdf929e..caac9cba15 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -2,6 +2,10 @@
 
 ## master (unreleased)
 
+### New features
+
+- [#3249](https://github.com/clojure-emacs/cider/pull/3249): Add support for 
Clojure Spec 2.
+
 ### Changes
 
 - Bump the injected nREPL version to 1.0.
diff --git a/cider-browse-spec.el b/cider-browse-spec.el
index f111dd63b1..71ba70684f 100644
--- a/cider-browse-spec.el
+++ b/cider-browse-spec.el
@@ -142,7 +142,79 @@ Display TITLE at the top and SPECS are indented 
underneath."
 
 (defun cider--spec-fn-p (value fn-name)
   "Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME."
-  (string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\)/" fn-name 
"$") value))
+  (string-match-p (concat 
"^\\(clojure.spec\\|clojure.spec.alpha\\|clojure.alpha.spec\\)/" fn-name "$") 
value))
+
+(defun cider-browse-spec--render-schema-map (spec-form)
+  "Render the s/schema map declaration SPEC-FORM."
+  (let ((name-spec-pairs (seq-partition (cdaadr spec-form) 2)))
+    (format "(s/schema\n {%s})"
+            (string-join
+             (thread-last
+               (seq-sort-by #'car #'string< name-spec-pairs)
+               (mapcar (lambda (s) (concat (cl-first s) " " 
(cider-browse-spec--pprint (cl-second s))))))
+             "\n  "))))
+
+(defun cider-browse-spec--render-schema-vector (spec-form)
+  "Render the s/schema vector declaration SPEC-FORM."
+  (format "(s/schema\n [%s])"
+          (string-join
+           (thread-last
+             (cl-second spec-form)
+             (mapcar (lambda (s) (cider-browse-spec--pprint s))))
+           "\n  ")))
+
+(defun cider-browse-spec--render-schema (spec-form)
+  "Render the s/schema SPEC-FORM."
+  (let ((schema-args (cl-second spec-form)))
+    (if (and (listp schema-args)
+             (nrepl-dict-p (cl-first schema-args)))
+        (cider-browse-spec--render-schema-map spec-form)
+      (cider-browse-spec--render-schema-vector spec-form))))
+
+(defun cider-browse-spec--render-select (spec-form)
+  "Render the s/select SPEC-FORM."
+  (let ((keyset (cl-second spec-form))
+        (selection (cl-third spec-form)))
+    (format "(s/select\n %s\n [%s])"
+            (cider-browse-spec--pprint keyset)
+            (string-join
+             (thread-last
+               selection
+               (mapcar (lambda (s) (cider-browse-spec--pprint s))))
+             "\n  "))))
+
+(defun cider-browse-spec--render-union (spec-form)
+  "Render the s/union SPEC-FORM."
+  (let ((keyset (cl-second spec-form))
+        (selection (cl-third spec-form)))
+    (format "(s/union\n %s\n [%s])"
+            (cider-browse-spec--pprint keyset)
+            (string-join
+             (thread-last
+               selection
+               (mapcar (lambda (s) (cider-browse-spec--pprint s))))
+             "\n  "))))
+
+(defun cider-browse-spec--render-vector (spec-form)
+  "Render SPEC-FORM as a vector."
+  (format "[%s]" (string-join (mapcar #'cider-browse-spec--pprint spec-form))))
+
+(defun cider-browse-spec--render-map-entry (spec-form)
+  "Render SPEC-FORM as a map entry."
+  (let ((key (cl-first spec-form))
+        (value (cl-second spec-form)))
+    (format "%s %s" (cider-browse-spec--pprint key)
+            (if (listp value)
+                (cider-browse-spec--render-vector value)
+              (cider-browse-spec--pprint value)))))
+
+(defun cider-browse-spec--render-map (spec-form)
+  "Render SPEC-FORM as a map."
+  (let ((map-entries (cl-rest spec-form)))
+    (format "{%s}" (thread-last
+                     (seq-partition map-entries 2)
+                     (seq-map #'cider-browse-spec--render-map-entry)
+                     (string-join)))))
 
 (defun cider-browse-spec--pprint (form)
   "Given a spec FORM builds a multi line string with a pretty render of that 
FORM."
@@ -158,7 +230,7 @@ Display TITLE at the top and SPECS are indented underneath."
            ;; and remove all clojure.core ns
            (thread-last
              form
-             (replace-regexp-in-string 
"^\\(clojure.spec\\|clojure.spec.alpha\\)/" "s/")
+             (replace-regexp-in-string 
"^\\(clojure.spec\\|clojure.spec.alpha\\|clojure.alpha.spec\\)/" "s/")
              (replace-regexp-in-string "^\\(clojure.core\\)/" ""))))
 
         ((and (listp form) (stringp (cl-first form)))
@@ -254,10 +326,21 @@ Display TITLE at the top and SPECS are indented 
underneath."
                                  (cider-browse-spec--pprint (cl-second s)))))
                (cl-reduce #'concat)
                (format "%s")))
+            ;; prettier (s/schema )
+            ((cider--spec-fn-p form-tag "schema")
+             (cider-browse-spec--render-schema form))
+            ;; prettier (s/select )
+            ((cider--spec-fn-p form-tag "select")
+             (cider-browse-spec--render-select form))
+            ;; prettier (s/union )
+            ((cider--spec-fn-p form-tag "union")
+             (cider-browse-spec--render-union form))
             ;; every other with no special management
             (t (format "(%s %s)"
                        (cider-browse-spec--pprint form-tag)
                        (string-join (mapcar #'cider-browse-spec--pprint 
(cl-rest form)) " "))))))
+        ((nrepl-dict-p form)
+         (cider-browse-spec--render-map form))
         (t (format "%s" form))))
 
 (defun cider-browse-spec--pprint-indented (spec-form)
diff --git a/doc/modules/ROOT/pages/usage/misc_features.adoc 
b/doc/modules/ROOT/pages/usage/misc_features.adoc
index 607b2952cf..96f0bfc6a1 100644
--- a/doc/modules/ROOT/pages/usage/misc_features.adoc
+++ b/doc/modules/ROOT/pages/usage/misc_features.adoc
@@ -318,6 +318,24 @@ meets the spec.
 
 image::spec_browser_gen_example.png[Spec Browser Example]
 
+== Clojure Spec Versions
+
+Clojure Spec has a bit of a history and is available in a couple of
+flavours:
+
+* `spec` (aka `clojure.spec`, the original release, never shipped with Clojure)
+* `spec-alpha` (aka `clojure.spec.alpha`, the original release under a 
different name, ships with Clojure)
+* `spec-alpha-2` (aka `clojure.alpha.spec`, the evolution, separate library, 
but still experimental)
+
+Cider supports the whole mix, but with a twist.
+
+* When Cider shows a list of specs, the keys from all registries are
+  shown. Registries are merged together from newest to oldest.
+
+* When Cider operates on a spec, like looking up a spec or generating
+  data for it, the operation is tried against all registries, from
+  newest to oldest, with the first successful operation winning.
+
 == Formatting Code with cljfmt
 
 While CIDER has it's own code formatting (indentation) engine, you can also
diff --git a/test/cider-browse-spec-tests.el b/test/cider-browse-spec-tests.el
new file mode 100644
index 0000000000..9096f50d42
--- /dev/null
+++ b/test/cider-browse-spec-tests.el
@@ -0,0 +1,87 @@
+;;; cider-browse-spec-tests.el  -*- lexical-binding: t; -*-
+
+;; Copyright © 2012-2022 r0man, Bozhidar Batsov
+
+;; Author: r0man <roman@burningswell.com>
+;;         Bozhidar Batsov <bozhidar@batsov.dev>
+
+;; This file is NOT part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see `http://www.gnu.org/licenses/'.
+
+;;; Commentary:
+
+;; This file is part of CIDER
+
+;;; Code:
+
+(require 'buttercup)
+(require 'cider-browse-spec)
+
+(defvar cider-browse-spec-tests--schema-vector-response
+  '("clojure.alpha.spec/schema"
+    (":example.customer/id" ":example.customer/name"))
+  "The NREPL response for a s/schema vector spec.")
+
+(defvar cider-browse-spec-tests--schema-map-response
+  '("clojure.alpha.spec/schema"
+    ((dict ":id" ":example.customer/id"
+           ":name" ":example.customer/name")))
+  "The NREPL response for a s/schema map spec.")
+
+(defvar cider-browse-spec-tests--company-addr-response
+  '("clojure.alpha.spec/union" ":test/addr"
+    (":test/company" ":test/suite"))
+  "The NREPL response for the :user/company-addr spec.")
+
+(defvar cider-browse-spec-tests--movie-times-user-response
+  '("clojure.alpha.spec/select" ":test/user"
+    (":test/id" ":test/addr"
+     (dict ":test/addr"
+           (":test/zip"))))
+  "The NREPL response for the :user/movie-times-user spec.")
+
+(defun cider-browse-spec-tests--setup-spec-form (spec-form)
+  "Setup the mocks to test rendering of SPEC-FORM."
+  (spy-on 'sesman-current-session :and-return-value t)
+  (spy-on 'cider-nrepl-op-supported-p :and-return-value t)
+  (spy-on 'cider-connected-p :and-return-value nil)
+  (spy-on 'cider--get-symbol-indent :and-return-value nil)
+  (spy-on 'cider-sync-request:spec-form :and-return-value spec-form))
+
+(describe "cider-browse-spec--browse"
+  (it "raises user-error when cider is not connected."
+    (spy-on 'sesman-current-session :and-return-value nil)
+    (expect (cider-browse-spec--browse ":example/customer") :to-throw 
'user-error))
+
+  (it "raises user-error when the `spec-form' op is not supported."
+    (spy-on 'sesman-current-session :and-return-value t)
+    (spy-on 'cider-nrepl-op-supported-p :and-return-value nil)
+    (expect (cider-browse-spec--browse ":example/customer") :to-throw 
'user-error))
+
+  (it "renders a s/schema map form"
+    (cider-browse-spec-tests--setup-spec-form 
cider-browse-spec-tests--schema-map-response)
+    (expect (cider-browse-spec--browse ":example/customer")))
+
+  (it "renders a s/schema vector form"
+    (cider-browse-spec-tests--setup-spec-form 
cider-browse-spec-tests--schema-vector-response)
+    (expect (cider-browse-spec--browse ":example/customer")))
+
+  (it "renders a s/select form"
+    (cider-browse-spec-tests--setup-spec-form 
cider-browse-spec-tests--movie-times-user-response)
+    (expect (cider-browse-spec--browse ":user/movie-times-user")))
+
+  (it "renders a s/union form"
+    (cider-browse-spec-tests--setup-spec-form 
cider-browse-spec-tests--company-addr-response)
+    (expect (cider-browse-spec--browse ":user/company-addr"))))