Function Schemas with clj-kondo integration

.gitignore

@@ -11,3 +11,4 @@ cljs-test-runner-out
 classes
 /demo
 /target
+.clj-kondo

README.md

@@ -21,6 +21,7 @@ Data-driven Schemas for Clojure/Script.
 - Immutable, Mutable, Dynamic, Lazy and Local [Schema Registries](#schema-registry)
 - [Schema Transformations](#schema-Transformation) to [JSON Schema](#json-schema) and [Swagger2](#swagger2)
 - [Multi-schemas](#multi-schemas), [Recursive Schemas](#recursive-schemas) and [Default values](#default-values)
+- [Function Schemas](#function-schemas) with [clj-kondo](#clj-kondo) support
 - [Visualizing Schemas](#visualizing-schemas) with DOT
 - [Fast](#performance)
 
@@ -177,7 +178,7 @@ Using `:string` Schema:
 ; => false
 ```
 
-## Function schemas
+## Fn schemas
 
 `:fn` allows any predicate function to be used:
 
@@ -1612,6 +1613,150 @@ Registries can be composed:
 ; => true
 ```
 
+## Function Schemas
+
+**alpha, subject to change**
+
+Functions can be described with `:=>`, which takes function arguments (as `:tuple`) and output schemas as children.
+
+```clj
+(defn plus [x y] (+ x y))
+
+(def =>plus [:=> [:tuple int? int?] int?])
+
+(m/validate =>plus plus)
+; => true
+```
+
+By default, validation just checks if a valu ia `ifn?`:
+
+```clj
+(m/validate =>plus str)
+; => true :(
+```
+
+We can use value generation for more comprehensive testing:
+
+```clj
+(m/validate =>plus plus {::m/=>validator mg/=>validator})
+; => true
+
+(m/validate =>plus str {::m/=>validator mg/=>validator})
+; => false
+``` 
+
+A generated function implementation:
+
+```clj
+(def plus-gen (mg/generate =>plus))
+
+(plus-gen 1 2)
+; => -1
+
+(plus-gen 1 "2")
+; =throws=> :malli.generator/invalid-input {:schema [:tuple int? int?], :args [1 "2"]}
+```
+
+Multiple arities are WIP, currently defined using `:or`:
+
+```clj
+(m/validate
+  [:or
+   [:=> [:tuple pos-int?] pos-int?]
+   [:=> [:tuple int? int?] int?]]
+  (fn math
+    ([x] (+ x x))
+    ([x y] (+ x y)))
+  {::m/=>validator mg/=>validator})
+; => true
+
+(def f (mg/generate
+         [:or
+          [:=> [:tuple int?] pos-int?]
+          [:=> [:tuple int? int?] int?]]))
+
+;; fixes the arity, which is not correct
+(-> f meta :arity)
+; => 1
+
+(f 42)
+; => 2
+
+(f 42 42)
+; =thrown=> :malli.generator/invalid-input {:schema [:tuple int?], :args [42 42]}
+```
+
+Varargs are WIP too (waiting for #180).
+
+## Function Schema Registry
+
+Vars can be annotated with function schemas using `m/=>` macro, backed by a global registry:
+
+```clj
+(defn square [x] (* x x))
+
+(m/=> square [:=> [:tuple int?] pos-int?])
+```
+
+Listing registered function Var schemas:
+
+```clj
+(m/=>schemas)
+;{user
+; {square
+;  {:schema [:=> [:tuple int?] pos-int?]
+;   :meta nil
+;   :ns malli.generator-test
+;   :name square}}}
+```
+
+## Clj-kondo
+
+[Clj-kondo](https://github.com/borkdude/clj-kondo) is a linter for Clojure code that sparks joy.
+
+Given functions and function Schemas:
+
+```clj
+(defn square [x] (* x x))
+(m/=> square [:=> [:tuple int?] nat-int?])
+
+(defn plus
+  ([x] x)
+  ([x y] (+ x y)))
+
+(m/=> plus [:or
+            [:=> [:tuple int?] int?]
+            [:=> [:tuple int? int?] int?]])
+```
+
+Generating `clj-kondo` configuration from current namespace:
+
+```clj
+(require '[malli.clj-kondo :as mc])
+
+(-> (mc/collect *ns*) (mc/linter-config))
+;{:lint-as #:malli.schema{defn schema.core/defn},
+; :linters
+; {:type-mismatch
+;  {:namespaces
+;   {user {square {:arities {1 {:args [:int]
+;                               :ret :pos-int}}}
+;          plus {:arities {1 {:args [:int]
+;                             :ret :int},
+;                          2 {:args [:int :int]
+;                             :ret :int}}}}}}}}
+```
+
+Emitting confing into `./.clj-kondo/configs/malli/config.edn`:
+
+```clj
+(mc/emit!)
+```
+
+In action:
+
+![malli](docs/img/clj-kondo.png)
+
 ## Visualizing Schemas
 
 Transforming Schemas into [DOT Language](https://en.wikipedia.org/wiki/DOT_(graph_description_language)):

src/malli/clj_kondo.cljc

@@ -0,0 +1,155 @@
+(ns malli.clj-kondo
+  (:require #?(:clj [clojure.java.io :as io])
+            [malli.core :as m]))
+
+(declare transform)
+
+(defmulti accept (fn [name _schema _children _options] name) :default ::default)
+
+(defmethod accept ::default [_ _ _ _] :any)
+(defmethod accept 'any? [_ _ _ _] :any)
+(defmethod accept 'some? [_ _ _ _] :any) ;;??
+(defmethod accept 'number? [_ _ _ _] :number)
+(defmethod accept 'integer? [_ _ _ _] :int)
+(defmethod accept 'int? [_ _ _ _] :int)
+(defmethod accept 'pos-int? [_ _ _ _] :pos-int)
+(defmethod accept 'neg-int? [_ _ _ _] :neg-int)
+(defmethod accept 'nat-int? [_ _ _ _] :nat-int)
+(defmethod accept 'float? [_ _ _ _] :double)
+(defmethod accept 'double? [_ _ _ _] :double)
+(defmethod accept 'pos? [_ _ _ _] :pos-int)
+(defmethod accept 'neg? [_ _ _ _] :neg-int)
+(defmethod accept 'boolean? [_ _ _ _] :boolean)
+(defmethod accept 'string? [_ _ _ _] :string)
+(defmethod accept 'ident? [_ _ _ _] :symbol) ;;??
+(defmethod accept 'simple-ident? [_ _ _ _] :symbol) ;;??
+(defmethod accept 'qualified-ident? [_ _ _ _] :symbol) ;;??
+(defmethod accept 'keyword? [_ _ _ _] :keyword)
+(defmethod accept 'simple-keyword? [_ _ _ _] :keyword)
+(defmethod accept 'qualified-keyword? [_ _ _ _] :keyword)
+(defmethod accept 'symbol? [_ _ _ _] :symbol)
+(defmethod accept 'simple-symbol? [_ _ _ _] :symbol)
+(defmethod accept 'qualified-symbol? [_ _ _ _] :symbol)
+(defmethod accept 'uuid? [_ _ _ _] :any) ;;??
+(defmethod accept 'uri? [_ _ _ _] :any) ;;??
+(defmethod accept 'decimal? [_ _ _ _] :double) ;;??
+(defmethod accept 'inst? [_ _ _ _] :any) ;;??
+(defmethod accept 'seqable? [_ _ _ _] :seqable)
+(defmethod accept 'indexed? [_ _ _ _] :vector) ;;??
+(defmethod accept 'map? [_ _ _ _] :map)
+(defmethod accept 'vector? [_ _ _ _] :vector)
+(defmethod accept 'list? [_ _ _ _] :list)
+(defmethod accept 'seq? [_ _ _ _] :seq)
+(defmethod accept 'char? [_ _ _ _] :char)
+(defmethod accept 'set? [_ _ _ _] :set)
+(defmethod accept 'nil? [_ _ _ _] :nil)
+(defmethod accept 'false? [_ _ _ _] :boolean) ;;??
+(defmethod accept 'true? [_ _ _ _] :boolean) ;;??
+(defmethod accept 'zero? [_ _ _ _] :int) ;;??
+#?(:clj (defmethod accept 'rational? [_ _ _ _] :double)) ;;??
+(defmethod accept 'coll? [_ _ _ _] :coll)
+(defmethod accept 'empty? [_ _ _ _] :seq) ;;??
+(defmethod accept 'associative? [_ _ _ _] :associative)
+(defmethod accept 'sequential? [_ _ _ _] :sequential)
+(defmethod accept 'ratio? [_ _ _ _] :int) ;;??
+(defmethod accept 'bytes? [_ _ _ _] :char-sequence) ;;??
+
+(defmethod accept :> [_ _ _ _] :number) ;;??
+(defmethod accept :>= [_ _ _ _] :number) ;;??
+(defmethod accept :< [_ _ _ _] :number) ;;??
+(defmethod accept :<= [_ _ _ _] :number) ;;??
+(defmethod accept := [_ _ _ _] :any) ;;??
+(defmethod accept :not= [_ _ _ _] :any) ;;??
+
+(defmethod accept :and [_ _ _ _] :any) ;;??
+(defmethod accept :or [_ _ _ _] :any) ;;??
+
+(defmethod accept ::m/val [_ _ children _] (first children))
+(defmethod accept :map [_ _ children _]
+  (let [{req true opt false} (->> children (group-by (m/-comp not :optional second)))
+        opt (apply array-map (mapcat (fn [[k _ s]] [k s]) opt))
+        req (apply array-map (mapcat (fn [[k _ s]] [k s]) req))]
+    (cond-> {:op :keys}, (seq opt) (assoc :opt opt), (seq req) (assoc :req req))))
+
+(defmethod accept :multi [_ _ _ _] :any) ;;??
+(defmethod accept :map-of [_ _ _ _] :map) ;;??
+(defmethod accept :vector [_ _ _ _] :vector)
+(defmethod accept :sequential [_ _ _ _] :sequential)
+(defmethod accept :set [_ _ _ _] :set)
+(defmethod accept :enum [_ _ _ _])
+(defmethod accept :maybe [_ _ [child] _] (if (keyword? child) (keyword "nilable" (name child)) child))
+(defmethod accept :tuple [_ _ children _] children)
+(defmethod accept :re [_ _ _ _] :regex)
+(defmethod accept :fn [_ _ _ _] :fn)
+
+(defmethod accept :string [_ _ _ _] :string)
+(defmethod accept :int [_ _ _ _] :int)
+(defmethod accept :double [_ _ _ _] :double)
+
+(defmethod accept :boolean [_ _ _ _] :boolean)
+(defmethod accept :keyword [_ _ _ _] :keyword)
+(defmethod accept :qualified-keyword [_ _ _ _] :keyword)
+(defmethod accept :symbol [_ _ _ _] :symbol)
+(defmethod accept :qualified-symbol [_ _ _ _] :symbol)
+(defmethod accept :uuid [_ _ _ _] :any) ;;??
+
+(defmethod accept :ref [_ _ _ _] :any) ;;??
+(defmethod accept :schema [_ schema _ options] (transform (m/deref schema) options))
+(defmethod accept ::m/schema [_ schema _ options] (transform (m/deref schema) options))
+
+(defmethod accept :merge [_ schema _ options] (transform (m/deref schema) options))
+(defmethod accept :union [_ schema _ options] (transform (m/deref schema) options))
+(defmethod accept :select-keys [_ schema _ options] (transform (m/deref schema) options))
+
+(defn- -walk [schema _ children options] (accept (m/type schema) schema children options))
+
+(defn -transform [?schema options] (m/walk ?schema -walk options))
+
+;;
+;; public api
+;;
+
+(defn transform
+  ([?schema]
+   (transform ?schema nil))
+  ([?schema options]
+   (-transform ?schema options)))
+
+#?(:clj
+   (defn save! [config]
+     (let [cfg-file (io/file ".clj-kondo" "configs" "malli" "config.edn")]
+       (io/make-parents cfg-file)
+       (spit cfg-file config)
+       config)))
+
+(defn from [{:keys [schema ns name]}]
+  (let [ns-name (-> ns str symbol)
+        schema (if (= :or (m/type schema)) schema (m/into-schema :or nil [schema] (m/options schema)))]
+    (reduce
+      (fn [acc schema]
+        (let [[input return] (m/children schema)
+              args (mapv transform (m/children input))
+              ret (transform return)
+              arity (count args)]
+          (conj acc {:ns ns-name
+                     :name name
+                     :arity arity
+                     :args args
+                     :ret ret}))) [] (m/children schema))))
+
+(defn collect
+  ([] (collect nil))
+  ([ns]
+   (let [-collect (fn [k] (or (nil? ns) (= k (symbol (str ns)))))]
+     (->> (for [[k vs] (m/=>schemas) :when (-collect k) [_ v] vs v (from v)] v)))))
+
+(defn linter-config [xs]
+  (reduce
+    (fn [acc {:keys [ns name arity args ret]}]
+      (assoc-in
+        acc [:linters :type-mismatch :namespaces (symbol (str ns)) name :arities arity]
+        {:args args, :ret ret}))
+    {:lint-as {'malli.schema/defn 'schema.core/defn}} xs))
+
+#?(:clj
+   (defn emit! [] (-> (collect) (linter-config) (save!)) nil))