Skip to content

Commit c9819f7

Browse files
committed
wip
1 parent 35de78a commit c9819f7

File tree

8 files changed

+218
-4
lines changed

8 files changed

+218
-4
lines changed
Lines changed: 46 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,46 @@
1+
(ns compojure-api-kondo-hooks.plumbing.core
2+
"Utility belt for Clojure in the wild"
3+
(:refer-clojure :exclude [update])
4+
(:require
5+
[schema.utils :as schema-utils]
6+
[schema.macros :as schema-macros]
7+
[plumbing.fnk.schema :as schema]
8+
[compojure-api-kondo-hooks.plumbing.fnk.impl :as fnk-impl]))
9+
10+
(defmacro letk
11+
"Keyword let. Accepts an interleaved sequence of binding forms and map forms like:
12+
(letk [[a {b 2} [:f g h] c d {e 4} :as m & more] a-map ...] & body)
13+
a, c, d, and f are required keywords, and letk will barf if not in a-map.
14+
b and e are optional, and will be bound to default values if not present.
15+
g and h are required keys in the map found under :f.
16+
m will be bound to the entire map (a-map).
17+
more will be bound to all the unbound keys (ie (dissoc a-map :a :b :c :d :e)).
18+
:as and & are both optional, but must be at the end in the specified order if present.
19+
The same symbol cannot be bound multiple times within the same destructing level.
20+
21+
Optional values can reference symbols bound earlier within the same binding, i.e.,
22+
(= [2 2] (let [a 1] (letk [[a {b a}] {:a 2}] [a b]))) but
23+
(= [2 1] (let [a 1] (letk [[{b a} a] {:a 2}] [a b])))
24+
25+
If present, :as and :& symbols are bound before other symbols within the binding.
26+
27+
Namespaced keys are supported by specifying fully-qualified key in binding form. The bound
28+
symbol uses the _name_ portion of the namespaced key, i.e,
29+
(= 1 (letk [[a/b] {:a/b 1}] b)).
30+
31+
Map destructuring bindings can be mixed with ordinary symbol bindings."
32+
[bindings & body]
33+
(schema/assert-iae (vector? bindings) "Letk binding must be a vector")
34+
(schema/assert-iae (even? (count bindings)) "Letk binding must have even number of elements")
35+
(reduce
36+
(fn [cur-body-form [bind-form value-form]]
37+
(if (symbol? bind-form)
38+
`(let [~bind-form ~value-form] ~cur-body-form)
39+
(let [{:keys [map-sym body-form]} (fnk-impl/letk-input-schema-and-body-form
40+
&env
41+
bind-form ;(fnk-impl/ensure-schema-metadata &env bind-form)
42+
[]
43+
cur-body-form)]
44+
`(let [~map-sym ~value-form] ~body-form))))
45+
`(do ~@body)
46+
(reverse (partition 2 bindings))))
Lines changed: 116 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,116 @@
1+
(ns compojure-api-kondo-hooks.plumbing.fnk.impl
2+
(:require
3+
[clojure.set :as set]
4+
[schema.core :as-alias s]
5+
[compojure-api-kondo-hooks.schema.macros :as schema-macros]))
6+
7+
;;;;; Helpers
8+
9+
(defn name-sym
10+
"Returns symbol of x's name.
11+
Converts a keyword/string to symbol, or removes namespace (if any) of symbol"
12+
[x]
13+
(with-meta (symbol (name x)) (meta x)))
14+
15+
;;; Parsing new fnk binding style
16+
17+
(declare letk-input-schema-and-body-form)
18+
19+
(defn- process-schematized-map
20+
"Take an optional binding map like {a 2} or {a :- Number 2} and convert the schema
21+
information to canonical metadata, if present."
22+
[env binding]
23+
(case (count binding)
24+
1 (let [[sym v] (first binding)]
25+
{sym v})
26+
27+
2 (let [[[[sym _]] [[schema v]]] ((juxt filter remove) #(= (val %) :-) binding)]
28+
{sym v})))
29+
30+
;; TODO: unify this with positional version.
31+
(defn letk-arg-bind-sym-and-body-form
32+
"Given a single element of a single letk binding form and a current body form, return
33+
a map {:schema-entry :body-form} where schema-entry is a tuple
34+
[bound-key schema external-schema?], and body-form wraps body with destructuring
35+
for this binding as necessary."
36+
[env map-sym binding key-path body-form]
37+
(cond (symbol? binding)
38+
{:schema-entry []
39+
:body-form `(let [~(name-sym binding) (get ~map-sym ~(keyword binding) ~key-path)]
40+
~body-form)}
41+
42+
(map? binding)
43+
(let [schema-fixed-binding (process-schematized-map env binding)
44+
[bound-sym opt-val-expr] (first schema-fixed-binding)
45+
bound-key (keyword bound-sym)]
46+
{:schema-entry []
47+
:body-form `(let [~(name-sym bound-sym) (get ~map-sym ~bound-key ~opt-val-expr)]
48+
~body-form)})
49+
50+
(vector? binding)
51+
(let [[bound-key & more] binding
52+
{inner-input-schema :input-schema
53+
inner-external-input-schema :external-input-schema
54+
inner-map-sym :map-sym
55+
inner-body-form :body-form} (letk-input-schema-and-body-form
56+
env
57+
(with-meta (vec more) (meta binding))
58+
(conj key-path bound-key)
59+
body-form)]
60+
{:schema-entry []
61+
:body-form `(let [~inner-map-sym (get ~map-sym ~bound-key ~key-path)]
62+
~inner-body-form)})
63+
64+
:else (throw (ex-info (format "bad binding: %s" binding) {}))))
65+
66+
(defn- extract-special-args
67+
"Extract trailing & sym and :as sym, possibly with schema metadata. Returns
68+
[more-bindings special-args-map] where special-args-map is a map from each
69+
special symbol found to the symbol that was found."
70+
[env special-arg-signifier-set binding-form]
71+
{:pre [(set? special-arg-signifier-set)]}
72+
(let [[more-bindings special-bindings] (split-with (complement special-arg-signifier-set) binding-form)]
73+
(loop [special-args-map {}
74+
special-arg-set special-arg-signifier-set
75+
[arg-signifier & other-bindings :as special-bindings] special-bindings]
76+
(if-not (seq special-bindings)
77+
[more-bindings special-args-map]
78+
(do
79+
(let [[sym remaining-bindings] (schema-macros/extract-arrow-schematized-element env other-bindings)]
80+
(recur (assoc special-args-map arg-signifier sym)
81+
(disj special-arg-set arg-signifier)
82+
remaining-bindings)))))))
83+
84+
(defn letk-input-schema-and-body-form
85+
"Given a single letk binding form, value form, key path, and body
86+
form, return a map {:input-schema :external-input-schema :map-sym :body-form}
87+
where input-schema is the schema imposed by binding-form, external-input-schema
88+
is like input-schema but includes user overrides for binding vectors,
89+
map-sym is the symbol which it expects the bound value to be bound to,
90+
and body-form wraps body in the bindings from binding-form from map-sym."
91+
[env binding-form key-path body-form]
92+
(let [[bindings {more-sym '& as-sym :as}] (extract-special-args env #{'& :as} binding-form)
93+
as-sym (or as-sym (gensym "map"))
94+
[input-schema-elts
95+
external-input-schema-elts
96+
bound-body-form] (reduce
97+
(fn [[input-schema-elts external-input-schema-elts cur-body] binding]
98+
(let [{:keys [schema-entry body-form]}
99+
(letk-arg-bind-sym-and-body-form
100+
env as-sym binding key-path cur-body)
101+
[bound-key input-schema external-input-schema] schema-entry]
102+
[(conj input-schema-elts [bound-key input-schema])
103+
(conj external-input-schema-elts
104+
[bound-key (or external-input-schema input-schema)])
105+
body-form]))
106+
[[] [] body-form]
107+
(reverse
108+
(schema-macros/process-arrow-schematized-args
109+
env bindings)))
110+
explicit-schema-keys []
111+
final-body-form (if more-sym
112+
`(let [~more-sym (dissoc ~as-sym ~@explicit-schema-keys)]
113+
~bound-body-form)
114+
bound-body-form)]
115+
{:map-sym as-sym
116+
:body-form final-body-form}))
Lines changed: 16 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,16 @@
1+
2+
(s/defn unwrap-schema-form-key :- (s/maybe (s/pair s/Keyword "k" s/Bool "optional?"))
3+
"Given a possibly-unevaluated schema map key form, unpack an explicit keyword
4+
and optional? flag, or return nil for a non-explicit key"
5+
[k]
6+
(cond (s/specific-key? k)
7+
[(s/explicit-schema-key k) (s/required-key? k)]
8+
9+
;; Deal with `(s/optional-key k) form from impl
10+
(and (sequential? k) (not (vector? k)) (= (count k) 2)
11+
(= (first k) 'schema.core/optional-key))
12+
[(second k) false]
13+
14+
;; Deal with `(with-meta ...) form from impl
15+
(and (sequential? k) (not (vector? k)) (= (first k) `with-meta))
16+
(unwrap-schema-form-key (second k))))
Lines changed: 24 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,24 @@
1+
(ns compojure-api-kondo-hooks.schema.macros)
2+
3+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4+
;;; Helpers for processing and normalizing element/argument schemas in s/defrecord and s/(de)fn
5+
6+
(defn extract-arrow-schematized-element
7+
"Take a nonempty seq, which may start like [a ...] or [a :- schema ...], and return
8+
a list of [first-element-with-schema-attached rest-elements]"
9+
[env s]
10+
(assert (seq s))
11+
(let [[f & more] s]
12+
(if (= :- (first more))
13+
[f (drop 2 more)]
14+
[f more])))
15+
16+
(defn process-arrow-schematized-args
17+
"Take an arg vector, in which each argument is followed by an optional :- schema,
18+
and transform into an ordinary arg vector where the schemas are metadata on the args."
19+
[env args]
20+
(loop [in args out []]
21+
(if (empty? in)
22+
out
23+
(let [[arg more] (extract-arrow-schematized-element env in)]
24+
(recur more (conj out arg))))))

examples/clj-kondo-hooks/.clj-kondo/imports/metosin/compojure-api/compojure/api/meta.clj

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,8 @@
33
[compojure.api.common :as common :refer [extract-parameters]]
44
[compojure.api.middleware #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) mw]
55
[compojure.api.routes #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) routes]
6-
[plumbing.core #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) p]
6+
#?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" [compojure-api-kondo-hooks.plumbing.core :as p]
7+
:default [plumbing.core :as p])
78
[plumbing.fnk.impl #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) fnk-impl]
89
[ring.swagger.common #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) rsc]
910
[ring.swagger.json-schema #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) js]
@@ -388,6 +389,7 @@
388389
form (if (seq letks) `(p/letk ~letks ~form) form)
389390
form (if (seq lets) `(let ~lets ~form) form)
390391
form `(comp-core/context ~path ~arg-with-request ~form)]
392+
(prn "context" form)
391393
form)
392394

393395
;; endpoints
@@ -398,6 +400,7 @@
398400
form `(fn [~'+compojure-api-request+]
399401
~'+compojure-api-request+ ;;always used
400402
~form)]
403+
(prn "endpoint" form)
401404
form)))
402405
:default ;; JVM
403406
(if context?
Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,6 @@
11
src/compojure_api_example/clj_kondo_hooks.clj:26:20: error: keyword :ok is called with 0 args but expects 1 or 2
22
src/compojure_api_example/clj_kondo_hooks.clj:30:21: error: keyword :ok is called with 0 args but expects 1 or 2
3-
src/compojure_api_example/clj_kondo_hooks.clj:38:44: error: Unresolved symbol: req
3+
src/compojure_api_example/clj_kondo_hooks.clj:33:17: error: Unresolved symbol: req
4+
src/compojure_api_example/clj_kondo_hooks.clj:35:25: error: Unresolved symbol: body
5+
src/compojure_api_example/clj_kondo_hooks.clj:38:17: error: Unresolved symbol: _
6+
src/compojure_api_example/clj_kondo_hooks.clj:46:29: error: Unresolved symbol: qparam

resources/clj-kondo.exports/metosin/compojure-api/compojure/api/meta.clj

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,8 @@
33
[compojure.api.common :as common :refer [extract-parameters]]
44
[compojure.api.middleware #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) mw]
55
[compojure.api.routes #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) routes]
6-
[plumbing.core #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) p]
6+
#?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" [compojure-api-kondo-hooks.plumbing.core :as p]
7+
:default [plumbing.core :as p])
78
[plumbing.fnk.impl #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) fnk-impl]
89
[ring.swagger.common #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) rsc]
910
[ring.swagger.json-schema #?(:default #_"the redundant :default is intentional, see ./scripts/regen_kondo_config.clj" :as-alias :default :as) js]
@@ -388,6 +389,7 @@
388389
form (if (seq letks) `(p/letk ~letks ~form) form)
389390
form (if (seq lets) `(let ~lets ~form) form)
390391
form `(comp-core/context ~path ~arg-with-request ~form)]
392+
(prn "context" form)
391393
form)
392394

393395
;; endpoints
@@ -398,6 +400,7 @@
398400
form `(fn [~'+compojure-api-request+]
399401
~'+compojure-api-request+ ;;always used
400402
~form)]
403+
(prn "endpoint" form)
401404
form)))
402405
:default ;; JVM
403406
(if context?

src/compojure/api/meta.cljc

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3,7 +3,8 @@
33
[compojure.api.common :as common :refer [extract-parameters]]
44
[compojure.api.middleware #?(:clj-kondo :as-alias :default :as) mw]
55
[compojure.api.routes #?(:clj-kondo :as-alias :default :as) routes]
6-
[plumbing.core #?(:clj-kondo :as-alias :default :as) p]
6+
#?(:clj-kondo [compojure-api-kondo-hooks.plumbing.core :as p]
7+
:default [plumbing.core :as p])
78
[plumbing.fnk.impl #?(:clj-kondo :as-alias :default :as) fnk-impl]
89
[ring.swagger.common #?(:clj-kondo :as-alias :default :as) rsc]
910
[ring.swagger.json-schema #?(:clj-kondo :as-alias :default :as) js]
@@ -388,6 +389,7 @@
388389
form (if (seq letks) `(p/letk ~letks ~form) form)
389390
form (if (seq lets) `(let ~lets ~form) form)
390391
form `(comp-core/context ~path ~arg-with-request ~form)]
392+
(prn "context" form)
391393
form)
392394

393395
;; endpoints
@@ -398,6 +400,7 @@
398400
form `(fn [~'+compojure-api-request+]
399401
~'+compojure-api-request+ ;;always used
400402
~form)]
403+
(prn "endpoint" form)
401404
form)))
402405
:default ;; JVM
403406
(if context?

0 commit comments

Comments
 (0)