Merge branch 'main' of github.com:active-group/active-clojure

project.clj

@@ -1,4 +1,4 @@
-(defproject de.active-group/active-clojure "0.43.0-SNAPSHOT"
+(defproject de.active-group/active-clojure "0.44.0-SNAPSHOT"
   :description "Active Clojure: Various Clojure utilities in use at Active Group"
   :url "http://github.com/active-group/active-clojure"
   :license {:name "Eclipse Public License"

resources/clj-kondo.exports/de.active-group/active-clojure/config.edn

@@ -0,0 +1,7 @@
+{:linters {:monad/empty {:level :error}}
+ :hooks {:analyze-call {active.clojure.monad/monadic hooks.monad/monadic
+                        active.clojure.cljs.record/define-record-type hooks.record/define-record-type
+                        active.clojure.cljs.record/define-singleton-type hooks.record/define-singleton-type
+                        active.clojure.sum-type/define-sum-type hooks.sum-type/define-sum-type
+                        active.clojure.record/define-record-type hooks.record/define-record-type
+                        active.clojure.record/define-singleton-type hooks.record/define-singleton-type}}}

resources/clj-kondo.exports/de.active-group/active-clojure/hooks/monad.clj

@@ -0,0 +1,38 @@
+(ns hooks.monad
+  (:require [clj-kondo.hooks-api :as api]))
+
+(defn monadic
+  [{:keys [:node]}]
+  (letfn [(rewrite-monadic-form
+            [forms]
+            (if (empty? forms)
+              forms
+              (let [form (first forms)
+                    forms (rest forms)]
+                (cond
+                  (= :vector (:tag form))
+                  (api/list-node
+                   (list (api/token-node 'let)
+                         form
+                         (rewrite-monadic-form forms)))
+                  (and (= :list (:tag form))
+                       (= 2 (count (:children form)))
+                       (= "let" (:string-value (first (:children form)))))
+                  (api/list-node
+                    (list (first (:children form))
+                          (second (:children form))
+                          (rewrite-monadic-form forms)))
+                  :else
+                  (if (empty? forms)
+                    form
+                    (api/list-node
+                      (list (api/token-node 'do)
+                            form
+                            (rewrite-monadic-form forms))))))))]
+    (let [[& forms] (rest (:children node))]
+      (if (empty? forms)
+        (api/reg-finding! (assoc (meta node)
+                                 :message "monadic must not be empty"
+                                 :type :monad/empty))
+        (let [new-node (rewrite-monadic-form forms)]
+          {:node new-node})))))

resources/clj-kondo.exports/de.active-group/active-clojure/hooks/record.clj

@@ -0,0 +1,37 @@
+(ns hooks.record
+  (:require [clj-kondo.hooks-api :as api]))
+
+(defn define-record-type
+  [{:keys [:node]}]
+  (let [[record-name & more] (rest (:children node))
+        [constructor-spec predicate field-specs] (if (api/map-node? (first more))
+                                                   ;; remove options
+                                                   (rest more)
+                                                   more)
+        [constructor & _fields] (if-let [ch (:children constructor-spec)]
+                                  ch
+                                  [constructor-spec])
+        accessors (map second (partition 2 (:children field-specs)))
+        new-node
+        (api/list-node
+         (list* (api/token-node 'do)
+                (api/list-node [(api/token-node 'declare) record-name])
+                (api/list-node [(api/token-node 'declare) predicate])
+                (api/list-node [(api/token-node 'declare) constructor])
+                (map (fn [t] (api/list-node [(api/token-node 'declare) t]))
+                     (if-let [projection-lens (and (api/map-node? (first more))
+                                                   (:projection-lens (api/sexpr (first more))))]
+                       (conj accessors (api/token-node projection-lens))
+                       accessors))))]
+  {:node new-node}))
+
+(defn define-singleton-type
+  [expr]
+  (update expr :node
+          (fn [node]
+            (let [[record-name singleton predicate] (rest (:children node))]
+              (api/list-node
+               (list (api/token-node 'do)
+                     (api/list-node [(api/token-node 'declare) record-name])
+                     (api/list-node [(api/token-node 'declare) singleton])
+                     (api/list-node [(api/token-node 'declare) predicate])))))))

resources/clj-kondo.exports/de.active-group/active-clojure/hooks/sum_type.clj

@@ -0,0 +1,13 @@
+(ns hooks.sum-type
+  (:require [clj-kondo.hooks-api :as api]))
+
+(defn define-sum-type
+  [expr]
+  (update expr :node
+          (fn [node]
+            (let [[sum-type-name predicate] (rest (:children node))]
+              (api/list-node
+               (list (api/token-node 'do)
+                     (api/list-node [(api/token-node 'declare) sum-type-name])
+                     (api/list-node [(api/token-node 'declare) predicate])))))))
+