Macro parsing overhaul (camsaul#119)

* Macro parsing overhaul

* Cleanup

.clj-kondo/config.edn

@@ -7,7 +7,20 @@
   :unsorted-required-namespaces {:level :warning}
   :single-key-in                {:level :warning}
   :shadowed-var                 {:level :warning}
-  :unresolved-symbol            {}}
+  :unresolved-symbol            {}
+
+  :docstring-leading-trailing-whitespace {:level :warning}
+  :keyword-binding                       {:level :warning}
+  :misplaced-docstring                   {:level :warning}
+  :missing-body-in-when                  {:level :warning}
+  :missing-else-branch                   {:level :warning}
+  :namespace-name-mismatch               {:level :warning}
+  :non-arg-vec-return-type-hint          {:level :warning}
+  :reduce-without-init                   {:level :warning}
+  :redundant-fn-wrapper                  {:level :warning}
+  :use                                   {:level :warning}
+  :used-underscored-binding              {:level :warning}
+  :warn-on-reflection                    {:level :warning}}
 
  :lint-as
  {potemkin.types/deftype+ clojure.core/deftype}

codecov.yml

@@ -8,7 +8,7 @@ coverage:
       default:
         # Project must always have at least 80% coverage (by line)
         target: 85%
-        # Whole-project test coverage is allowed to drop up to 5%. (For situtations where we delete code with full coverage)
+        # Whole-project test coverage is allowed to drop up to 5%. (For situations where we delete code with full coverage)
         threshold: 5%
     patch:
       default:

dev/user.clj

@@ -0,0 +1,7 @@
+(ns user
+  (:require
+   [humane-are.core :as humane-are]
+   [pjstadig.humane-test-output :as humane-test-output]))
+
+(humane-test-output/activate!)
+(humane-are/install!)

resources/clj-kondo.exports/methodical/methodical/config.edn

@@ -5,12 +5,10 @@
 
  :hooks
  {:analyze-call
-  {methodical.core/defmethod               hooks.methodical.core/defmethod
-   methodical.core/defmulti                hooks.methodical.core/defmulti
-   methodical.macros/define-aux-method     hooks.methodical.core/defmethod
-   methodical.macros/define-primary-method hooks.methodical.core/defmethod
-   methodical.macros/defmethod             hooks.methodical.core/defmethod
-   methodical.macros/defmulti              hooks.methodical.core/defmulti}
+  {methodical.core/defmethod   hooks.methodical.macros/defmethod
+   methodical.core/defmulti    hooks.methodical.macros/defmulti
+   methodical.macros/defmethod hooks.methodical.macros/defmethod
+   methodical.macros/defmulti  hooks.methodical.macros/defmulti}
 
   :macroexpand
   {methodical.impl.combo.operator/defoperator macros.methodical.impl.combo.operator/defoperator}}}

resources/clj-kondo.exports/methodical/methodical/hooks/methodical/macros.clj

@@ -0,0 +1,174 @@
+(ns hooks.methodical.macros
+  (:refer-clojure :exclude [defmulti defmethod])
+  (:require [clj-kondo.hooks-api :as hooks]))
+
+;;; The code below is basically simulating the spec for parsing defmethod args without using spec. It uses a basic
+;;; backtracking algorithm to achieve a similar result. Parsing defmethod args is kinda complicated.
+;;;
+;;; Unfortunately this is hardcoded to `:before`, `:after`, and `:around` as the only allowed qualifiers for now... at
+;;; some point in the future we'll have to figure out how to fix this and support other qualifiers too.
+
+(defn- bindings-vector? [x]
+  (and (hooks/vector-node? x)
+       (every? (some-fn hooks/token-node?
+                        hooks/map-node?
+                        hooks/vector-node?)
+               (:children x))))
+
+(defn- single-arity-fn-tail? [args]
+  (bindings-vector? (first args)))
+
+(defn- n-arity-fn-tail? [args]
+  (and (seq args)
+       (every? (fn [x]
+                 (and (hooks/list-node? x)
+                      (single-arity-fn-tail? (:children x))))
+               args)))
+
+(defn- fn-tail? [args]
+  (or (single-arity-fn-tail? args)
+      (n-arity-fn-tail? args)))
+
+(defn- qualifier? [x]
+  (and (hooks/keyword-node? x)
+       (#{:before :after :around} (hooks/sexpr x))))
+
+(defn- dispatch-value?
+  "A dispatch value can be anything except for qualifier keyword or a list that looks like part of a n-arity function tail
+  e.g. `([x] x)`."
+  [x]
+  (and (not (qualifier? x))
+       (or (not (hooks/list-node? x))
+           (not (single-arity-fn-tail? (:children x))))))
+
+(defonce ^:private backtrack (Exception.))
+
+(defn- parse-defmethod-args
+  ([unparsed]
+   (let [parses (atom [])]
+     (try
+       (parse-defmethod-args parses {} unparsed)
+       (catch Exception _
+         (when (zero? (count @parses))
+           (throw (ex-info (format "Unable to parse defmethod args: %s" (pr-str (mapv hooks/sexpr unparsed)))
+                           {:args (mapv hooks/sexpr unparsed)})))
+         (when (> (count @parses) 1)
+           (throw (ex-info (format "Ambiguous defmethod args: %s" (pr-str (mapv hooks/sexpr unparsed)))
+                           {:args (mapv hooks/sexpr unparsed)
+                            :parses @parses})))
+         (first @parses)))))
+
+  ([parses parsed unparsed]
+   (cond
+     (and (not (contains? parsed :qualifier))
+          (qualifier? (first unparsed)))
+     (try
+       (parse-defmethod-args parses (assoc parsed :qualifier (first unparsed)) (rest unparsed))
+       (catch Exception _
+         (parse-defmethod-args parses (assoc parsed :qualifier nil) unparsed)))
+
+     (and (not (contains? parsed :dispatch-value))
+          (dispatch-value? (first unparsed)))
+     (parse-defmethod-args parses (assoc parsed :dispatch-value (first unparsed)) (rest unparsed))
+
+     (not (contains? parsed :dispatch-value))
+     (throw backtrack)
+
+     (and (not (contains? parsed :unique-key))
+          (:qualifier parsed)           ; can only have unique keys for aux methods
+          (not (hooks/string-node? (first unparsed)))
+          (not (hooks/list-node? (first unparsed)))
+          (not (hooks/vector-node? (first unparsed))))
+     (try
+       (parse-defmethod-args parses (assoc parsed :unique-key (first unparsed)) (rest unparsed))
+       (catch Exception _
+         (parse-defmethod-args parses (assoc parsed :unique-key nil) unparsed)))
+
+     (and (not (contains? parsed :docstring))
+          (hooks/string-node? (first unparsed)))
+     (try
+       (parse-defmethod-args parses (assoc parsed :docstring (first unparsed)) (rest unparsed))
+       (catch Exception _
+         (parse-defmethod-args parses (assoc parsed :docstring nil) unparsed)))
+
+     (fn-tail? unparsed)
+     (do
+       (swap! parses conj (assoc parsed :fn-tail unparsed))
+       (throw backtrack))
+
+     :else
+     (throw backtrack))))
+
+(defn defmethod
+  [{{[_ multimethod & args] :children, :as node} :node}]
+  (#_println)
+  #_(clojure.pprint/pprint (hooks/sexpr node))
+  (let [parsed (parse-defmethod-args args)]
+    #_(doseq [[k v] parsed]
+        (println \newline k '=> (pr-str (some-> v hooks/sexpr))))
+    (let [fn-tail     (:fn-tail parsed)
+          other-stuff (dissoc parsed :fn-tail)
+          result      (hooks/list-node
+                       (concat
+                        [(hooks/token-node 'do)
+                         multimethod]
+                        (filter some? (vals other-stuff))
+                        [(hooks/list-node
+                          (list*
+                           (hooks/token-node 'fn)
+                           (hooks/token-node 'next-method)
+                           fn-tail))]))]
+      #_(println "=>")
+      #_(clojure.pprint/pprint (hooks/sexpr result))
+      {:node result})))
+
+;;; this stuff is for debugging things to make sure we didn't do something dumb
+(comment
+  (defn defmethod* [form]
+    (hooks/sexpr (:node (defmethod {:node (hooks/parse-string (str form))}))))
+
+  (defmethod* '(defmethod mf :second [& _] 2))
+
+  (defmethod* '(m/defmethod multi-arity :k
+                 ([x]
+                  {:x x})
+                 ([x y]
+                  {:x x, :y y})))
+
+  (defmethod* '(m/defmethod mf1 :docstring
+                 "Docstring"
+                 [_x])))
+
+(defn defmulti
+  [{{[_ multimethod-name & args] :children, :as node} :node}]
+  #_(clojure.pprint/pprint (hooks/sexpr node))
+  (let [[docstring & args]         (if (hooks/string-node? (first args))
+                                     args
+                                     (cons nil args))
+        [attribute-map & args]     (if (hooks/map-node? (first args))
+                                     args
+                                     (cons nil args))
+        ;; if there wasn't a positional dispatch function arg passed just use (constantly nil) so Kondo won't complain
+        [dispatch-fn & kv-options] (if (odd? (count args))
+                                     args
+                                     (cons (hooks/list-node
+                                            (list
+                                             (hooks/token-node 'clojure.core/constantly)
+                                             (hooks/token-node 'nil)))
+                                           args))]
+    (let [defmulti-form (hooks/list-node
+                         (filter
+                          some?
+                          [(hooks/token-node 'clojure.core/defmulti)
+                           multimethod-name
+                           docstring
+                           attribute-map
+                           dispatch-fn]))
+          result   (hooks/list-node
+                    (list*
+                     (hooks/token-node 'do)
+                     defmulti-form
+                     kv-options))]
+      #_(println "=>")
+      #_(clojure.pprint/pprint (hooks/sexpr result))
+      {:node result})))

src/methodical/impl/cache/simple.clj

@@ -7,6 +7,8 @@
             [pretty.core :as pretty])
   (:import methodical.interface.Cache))
 
+(set! *warn-on-reflection* true)
+
 (comment methodical.interface/keep-me)
 
 (p.types/deftype+ SimpleCache [atomm]

src/methodical/impl/cache/watching.clj

@@ -17,6 +17,8 @@
   (:import java.lang.ref.WeakReference
            methodical.interface.Cache))
 
+(set! *warn-on-reflection* true)
+
 (declare add-watches remove-watches)
 
 (p.types/deftype+ WatchingCache [^Cache cache watch-key refs]

src/methodical/impl/combo/clojure.clj

@@ -6,6 +6,8 @@
             [pretty.core :as pretty])
   (:import methodical.interface.MethodCombination))
 
+(set! *warn-on-reflection* true)
+
 (comment methodical.interface/keep-me)
 
 (p.types/deftype+ ClojureMethodCombination []

src/methodical/impl/combo/clos.clj

@@ -9,6 +9,8 @@
             [pretty.core :as pretty])
   (:import methodical.interface.MethodCombination))
 
+(set! *warn-on-reflection* true)
+
 (comment methodical.interface/keep-me)
 
 ;; TODO - I'm 90% sure we can leverage the `reducing-operator` stuff in `combo.operator` to implement this

src/methodical/impl/combo/operator.clj

@@ -37,11 +37,16 @@
       [city]
       ...)"
   (:refer-clojure :exclude [methods])
-  (:require [methodical.impl.combo.common :as combo.common]
-            methodical.interface
-            [potemkin.types :as p.types]
-            [pretty.core :as pretty])
-  (:import methodical.interface.MethodCombination))
+  (:require
+   [clojure.spec.alpha :as s]
+   [methodical.impl.combo.common :as combo.common]
+   [methodical.interface]
+   [potemkin.types :as p.types]
+   [pretty.core :as pretty])
+  (:import
+   (methodical.interface MethodCombination)))
+
+(set! *warn-on-reflection* true)
 
 (comment methodical.interface/keep-me)
 
@@ -84,16 +89,23 @@
        [~'_]
        fn#)))
 
+(s/fdef defoperator
+  :args (s/cat :operator-name keyword?
+               :bindings      (s/spec (s/cat :methods :clojure.core.specs.alpha/binding-form
+                                             :invoke  symbol?))
+               :body          (s/+ any?))
+  :ret any?)
+
 ;;;; ### Predefined operators
 
-(defoperator do [methods invoke]
+(defoperator :do [methods invoke]
   (loop [[method & more] methods]
     (let [result (invoke method)]
       (if (seq more)
         (recur more)
         result))))
 
-(defoperator seq [methods invoke]
+(defoperator :seq [methods invoke]
   ((fn seq* [[method & more]]
      (lazy-seq
       (cons
@@ -102,7 +114,7 @@
          (seq* more)))))
    methods))
 
-(defoperator concat [methods invoke]
+(defoperator :concat [methods invoke]
   ((fn seq* [[method & more]]
      (lazy-seq
       (concat
@@ -111,20 +123,20 @@
          (seq* more)))))
    methods))
 
-(defoperator and [methods invoke]
+(defoperator :and [methods invoke]
   (loop [[method & more] methods]
     (let [result (invoke method)]
       (if (and result (seq more))
         (recur more)
         result))))
 
-(defoperator or [methods invoke]
+(defoperator :or [methods invoke]
   (loop [[method & more] methods]
     (or (invoke method)
         (when (seq more)
           (recur more)))))
 
-(defoperator max [methods invoke]
+(defoperator :max [methods invoke]
   (loop [current-max nil, [method & more] methods]
     (let [result  (invoke method)
           new-max (if current-max
@@ -134,7 +146,7 @@
         (recur new-max more)
         new-max))))
 
-(defoperator min [methods invoke]
+(defoperator :min [methods invoke]
   (loop [current-min nil, [method & more] methods]
     (let [result  (invoke method)
           new-min (if current-min
@@ -144,7 +156,7 @@
         (recur new-min more)
         new-min))))
 
-(defoperator + [methods invoke]
+(defoperator :+ [methods invoke]
   (loop [sum 0, [method & more] methods]
     (let [sum (+ (invoke method) sum)]
       (if (seq more)
@@ -180,7 +192,7 @@
 
 (defn operator-method-combination
   "Create a new method combination using the operator named by `operator-name`, a keyword name of one of the
-  `defoperator` forms above or defined externallly.
+  `defoperator`: forms above or defined externallly.
 
     (operator-method-combination :max)"
   [operator-name]

src/methodical/impl/combo/threaded.clj

@@ -6,6 +6,8 @@
             [pretty.core :as pretty])
   (:import methodical.interface.MethodCombination))
 
+(set! *warn-on-reflection* true)
+
 (comment methodical.interface/keep-me)
 
 (defn reducer-fn
@@ -22,7 +24,7 @@
 (defn combine-with-threader
   "Combine primary and auxiliary methods using a threading invoker, i.e. something you'd get by calling
   `threading-invoker`. The way these methods are combined/reduced is the same, regardless of how args are threaded;
-  thus, various strategies such as `:thread-first` and `:thread-last` can both share the same `reducer-fn`. "
+  thus, various strategies such as `:thread-first` and `:thread-last` can both share the same `reducer-fn`."
   ([threader before-primary-afters]
    (comp (reducer-fn before-primary-afters) threader))