feat: ensure capture all instances of rule env and rule form meta

Author: k13gomez

clj-kondo/clj-kondo.exports/clara/rules/hooks/clara_rules.clj_kondo

@@ -410,7 +410,7 @@
                     (api/token-node 'def)
                     var-name
                     (api/vector-node
-                      children)))
+                     children)))
                   merge {:clj-kondo/ignore [:clojure-lsp/unused-public-var]})]
     {:node new-node}))
 

src/main/clojure/clara/rules.clj

@@ -256,19 +256,23 @@
   See the [rule authoring documentation](http://www.clara-rules.org/docs/rules/) for details."
   [rule-name & body]
   (let [doc (if (string? (first body)) (first body) nil)
-        rule (dsl/build-rule rule-name body (meta &form)) ;;; Full rule LHS + RHS
-        rule-action (dsl/build-rule-action rule-name body (meta &form)) ;;; Only the RHS
+        rule (dsl/build-rule rule-name body &env (meta &form)) ;;; Full rule LHS + RHS
+        rule-action (dsl/build-rule-action rule-name body &env (meta &form)) ;;; Only the RHS
         rule-node (com/build-rule-node rule-action) ;;; The Node of the RHS
         {:keys [bindings production]} rule-node
         rule-handler (com/compile-action-handler rule-name bindings
                                                  (:rhs production)
                                                  (:env production))
+        [rule-args & rule-body] (drop 2 rule-handler)
         name-with-meta (vary-meta rule-name assoc :rule true :doc doc)
         handler-name (symbol (name (ns-name *ns*)) (name rule-name))] ;;; The compiled RHS
     `(defn ~name-with-meta
        ([]
         (assoc ~rule :handler '~handler-name))
-       (~@(drop 2 rule-handler)))))
+       ([~@(take 1 rule-args)]
+        (~rule-name '?__token__ {}))
+       ([~@rule-args]
+        ~@rule-body))))
 
 (defmacro defquery
   "Defines a query and stores it in the given var. For instance, a simple query that accepts no
@@ -283,7 +287,7 @@
   [name & body]
   (let [doc (if (string? (first body)) (first body) nil)]
     `(def ~(vary-meta name assoc :query true :doc doc)
-       ~(dsl/build-query name body (meta &form)))))
+       ~(dsl/build-query name body &env (meta &form)))))
 
 (defmacro defhierarchy
   "Defines a hierarchy and stores it in the given var. For instance, a simple hierarchy that adds

src/main/clojure/clara/rules/compiler.clj

@@ -396,16 +396,17 @@
                             binding-keys)
 
         ;; The destructured environment, if any.
-        destructured-env (if (> (count env) 0)
-                           {:keys (mapv #(symbol (name %)) (keys env))}
-                           '?__env__)]
-    `(fn ~action-name [~'?__token__ ~destructured-env]
+        destructured-env (if (pos? (count env))
+                           {:keys (mapv (comp symbol name) (keys env)) :as '?__env__}
+                           '?__env__)
+        destructured-bindings (if (pos? (count token-binding-keys))
+                                {{:keys (mapv (comp symbol name) token-binding-keys)} :bindings
+                                 :as '?__token__}
+                                '?__token__)]
+    `(fn ~action-name [~destructured-bindings ~destructured-env]
        ;; similar to test nodes, nothing in the contract of an RHS enforces that bound variables must be used.
        ;; similarly we will not bind anything in this event, and thus the let block would be superfluous.
-       ~(if (seq token-binding-keys)
-          `(let [{:keys [~@(map (comp symbol name) token-binding-keys)]} (:bindings ~'?__token__)]
-             ~rhs)
-          rhs))))
+       ~rhs)))
 
 (defn compile-action
   "Compile the right-hand-side action of a rule, returning a function to execute it."

src/main/clojure/clara/rules/dsl.clj

@@ -220,9 +220,7 @@
 (defn parse-rule*
   "Creates a rule from the DSL syntax using the given environment map.  *ns*
    should be bound to the namespace the rule is meant to be defined in."
-  ([lhs rhs properties env]
-   (parse-rule* lhs rhs properties env {}))
-  ([lhs rhs properties env rule-meta]
+  ([lhs rhs properties rule-env rule-meta]
    (let [conditions (into [] (for [expr lhs]
                                (parse-expression expr rule-meta)))
 
@@ -235,7 +233,7 @@
                                          assoc :file *file*))}
 
          symbols (set (filter symbol? (com/flatten-expression (concat lhs rhs))))
-         matching-env (into {} (for [sym (keys env)
+         matching-env (into {} (for [sym (keys rule-env)
                                      :when (symbols sym)]
                                  [(keyword (name sym)) sym]))]
 
@@ -245,14 +243,12 @@
        (seq properties) (assoc :props properties)
 
        ;; Add the environment, if given.
-       (seq env) (assoc :env matching-env)))))
+       (seq rule-env) (assoc :env matching-env)))))
 
 (defn parse-rule-action*
   "Creates a rule action from the DSL syntax using the given environment map.  *ns*
    should be bound to the namespace the rule is meant to be defined in."
-  ([lhs rhs properties env]
-   (parse-rule-action* lhs rhs properties env {}))
-  ([lhs rhs properties env rule-meta]
+  ([lhs rhs properties rule-env rule-meta]
    (let [conditions (into [] (for [expr lhs]
                                (parse-expression expr rule-meta)))
 
@@ -262,7 +258,7 @@
                :rhs     (vary-meta rhs assoc :file *file*)}
 
          symbols (set (filter symbol? (com/flatten-expression (concat lhs rhs))))
-         matching-env (into {} (for [sym (keys env)
+         matching-env (into {} (for [sym (keys rule-env)
                                      :when (symbols sym)]
                                  [(keyword (name sym)) sym]))]
 
@@ -272,13 +268,11 @@
        (seq properties) (assoc :props properties)
 
        ;; Add the environment, if given.
-       (seq env) (assoc :env matching-env)))))
+       (seq rule-env) (assoc :env matching-env)))))
 
 (defn parse-query*
   "Creates a query from the DSL syntax using the given environment map."
-  ([params lhs env]
-   (parse-query* params lhs env {}))
-  ([params lhs env query-meta]
+  ([params lhs query-env query-meta]
    (let [conditions (into [] (for [expr lhs]
                                (parse-expression expr query-meta)))
 
@@ -288,19 +282,19 @@
 
          symbols (set (filter symbol? (com/flatten-expression lhs)))
          matching-env (into {}
-                            (for [sym (keys env)
+                            (for [sym (keys query-env)
                                   :when (symbols sym)]
                               [(keyword (name sym)) sym]))]
 
      (cond-> query
-       (seq env) (assoc :env matching-env)))))
+       (seq query-env) (assoc :env matching-env)))))
 
 (defmacro parse-rule
   "Macro used to dynamically create a new rule using the DSL syntax."
   ([lhs rhs]
-   (parse-rule* lhs rhs nil &env))
+   (parse-rule* lhs rhs nil &env (meta &form)))
   ([lhs rhs properties]
-   (parse-rule* lhs rhs properties &env)))
+   (parse-rule* lhs rhs properties &env (meta &form))))
 
 ;;; added to clojure.core in 1.9
 (defn- qualified-keyword?
@@ -315,44 +309,41 @@
 
 (defn build-rule
   "Function used to parse and build a rule using the DSL syntax."
-  ([name body] (build-rule name body {}))
-  ([name body form-meta]
+  ([name body rule-env rule-meta]
    (let [doc (if (string? (first body)) (first body) nil)
          body (if doc (rest body) body)
          properties (if (map? (first body)) (first body) nil)
          definition (if properties (rest body) body)
          {:keys [lhs rhs]} (split-lhs-rhs definition)]
-     (cond-> (parse-rule* lhs rhs properties {} form-meta)
+     (cond-> (parse-rule* lhs rhs properties rule-env rule-meta)
 
        name (assoc :name (production-name name))
        doc (assoc :doc doc)))))
 
 (defn build-rule-action
   "Function used to parse and build a rule action using the DSL syntax."
-  ([name body] (build-rule-action name body {}))
-  ([name body form-meta]
+  ([name body rule-env rule-meta]
    (let [doc (if (string? (first body)) (first body) nil)
          body (if doc (rest body) body)
          properties (if (map? (first body)) (first body) nil)
          definition (if properties (rest body) body)
          {:keys [lhs rhs]} (split-lhs-rhs definition)]
-     (cond-> (parse-rule-action* lhs rhs properties {} form-meta)
+     (cond-> (parse-rule-action* lhs rhs properties rule-env rule-meta)
 
        name (assoc :name (production-name name))
        doc (assoc :doc doc)))))
 
 (defmacro parse-query
   "Macro used to dynamically create a new rule using the DSL syntax."
   [params lhs]
-  (parse-query* params lhs &env))
+  (parse-query* params lhs &env (meta &form)))
 
 (defn build-query
   "Function used to parse and build a query using the DSL syntax."
-  ([name body] (build-query name body {}))
-  ([name body form-meta]
+  ([name body env form-meta]
    (let [doc (if (string? (first body)) (first body) nil)
          binding (if doc (second body) (first body))
          definition (if doc (drop 2 body) (rest body))]
-     (cond-> (parse-query* binding definition {} form-meta)
+     (cond-> (parse-query* binding definition env form-meta)
        name (assoc :name (production-name name))
        doc (assoc :doc doc)))))

src/main/clojure/clara/tools/testing_utils.clj

@@ -31,14 +31,14 @@
                        (partition 2)
                        (into {}
                              (map (fn [[rule-name [lhs rhs props]]]
-                                    [rule-name (assoc (dsl/parse-rule* lhs rhs props {}) :name (str rule-name))]))))
+                                    [rule-name (assoc (dsl/parse-rule* lhs rhs props &env (meta &form)) :name (str rule-name))]))))
 
         sym->query (->> params
                         :queries
                         (partition 2)
                         (into {}
                               (map (fn [[query-name [params lhs]]]
-                                     [query-name (assoc (dsl/parse-query* params lhs {}) :name (str query-name))]))))
+                                     [query-name (assoc (dsl/parse-query* params lhs &env (meta &form)) :name (str query-name))]))))
 
         production-syms->productions (fn [p-syms]
                                        (map (fn [s]