-
-
Notifications
You must be signed in to change notification settings - Fork 652
Spec2 #3249
New issue
Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.
By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.
Already on GitHub? Sign in to your account
Spec2 #3249
Changes from all commits
File filter
Filter by extension
Conversations
Jump to
Diff view
Diff view
There are no files selected for viewing
Original file line number | Diff line number | Diff line change |
---|---|---|
|
@@ -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))) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I prefer the use of |
||
(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))) | ||
There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. Ditto. There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I don't really mind, but one advantage I see in using the There was a problem hiding this comment. Choose a reason for hiding this commentThe reason will be displayed to describe this comment to others. Learn more. I just don't like mixing APIs. For me |
||
(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) | ||
|
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,87 @@ | ||
;;; cider-browse-spec-tests.el -*- lexical-binding: t; -*- | ||
|
||
;; Copyright © 2012-2022 r0man, Bozhidar Batsov | ||
|
||
;; Author: r0man <[email protected]> | ||
;; Bozhidar Batsov <[email protected]> | ||
|
||
;; 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")))) |
There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
cl-first
is basicallycar
. :-)There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Let's leave all those
cl-
vsnth
for now? I think it is more consistent with the rest of the code in this namespace, sincecl-first
tocl-third
are actually used a LOT in this namespace. ;) WDYT?There was a problem hiding this comment.
Choose a reason for hiding this comment
The reason will be displayed to describe this comment to others. Learn more.
Fair enough, I guess I didn't pay enough attention to this bit of code when it was submitted initially.