From 09ba1e517c12561e25c9c36796029004eaa3f578 Mon Sep 17 00:00:00 2001
From: Marius Peter <dev@marius-peter.com>
Date: Thu, 20 Nov 2025 11:31:50 +0100
Subject: Use db library grouping mechanism rather than ad-hoc accumulator.

---
 models/nutrient-measurement.rkt | 92 +++++++++++++++++------------------------
 1 file changed, 38 insertions(+), 54 deletions(-)

(limited to 'models/nutrient-measurement.rkt')

diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt
index 1cabf63..dbcb53c 100644
--- a/models/nutrient-measurement.rkt
+++ b/models/nutrient-measurement.rkt
@@ -66,7 +66,6 @@
 
 ;; READ
 
-(struct acc (measured-on pairs) #:transparent)
 (define joined
   (table-expr-qq (inner-join (inner-join (inner-join (as nutrient_measurements nm)
                                                      (as nutrient_value_sets nvs)
@@ -76,66 +75,51 @@
                              (as nutrients n)
                              #:on (= n.id nv.nutrient_id))))
 
+(define (grouped-row->nutrient-measurement row)
+  (match-define (vector nm-id measured-on residuals) row)
+  (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
+  (nutrient-measurement nm-id measured-on nutrient-value-pairs))
 
 (define (get-nutrient-measurements)
-  (define query (select nm.id nm.measured_on
-                        n.id n.canonical_name n.formula
-                        nv.value_ppm
-                        #:from (TableExpr:AST ,joined)
-                        #:order-by nm.measured_on #:desc))
-  (define rows (query-rows (current-conn) query))
-  (define by-id
-    (for/fold ([h (hash)]) ([row (in-list rows)])
-      (match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row)
-      (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
-      (hash-update h nm-id
-                   (λ (old-acc)
-                     (acc (acc-measured-on old-acc)
-                          (cons nv-pair (acc-pairs old-acc))))
-                   (λ ()
-                     (acc measured-on
-                          (list nv-pair))))))
-  (for/list ([(id a) (in-hash by-id)])
-    (nutrient-measurement id
-                          (acc-measured-on a)
-                          (reverse (acc-pairs a)))))
-
-(define (get-nutrient-measurement #:id [nm-id #f]
-                                  #:measured-on [measured-on #f])
+  (define grouped-rows (query-rows (current-conn)
+                                   (select nm.id
+                                           nm.measured_on
+                                           n.id
+                                           n.canonical_name
+                                           n.formula
+                                           nv.value_ppm
+                                           #:from (TableExpr:AST ,joined)
+                                           #:order-by nm.measured_on
+                                           #:desc)
+                                   #:group '#(0 1)))
+  (for/list ([row grouped-rows])
+    (grouped-row->nutrient-measurement row)))
+
+(define (get-nutrient-measurement #:id [nm-id #f] #:measured-on [measured-on #f])
   (define where
     (cond
       [(and nm-id measured-on)
-       (scalar-expr-qq (and (= nm.id ,nm-id)
-                            (= nm.measured_on ,measured-on)))]
-      [nm-id
-       (scalar-expr-qq (= nm.id ,nm-id))]
-      [measured-on
-       (scalar-expr-qq (= nm.measured_on ,measured-on))]))
-  (define query (select nm.id nm.measured_on
-                        n.id n.canonical_name n.formula
+       (scalar-expr-qq (and (= nm.id ,nm-id) (= nm.measured_on ,measured-on)))]
+      [nm-id (scalar-expr-qq (= nm.id ,nm-id))]
+      [measured-on (scalar-expr-qq (= nm.measured_on ,measured-on))]
+      [else (error 'get-nutrient-measurement "either #:id or #:measured-on must be provided")]))
+  (define grouped-rows
+    (query-rows (current-conn)
+                (select nm.id
+                        nm.measured_on
+                        n.id
+                        n.canonical_name
+                        n.formula
                         nv.value_ppm
                         #:from (TableExpr:AST ,joined)
-                        #:where (ScalarExpr:AST ,where)))
-  (define rows (query-rows (current-conn) query))
-  (cond
-    [(null? rows) #f]
-    [else
-     ;; Fold all nutrient value rows belonging to the single nutrient measurement into one struct
-     (define the-id #f)
-     (define A #f)
-     (for ([row (in-list rows)])
-       (match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row)
-       (unless the-id (set! the-id nm-id))
-       (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
-       (set! A (if A
-                   (acc (acc-measured-on A)
-                        (cons nv-pair (acc-pairs A)))
-                   (acc measured-on
-                        (list nv-pair)))))
-     (and A
-          (nutrient-measurement the-id
-                                (acc-measured-on A)
-                                (reverse (acc-pairs A))))]))
+                        #:where (ScalarExpr:AST ,where)
+                        #:order-by nm.measured_on
+                        #:desc)
+                #:group '#(0 1)))
+  (match grouped-rows
+    ['() #f]
+    [(list row) (grouped-row->nutrient-measurement row)]
+    [many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))]))
 
 (define (get-nutrient-measurement-values nutrient-measurement)
   (for/list ([(nutrient-id name formula value_ppm)
-- 
cgit v1.2.3