refactor: Batch Datalevin queries and share datetime formatters

Author: bzg

scripts/bark-docs.clj

@@ -358,18 +358,21 @@
 ;; Maintainers section
 ;; ---------------------------------------------------------------------------
 
-(defn- participant-name
-  "Look up a participant's display name by email for a given source.
-  Returns the name if found and non-blank, otherwise nil."
-  [db source-name email]
-  (let [dq (resolve 'pod.huahaiy.datalevin/q)
-        k  (str source-name ":" (str/lower-case email))]
-    (when-let [n (dq '[:find ?n .
-                       :in $ ?k
-                       :where [?e :participant/key ?k]
-                       [?e :participant/name ?n]]
-                     db k)]
-      (when-not (str/blank? n) n))))
+(defn- participant-names-for-source
+  "Return `{lowercase-email -> non-blank name}` for all participants of
+  `source-name`.  Single query, intended for batch lookups."
+  [db source-name]
+  (let [dq (resolve 'pod.huahaiy.datalevin/q)]
+    (->> (dq '[:find ?email ?name
+               :in $ ?src
+               :where
+               [?e :participant/source ?src]
+               [?e :participant/email ?email]
+               [?e :participant/name ?name]]
+             db source-name)
+         (reduce (fn [acc [email name]]
+                   (if (str/blank? name) acc (assoc acc email name)))
+                 {}))))
 
 (defn- html-escape
   "Escape HTML special characters in a string."
@@ -391,14 +394,15 @@
   (when source-name
     (let [tenures     (get-tenures db source-name)
           lead        (lead-maintainer tenures)
+          names       (participant-names-for-source db source-name)
           ;; Sort: lead first, then alphabetical by email (case-insensitive).
           sort-key    (fn [{:keys [email to]}]
                         [(if (and (nil? to) (= email lead)) 0 1)
                          (str/lower-case (or email ""))])
           ordered     (sort-by sort-key tenures)
           entries     (mapv
                        (fn [{:keys [email from to]}]
-                         (let [display (or (participant-name db source-name email) email)
+                         (let [display (or (get names (some-> email str/lower-case)) email)
                                escaped (html-escape display)
                                range   (cond
                                          (and from to)

scripts/bark-export.clj

@@ -613,14 +613,20 @@
      (when (seq data)
        (log/info "Wrote" (count data) "reports to" filename)))))
 
+(def ^:private rfc822-formatter
+  ;; DateTimeFormatter is immutable and thread-safe.  Pattern matches
+  ;; SimpleDateFormat's "EEE, dd MMM yyyy HH:mm:ss Z" output (e.g.
+  ;; "Mon, 12 May 2026 14:30:45 +0000") -- do not substitute with
+  ;; RFC_1123_DATE_TIME, which emits "GMT" and a non-padded day.
+  (-> (java.time.format.DateTimeFormatter/ofPattern "EEE, dd MMM yyyy HH:mm:ss Z")
+      (.withLocale java.util.Locale/ENGLISH)
+      (.withZone java.time.ZoneOffset/UTC)))
+
 (defn- rfc822-date
   "Format a java.util.Date as an RFC 822 date string (for RSS)."
   [^java.util.Date d]
   (when d
-    (let [out-fmt (doto (java.text.SimpleDateFormat. "EEE, dd MMM yyyy HH:mm:ss Z"
-                                                     java.util.Locale/ENGLISH)
-                    (.setTimeZone (java.util.TimeZone/getTimeZone "UTC")))]
-      (.format out-fmt d))))
+    (.format rfc822-formatter (.toInstant d))))
 
 (defn- rss-author [m]
   (let [email (:from m)

scripts/bark-stats.clj

@@ -166,35 +166,40 @@
        (group-by #(some-> (:report/type %) name))
        (into {} (map (fn [[t rs]] [t (count rs)])))))
 
-(defn- make-ym-formatter
-  "Create a locale-independent yyyy-MM formatter (UTC).
-  SimpleDateFormat is not thread-safe, so create a fresh instance each time."
-  ^java.text.SimpleDateFormat []
-  (doto (java.text.SimpleDateFormat. "yyyy-MM" java.util.Locale/ENGLISH)
-    (.setTimeZone (java.util.TimeZone/getTimeZone "UTC"))))
+(def ^:private ym-formatter
+  ;; DateTimeFormatter is immutable and thread-safe, so it can be shared.
+  (-> (java.time.format.DateTimeFormatter/ofPattern "yyyy-MM")
+      (.withLocale java.util.Locale/ENGLISH)
+      (.withZone java.time.ZoneOffset/UTC)))
 
 (defn- date->ym
   "Extract 'yyyy-MM' from a java.util.Date using a locale-independent formatter.
   Returns nil on failure."
   [date]
   (when date
-    (try (.format (make-ym-formatter) date)
+    (try (.format ym-formatter (.toInstant ^java.util.Date date))
          (catch Exception _ nil))))
 
 (defn- current-ym
   "Return [year month] for right now, locale-independent."
   []
-  (let [s (.format (make-ym-formatter) (java.util.Date.))
+  (let [s (.format ym-formatter (.toInstant (java.util.Date.)))
         [year month] (str/split s #"-")]
     [(parse-long year) (parse-long month)]))
 
+(def ^:private last-12-months*
+  ;; Memoize: the script runs once per invocation, so freezing the
+  ;; window at first deref is fine and avoids recomputing 4+ times.
+  (delay
+   (let [[cy cm] (current-ym)]
+     (vec (for [i (range 11 -1 -1)]
+            (let [total (+ (* cy 12) (dec cm) (- i))]
+              (format "%04d-%02d" (quot total 12) (inc (mod total 12)))))))))
+
 (defn- last-12-months
   "Return a vector of 12 \"yyyy-MM\" strings ending with the current month."
   []
-  (let [[cy cm] (current-ym)]
-    (vec (for [i (range 11 -1 -1)]
-           (let [total (+ (* cy 12) (dec cm) (- i))]
-             (format "%04d-%02d" (quot total 12) (inc (mod total 12))))))))
+  @last-12-months*)
 
 (defn- cumulative-by-month
   "Given a {\"yyyy-MM\" count} frequency map and a base count (entries before

src/bark/commands.clj

@@ -763,12 +763,39 @@
   "Build a partial pull map exposing relation setters under `:setter-attr`
   so `scope-permits?` can resolve `:setter-or-maintainer` on relation
   unset directives.  `rows` is a seq carrying `:kind`, `:role` and
-  `:setter-attr`."
+  `:setter-attr`.
+
+  Batches the per-row d/q calls into at most two queries (one per role)
+  to avoid N+1 lookups when several rows share a role."
   [db report-eid rows]
-  (into {} (keep (fn [{:keys [kind role setter-attr]}]
-                   (when-let [s (relation-setter db report-eid kind role)]
-                     [setter-attr {:email/author-address s}])))
-        rows))
+  (let [by-role      (group-by :role rows)
+        from-kinds   (some->> (get by-role :current-as-from) seq (map :kind) vec)
+        to-kinds     (some->> (get by-role :current-as-to) seq (map :kind) vec)
+        from-setters (when from-kinds
+                       (into {} (d/q '[:find ?kind ?setter
+                                       :in $ ?from [?kind ...]
+                                       :where
+                                       [?e :rel/from ?from]
+                                       [?e :rel/kind ?kind]
+                                       [?e :rel/active? true]
+                                       [?e :rel/setter ?setter]]
+                                     db report-eid from-kinds)))
+        to-setters   (when to-kinds
+                       (into {} (d/q '[:find ?kind ?setter
+                                       :in $ ?to [?kind ...]
+                                       :where
+                                       [?e :rel/to ?to]
+                                       [?e :rel/kind ?kind]
+                                       [?e :rel/active? true]
+                                       [?e :rel/setter ?setter]]
+                                     db report-eid to-kinds)))]
+    (into {}
+          (keep (fn [{:keys [kind role setter-attr]}]
+                  (when-let [s (case role
+                                 :current-as-from (get from-setters kind)
+                                 :current-as-to   (get to-setters kind))]
+                    [setter-attr {:email/author-address s}])))
+          rows)))
 
 (def ^:private closure-relation-rows
   "Specs for directive-driven closure relations (Superseded-by /

src/bark/digest.clj

@@ -289,27 +289,37 @@
         n           (parse-version-number new-version)]
     (when (and n (>= n 1))
       (let [versions-to-close (cond-> #{new-version}
-                                (> n 1) (conj (str "v" (dec n))))]
-        (doseq [rid nearest-report-eids]
-          ;; Refresh the snapshot per-iteration so prior transacts in
-          ;; this loop are visible to the :report/closed check below.
-          (let [r (d/pull (d/db conn)
-                          [:report/type :report/version :report/topic-value :report/closed
-                           :report/message-id]
-                          rid)]
-            (when (and (= :patch (:report/type r))
-                       (contains? versions-to-close (:report/version r))
-                       (not (:report/closed r))
-                       (or (and (nil? new-topic) (nil? (:report/topic-value r)))
-                           (and new-topic
-                                (= (str/lower-case new-topic)
-                                   (str/lower-case (or (:report/topic-value r) ""))))))
-              (auto-supersede-patch!
-               conn rid report-eid email
-               (str "[PATCH " (:report/version r)
-                    (when-let [t (:report/topic-value r)] (str " " t)) "] "
-                    "(" (:report/message-id r) ") "
-                    "(superseded by " new-version ")")))))))))
+                                (> n 1) (conj (str "v" (dec n))))
+            new-topic-lc      (some-> new-topic str/lower-case)
+            ;; Single snapshot: nearest-report-eids contains distinct
+            ;; rids and the daemon is single-threaded on this section,
+            ;; so no concurrent mutation of :report/closed can happen
+            ;; between pulls.  If that invariant changes, restore the
+            ;; per-iteration refresh.
+            db                (d/db conn)
+            candidates        (keep
+                               (fn [rid]
+                                 (let [r (d/pull db
+                                                 [:report/type :report/version
+                                                  :report/topic-value :report/closed
+                                                  :report/message-id]
+                                                 rid)]
+                                   (when (and (= :patch (:report/type r))
+                                              (contains? versions-to-close
+                                                         (:report/version r))
+                                              (not (:report/closed r))
+                                              (= new-topic-lc
+                                                 (some-> (:report/topic-value r)
+                                                         str/lower-case)))
+                                     [rid r])))
+                               nearest-report-eids)]
+        (doseq [[rid r] candidates]
+          (auto-supersede-patch!
+           conn rid report-eid email
+           (str "[PATCH " (:report/version r)
+                (when-let [t (:report/topic-value r)] (str " " t)) "] "
+                "(" (:report/message-id r) ") "
+                "(superseded by " new-version ")")))))))
 
 (defn- normalize-subject
   "Strip Re:/Fwd: prefixes and bracketed tags to get the base subject."
@@ -547,9 +557,11 @@
         email-eid (:db/id email)
         from-addr (:email/author-address email)
         addr-lc   (some-> from-addr str/lower-case)
-        targets   (rel/active-targets db patch-report-eid :resolves)]
+        targets   (rel/active-targets db patch-report-eid :resolves)
+        patch-mid (:report/message-id
+                   (d/pull db [:report/message-id] patch-report-eid))]
     (doseq [bug-eid targets]
-      (let [bug-state (d/pull db [:report/acked :report/owned] bug-eid)
+      (let [bug-state (d/pull db [:report/acked :report/owned :report/message-id] bug-eid)
             credit    (fn [tx attr addr-attr]
                         (cond-> tx
                           (nil? (get bug-state attr))
@@ -561,9 +573,8 @@
           (d/transact! conn tx)
           (tracking/bump-report-updated! conn bug-eid)
           (log/info "Auto-credit:" from-addr "credited as acked+owned of"
-                    (:report/message-id (d/pull (d/db conn) [:report/message-id] bug-eid))
-                    "via patch"
-                    (:report/message-id (d/pull (d/db conn) [:report/message-id] patch-report-eid))))))))
+                    (:report/message-id bug-state)
+                    "via patch" patch-mid))))))
 
 (defn- run-post-creation-hooks!
   "Execute post-creation side effects driven by the plan."

src/bark/relations.clj

@@ -341,10 +341,16 @@
           bugs (active-targets db patch-eid :resolves)]
       (case close-reason
         :resolved
-        (doseq [bug-eid bugs]
-          (let [closed? (some? (:report/closed
-                                (d/pull (d/db conn) [:report/closed] bug-eid)))]
-            (when-not closed?
+        ;; Bugs already closed are filtered up-front in a single query.
+        ;; Safe with one snapshot: each bug-eid is distinct, so closing
+        ;; bug-A does not affect the closed status of bug-B.
+        (let [closed-bugs (when (seq bugs)
+                            (set (d/q '[:find [?b ...]
+                                        :in $ [?b ...]
+                                        :where [?b :report/closed _]]
+                                      db bugs)))]
+          (doseq [bug-eid bugs]
+            (when-not (contains? closed-bugs bug-eid)
               (d/transact! conn [{:db/id bug-eid
                                   :report/closed email-eid
                                   :report/close-reason :resolved}]))))

src/bark/series.clj

@@ -145,11 +145,11 @@
                                              :where [?s :series/cover-letter ?e]
                                              [?e :email/message-id ?mid]]
                                            db existing-series))
-                            parent-mids (set (keep (fn [rid]
-                                                     (d/q '[:find ?mid . :in $ ?r
-                                                            :where [?r :report/message-id ?mid]]
-                                                          db rid))
-                                                   parent-report-eids))]
+                            parent-mids (when (seq parent-report-eids)
+                                          (set (d/q '[:find [?mid ...]
+                                                      :in $ [?r ...]
+                                                      :where [?r :report/message-id ?mid]]
+                                                    db parent-report-eids)))]
                         (some old-mids parent-mids)))]
       (when (and restart? ancestor?)
         (doseq [sid existing-series]