wip

Author: frenchy64

dev/compojure_api_kondo_hooks/plumbing/core.clj

@@ -2,9 +2,7 @@
   "Utility belt for Clojure in the wild"
   (:refer-clojure :exclude [update])
   (:require
-   [schema.utils :as schema-utils]
-   [schema.macros :as schema-macros]
-   [plumbing.fnk.schema :as schema]
+   [compojure-api-kondo-hooks.schema.macros :as schema-macros]
    [compojure-api-kondo-hooks.plumbing.fnk.impl :as fnk-impl]))
 
 (defmacro letk
@@ -30,8 +28,6 @@
 
    Map destructuring bindings can be mixed with ordinary symbol bindings."
   [bindings & body]
-  (schema/assert-iae (vector? bindings) "Letk binding must be a vector")
-  (schema/assert-iae (even? (count bindings)) "Letk binding must have even number of elements")
   (reduce
    (fn [cur-body-form [bind-form value-form]]
      (if (symbol? bind-form)

examples/clj-kondo-hooks/.clj-kondo/imports/metosin/compojure-api/compojure_api_kondo_hooks/plumbing/core.clj

@@ -0,0 +1,42 @@
+(ns compojure-api-kondo-hooks.plumbing.core
+  "Utility belt for Clojure in the wild"
+  (:refer-clojure :exclude [update])
+  (:require
+   [compojure-api-kondo-hooks.schema.macros :as schema-macros]
+   [compojure-api-kondo-hooks.plumbing.fnk.impl :as fnk-impl]))
+
+(defmacro letk
+  "Keyword let.  Accepts an interleaved sequence of binding forms and map forms like:
+   (letk [[a {b 2} [:f g h] c d {e 4} :as m & more] a-map ...] & body)
+   a, c, d, and f are required keywords, and letk will barf if not in a-map.
+   b and e are optional, and will be bound to default values if not present.
+   g and h are required keys in the map found under :f.
+   m will be bound to the entire map (a-map).
+   more will be bound to all the unbound keys (ie (dissoc a-map :a :b :c :d :e)).
+   :as and & are both optional, but must be at the end in the specified order if present.
+   The same symbol cannot be bound multiple times within the same destructing level.
+
+   Optional values can reference symbols bound earlier within the same binding, i.e.,
+   (= [2 2] (let [a 1] (letk [[a {b a}] {:a 2}] [a b]))) but
+   (= [2 1] (let [a 1] (letk [[{b a} a] {:a 2}] [a b])))
+
+   If present, :as and :& symbols are bound before other symbols within the binding.
+
+   Namespaced keys are supported by specifying fully-qualified key in binding form. The bound
+   symbol uses the _name_ portion of the namespaced key, i.e,
+   (= 1 (letk [[a/b] {:a/b 1}] b)).
+
+   Map destructuring bindings can be mixed with ordinary symbol bindings."
+  [bindings & body]
+  (reduce
+   (fn [cur-body-form [bind-form value-form]]
+     (if (symbol? bind-form)
+       `(let [~bind-form ~value-form] ~cur-body-form)
+       (let [{:keys [map-sym body-form]} (fnk-impl/letk-input-schema-and-body-form
+                                          &env
+                                          bind-form ;(fnk-impl/ensure-schema-metadata &env bind-form)
+                                          []
+                                          cur-body-form)]
+         `(let [~map-sym ~value-form] ~body-form))))
+   `(do ~@body)
+   (reverse (partition 2 bindings))))

examples/clj-kondo-hooks/.clj-kondo/imports/metosin/compojure-api/compojure_api_kondo_hooks/plumbing/fnk/impl.clj

@@ -0,0 +1,116 @@
+(ns compojure-api-kondo-hooks.plumbing.fnk.impl
+  (:require
+   [clojure.set :as set]
+   [schema.core :as-alias s]
+   [compojure-api-kondo-hooks.schema.macros :as schema-macros]))
+
+;;;;; Helpers
+
+(defn name-sym
+  "Returns symbol of x's name.
+   Converts a keyword/string to symbol, or removes namespace (if any) of symbol"
+  [x]
+  (with-meta (symbol (name x)) (meta x)))
+
+;;; Parsing new fnk binding style
+
+(declare letk-input-schema-and-body-form)
+
+(defn- process-schematized-map
+  "Take an optional binding map like {a 2} or {a :- Number 2} and convert the schema
+   information to canonical metadata, if present."
+  [env binding]
+  (case (count binding)
+    1 (let [[sym v] (first binding)]
+        {sym v})
+
+    2 (let [[[[sym _]] [[schema v]]] ((juxt filter remove) #(= (val %) :-) binding)]
+        {sym v})))
+
+;; TODO: unify this with positional version.
+(defn letk-arg-bind-sym-and-body-form
+  "Given a single element of a single letk binding form and a current body form, return
+   a map {:schema-entry :body-form} where schema-entry is a tuple
+   [bound-key schema external-schema?], and body-form wraps body with destructuring
+   for this binding as necessary."
+  [env map-sym binding key-path body-form]
+  (cond (symbol? binding)
+        {:schema-entry []
+         :body-form `(let [~(name-sym binding) (get ~map-sym ~(keyword binding) ~key-path)]
+                       ~body-form)}
+
+        (map? binding)
+        (let [schema-fixed-binding (process-schematized-map env binding)
+              [bound-sym opt-val-expr] (first schema-fixed-binding)
+              bound-key (keyword bound-sym)]
+          {:schema-entry []
+           :body-form `(let [~(name-sym bound-sym) (get ~map-sym ~bound-key ~opt-val-expr)]
+                         ~body-form)})
+
+        (vector? binding)
+        (let [[bound-key & more] binding
+              {inner-input-schema :input-schema
+               inner-external-input-schema :external-input-schema
+               inner-map-sym :map-sym
+               inner-body-form :body-form} (letk-input-schema-and-body-form
+                                            env
+                                            (with-meta (vec more) (meta binding))
+                                            (conj key-path bound-key)
+                                            body-form)]
+          {:schema-entry []
+           :body-form `(let [~inner-map-sym (get ~map-sym ~bound-key ~key-path)]
+                         ~inner-body-form)})
+
+        :else (throw (ex-info (format "bad binding: %s" binding) {}))))
+
+(defn- extract-special-args
+  "Extract trailing & sym and :as sym, possibly with schema metadata. Returns
+  [more-bindings special-args-map] where special-args-map is a map from each
+  special symbol found to the symbol that was found."
+  [env special-arg-signifier-set binding-form]
+  {:pre [(set? special-arg-signifier-set)]}
+  (let [[more-bindings special-bindings] (split-with (complement special-arg-signifier-set) binding-form)]
+    (loop [special-args-map {}
+           special-arg-set special-arg-signifier-set
+           [arg-signifier & other-bindings :as special-bindings] special-bindings]
+      (if-not (seq special-bindings)
+        [more-bindings special-args-map]
+        (do
+          (let [[sym remaining-bindings] (schema-macros/extract-arrow-schematized-element env other-bindings)]
+            (recur (assoc special-args-map arg-signifier sym)
+                   (disj special-arg-set arg-signifier)
+                   remaining-bindings)))))))
+
+(defn letk-input-schema-and-body-form
+  "Given a single letk binding form, value form, key path, and body
+   form, return a map {:input-schema :external-input-schema :map-sym :body-form}
+   where input-schema is the schema imposed by binding-form, external-input-schema
+   is like input-schema but includes user overrides for binding vectors,
+   map-sym is the symbol which it expects the bound value to be bound to,
+   and body-form wraps body in the bindings from binding-form from map-sym."
+  [env binding-form key-path body-form]
+  (let [[bindings {more-sym '& as-sym :as}] (extract-special-args env #{'& :as} binding-form)
+        as-sym (or as-sym (gensym "map"))
+        [input-schema-elts
+         external-input-schema-elts
+         bound-body-form] (reduce
+                           (fn [[input-schema-elts external-input-schema-elts cur-body] binding]
+                             (let [{:keys [schema-entry body-form]}
+                                   (letk-arg-bind-sym-and-body-form
+                                    env as-sym binding key-path cur-body)
+                                   [bound-key input-schema external-input-schema] schema-entry]
+                               [(conj input-schema-elts [bound-key input-schema])
+                                (conj external-input-schema-elts
+                                      [bound-key (or external-input-schema input-schema)])
+                                body-form]))
+                           [[] [] body-form]
+                           (reverse
+                            (schema-macros/process-arrow-schematized-args
+                             env bindings)))
+        explicit-schema-keys []
+        final-body-form (if more-sym
+                          `(let [~more-sym (dissoc ~as-sym ~@explicit-schema-keys)]
+                             ~bound-body-form)
+                          bound-body-form)]
+    {:map-sym as-sym
+     :body-form final-body-form}))

examples/clj-kondo-hooks/.clj-kondo/imports/metosin/compojure-api/compojure_api_kondo_hooks/schema/macros.clj

@@ -0,0 +1,24 @@
+(ns compojure-api-kondo-hooks.schema.macros)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Helpers for processing and normalizing element/argument schemas in s/defrecord and s/(de)fn
+
+(defn extract-arrow-schematized-element
+  "Take a nonempty seq, which may start like [a ...] or [a :- schema ...], and return
+   a list of [first-element-with-schema-attached rest-elements]"
+  [env s]
+  (assert (seq s))
+  (let [[f & more] s]
+    (if (= :- (first more))
+      [f (drop 2 more)]
+      [f more])))
+
+(defn process-arrow-schematized-args
+  "Take an arg vector, in which each argument is followed by an optional :- schema,
+   and transform into an ordinary arg vector where the schemas are metadata on the args."
+  [env args]
+  (loop [in args out []]
+    (if (empty? in)
+      out
+      (let [[arg more] (extract-arrow-schematized-element env in)]
+        (recur more (conj out arg))))))

resources/clj-kondo.exports/metosin/compojure-api/compojure_api_kondo_hooks/plumbing/core.clj

@@ -0,0 +1,42 @@
+(ns compojure-api-kondo-hooks.plumbing.core
+  "Utility belt for Clojure in the wild"
+  (:refer-clojure :exclude [update])
+  (:require
+   [compojure-api-kondo-hooks.schema.macros :as schema-macros]
+   [compojure-api-kondo-hooks.plumbing.fnk.impl :as fnk-impl]))
+
+(defmacro letk
+  "Keyword let.  Accepts an interleaved sequence of binding forms and map forms like:
+   (letk [[a {b 2} [:f g h] c d {e 4} :as m & more] a-map ...] & body)
+   a, c, d, and f are required keywords, and letk will barf if not in a-map.
+   b and e are optional, and will be bound to default values if not present.
+   g and h are required keys in the map found under :f.
+   m will be bound to the entire map (a-map).
+   more will be bound to all the unbound keys (ie (dissoc a-map :a :b :c :d :e)).
+   :as and & are both optional, but must be at the end in the specified order if present.
+   The same symbol cannot be bound multiple times within the same destructing level.
+
+   Optional values can reference symbols bound earlier within the same binding, i.e.,
+   (= [2 2] (let [a 1] (letk [[a {b a}] {:a 2}] [a b]))) but
+   (= [2 1] (let [a 1] (letk [[{b a} a] {:a 2}] [a b])))
+
+   If present, :as and :& symbols are bound before other symbols within the binding.
+
+   Namespaced keys are supported by specifying fully-qualified key in binding form. The bound
+   symbol uses the _name_ portion of the namespaced key, i.e,
+   (= 1 (letk [[a/b] {:a/b 1}] b)).
+
+   Map destructuring bindings can be mixed with ordinary symbol bindings."
+  [bindings & body]
+  (reduce
+   (fn [cur-body-form [bind-form value-form]]
+     (if (symbol? bind-form)
+       `(let [~bind-form ~value-form] ~cur-body-form)
+       (let [{:keys [map-sym body-form]} (fnk-impl/letk-input-schema-and-body-form
+                                          &env
+                                          bind-form ;(fnk-impl/ensure-schema-metadata &env bind-form)
+                                          []
+                                          cur-body-form)]
+         `(let [~map-sym ~value-form] ~body-form))))
+   `(do ~@body)
+   (reverse (partition 2 bindings))))

resources/clj-kondo.exports/metosin/compojure-api/compojure_api_kondo_hooks/plumbing/fnk/impl.clj

@@ -0,0 +1,116 @@
+(ns compojure-api-kondo-hooks.plumbing.fnk.impl
+  (:require
+   [clojure.set :as set]
+   [schema.core :as-alias s]
+   [compojure-api-kondo-hooks.schema.macros :as schema-macros]))
+
+;;;;; Helpers
+
+(defn name-sym
+  "Returns symbol of x's name.
+   Converts a keyword/string to symbol, or removes namespace (if any) of symbol"
+  [x]
+  (with-meta (symbol (name x)) (meta x)))
+
+;;; Parsing new fnk binding style
+
+(declare letk-input-schema-and-body-form)
+
+(defn- process-schematized-map
+  "Take an optional binding map like {a 2} or {a :- Number 2} and convert the schema
+   information to canonical metadata, if present."
+  [env binding]
+  (case (count binding)
+    1 (let [[sym v] (first binding)]
+        {sym v})
+
+    2 (let [[[[sym _]] [[schema v]]] ((juxt filter remove) #(= (val %) :-) binding)]
+        {sym v})))
+
+;; TODO: unify this with positional version.
+(defn letk-arg-bind-sym-and-body-form
+  "Given a single element of a single letk binding form and a current body form, return
+   a map {:schema-entry :body-form} where schema-entry is a tuple
+   [bound-key schema external-schema?], and body-form wraps body with destructuring
+   for this binding as necessary."
+  [env map-sym binding key-path body-form]
+  (cond (symbol? binding)
+        {:schema-entry []
+         :body-form `(let [~(name-sym binding) (get ~map-sym ~(keyword binding) ~key-path)]
+                       ~body-form)}
+
+        (map? binding)
+        (let [schema-fixed-binding (process-schematized-map env binding)
+              [bound-sym opt-val-expr] (first schema-fixed-binding)
+              bound-key (keyword bound-sym)]
+          {:schema-entry []
+           :body-form `(let [~(name-sym bound-sym) (get ~map-sym ~bound-key ~opt-val-expr)]
+                         ~body-form)})
+
+        (vector? binding)
+        (let [[bound-key & more] binding
+              {inner-input-schema :input-schema
+               inner-external-input-schema :external-input-schema
+               inner-map-sym :map-sym
+               inner-body-form :body-form} (letk-input-schema-and-body-form
+                                            env
+                                            (with-meta (vec more) (meta binding))
+                                            (conj key-path bound-key)
+                                            body-form)]
+          {:schema-entry []
+           :body-form `(let [~inner-map-sym (get ~map-sym ~bound-key ~key-path)]
+                         ~inner-body-form)})
+
+        :else (throw (ex-info (format "bad binding: %s" binding) {}))))
+
+(defn- extract-special-args
+  "Extract trailing & sym and :as sym, possibly with schema metadata. Returns
+  [more-bindings special-args-map] where special-args-map is a map from each
+  special symbol found to the symbol that was found."
+  [env special-arg-signifier-set binding-form]
+  {:pre [(set? special-arg-signifier-set)]}
+  (let [[more-bindings special-bindings] (split-with (complement special-arg-signifier-set) binding-form)]
+    (loop [special-args-map {}
+           special-arg-set special-arg-signifier-set
+           [arg-signifier & other-bindings :as special-bindings] special-bindings]
+      (if-not (seq special-bindings)
+        [more-bindings special-args-map]
+        (do
+          (let [[sym remaining-bindings] (schema-macros/extract-arrow-schematized-element env other-bindings)]
+            (recur (assoc special-args-map arg-signifier sym)
+                   (disj special-arg-set arg-signifier)
+                   remaining-bindings)))))))
+
+(defn letk-input-schema-and-body-form
+  "Given a single letk binding form, value form, key path, and body
+   form, return a map {:input-schema :external-input-schema :map-sym :body-form}
+   where input-schema is the schema imposed by binding-form, external-input-schema
+   is like input-schema but includes user overrides for binding vectors,
+   map-sym is the symbol which it expects the bound value to be bound to,
+   and body-form wraps body in the bindings from binding-form from map-sym."
+  [env binding-form key-path body-form]
+  (let [[bindings {more-sym '& as-sym :as}] (extract-special-args env #{'& :as} binding-form)
+        as-sym (or as-sym (gensym "map"))
+        [input-schema-elts
+         external-input-schema-elts
+         bound-body-form] (reduce
+                           (fn [[input-schema-elts external-input-schema-elts cur-body] binding]
+                             (let [{:keys [schema-entry body-form]}
+                                   (letk-arg-bind-sym-and-body-form
+                                    env as-sym binding key-path cur-body)
+                                   [bound-key input-schema external-input-schema] schema-entry]
+                               [(conj input-schema-elts [bound-key input-schema])
+                                (conj external-input-schema-elts
+                                      [bound-key (or external-input-schema input-schema)])
+                                body-form]))
+                           [[] [] body-form]
+                           (reverse
+                            (schema-macros/process-arrow-schematized-args
+                             env bindings)))
+        explicit-schema-keys []
+        final-body-form (if more-sym
+                          `(let [~more-sym (dissoc ~as-sym ~@explicit-schema-keys)]
+                             ~bound-body-form)
+                          bound-body-form)]
+    {:map-sym as-sym
+     :body-form final-body-form}))

resources/clj-kondo.exports/metosin/compojure-api/compojure_api_kondo_hooks/schema/macros.clj

@@ -0,0 +1,24 @@
+(ns compojure-api-kondo-hooks.schema.macros)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Helpers for processing and normalizing element/argument schemas in s/defrecord and s/(de)fn
+
+(defn extract-arrow-schematized-element
+  "Take a nonempty seq, which may start like [a ...] or [a :- schema ...], and return
+   a list of [first-element-with-schema-attached rest-elements]"
+  [env s]
+  (assert (seq s))
+  (let [[f & more] s]
+    (if (= :- (first more))
+      [f (drop 2 more)]
+      [f more])))
+
+(defn process-arrow-schematized-args
+  "Take an arg vector, in which each argument is followed by an optional :- schema,
+   and transform into an ordinary arg vector where the schemas are metadata on the args."
+  [env args]
+  (loop [in args out []]
+    (if (empty? in)
+      out
+      (let [[arg more] (extract-arrow-schematized-element env in)]
+        (recur more (conj out arg))))))

scripts/regen-kondo.clj

@@ -5,5 +5,7 @@ set -ex
 rm -r resources/clj-kondo.exports
 mkdir -p resources/clj-kondo.exports/metosin/compojure-api/compojure/api
 mkdir -p resources/clj-kondo.exports/metosin/compojure-api/compojure_api_kondo_hooks/compojure
+mkdir -p resources/clj-kondo.exports/metosin/compojure-api/compojure_api_kondo_hooks/plumbing/fnk
+mkdir -p resources/clj-kondo.exports/metosin/compojure-api/compojure_api_kondo_hooks/schema
 
 bb -f ./scripts/regen_kondo_config.clj