luciano/specter
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add arglist metadata to navs. (#290)

Browse source
This commit is contained in:
Adrian 2020-08-16 16:40:02 -07:00 committed by GitHub
parent 40add561b6
commit e222ba2a6c
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
2 changed files with 59 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

66
src/clj/com/rpl/specter.cljc
View file

@ -115,7 +115,32 @@
(providepath ~self-sym ~path) (providepath ~self-sym ~path)
~self-sym))))) ~self-sym)))))
;; copied from tools.macro to avoid the dependency ;; copied from clojure.core
(def
^{:private true}
sigs
(fn [fdecl]
(let [asig
(fn [fdecl]
(let [arglist (first fdecl)
;; elide implicit macro args
arglist (if (= '&form (first arglist))
(subvec arglist 2 (count arglist))
arglist)
body (next fdecl)]
(if (map? (first body))
(if (next body)
(with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body)))
arglist)
arglist)))]
(if (seq? (first fdecl))
(loop [ret [] fdecls fdecl]
(if fdecls
(recur (conj ret (asig (first fdecls))) (next fdecls))
(seq ret)))
(list (asig fdecl))))))
;; partially copied from clojure.core/defn
(defn- name-with-attributes (defn- name-with-attributes
"To be used in macro definitions. "To be used in macro definitions.
Handles optional docstrings and attribute maps for a name to be defined Handles optional docstrings and attribute maps for a name to be defined
@ -126,20 +151,31 @@
macro argument list. The return value is a vector containing the name macro argument list. The return value is a vector containing the name
with its extended metadata map and the list of unprocessed macro with its extended metadata map and the list of unprocessed macro
arguments." arguments."
[name macro-args] [name fdecl]
(let [[docstring macro-args] (if (string? (first macro-args)) (let [m (if (string? (first fdecl))
[(first macro-args) (next macro-args)] {:doc (first fdecl)}
[nil macro-args]) {})
[attr macro-args] (if (map? (first macro-args))
[(first macro-args) (next macro-args)] fdecl (if (string? (first fdecl))
[{} macro-args]) (next fdecl)
attr (if docstring fdecl)
(assoc attr :doc docstring) m (if (map? (first fdecl))
attr) (conj m (first fdecl))
attr (if (meta name) m)
(conj (meta name) attr) fdecl (if (map? (first fdecl))
attr)] (next fdecl)
[(with-meta name attr) macro-args])) fdecl)
fdecl (if (vector? (first fdecl))
(list fdecl)
fdecl)
m (if (map? (last fdecl))
(conj m (last fdecl))
m)
fdecl (if (map? (last fdecl))
(butlast fdecl)
fdecl)
m (conj {:arglists (list 'quote (sigs fdecl))} m)]
[(with-meta name m) fdecl]))
(defmacro dynamicnav [& args] (defmacro dynamicnav [& args]
`(vary-meta (wrap-dynamic-nav (fn ~@args)) assoc :dynamicnav true)) `(vary-meta (wrap-dynamic-nav (fn ~@args)) assoc :dynamicnav true))

11
src/clj/com/rpl/specter/macros.clj
View file

@ -39,11 +39,16 @@
(let [helpers (for [[mname [_ & mparams] & mbody] impls] (let [helpers (for [[mname [_ & mparams] & mbody] impls]
`(defn ~(helper-name name mname) [~@params ~@mparams] ~@mbody)) `(defn ~(helper-name name mname) [~@params ~@mparams] ~@mbody))
decls (for [[mname & _] impls] decls (for [[mname & _] impls]
`(declare ~(helper-name name mname)))] `(declare ~(helper-name name mname)))
name-with-meta (vary-meta name
assoc :arglists (list 'quote (list params)))]
`(do `(do
~@decls ~@decls
~@helpers ~@helpers
(def ~name (nav ~params ~@impls))))) (def ~name-with-meta (nav ~params ~@impls)))))
(defmacro defrichnav [name params & impls] (defmacro defrichnav [name params & impls]
`(def ~name (richnav ~params ~@impls))) (let [name-with-meta (vary-meta name
assoc :arglists (list 'quote (list params)))]
`(def ~name-with-meta
(richnav ~params ~@impls))))