Massive nutrient measurement overhaul.

1. Better struct accessor names (rename-out),
2. Eagerly load nutrient values when getting a nutrient measurement.

2 files changed, 111 insertions, 91 deletions

diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt
index 0f66466..7ccc7f3 100644
--- a/models/nutrient-measurement.rkt
+++ b/models/nutrient-measurement.rkt
@@ -4,7 +4,10 @@
  ;; Struct definitions
  nutrient-measurement
  nutrient-measurement?
- nutrient-measurement-id nutrient-measurement-measured-on
+ nutrient-measurement-id
+ (rename-out
+  [nutrient-measurement-measured-on nutrient-measurement-date]
+  [nutrient-measurement-nutrient-values nutrient-measurement-values])
  ;; SQL CRUD
  (contract-out
   [create-nutrient-measurement! (-> string?
@@ -28,71 +31,114 @@
          "nutrient.rkt")
 
 ;; Instances of this struct are persisted in the nutrient_measurements table.
-(struct nutrient-measurement (id measured-on) #:transparent)
+(struct nutrient-measurement (id measured-on nutrient-values) #:transparent)
 
 
 ;; CREATE
 
 (define (create-nutrient-measurement! measured-on nutrient-values)
-  (define existing-nutrient-measurement (get-nutrient-measurement #:measured-on measured-on))
-  (define (new-nutrient-measurement)
-    (with-tx
-      (query-exec (current-conn)
-                  (insert #:into nutrient_measurements
-                          #:set [measured_on ,measured-on]))
-      (define nm-id (nutrient-measurement-id (get-nutrient-measurement #:measured-on measured-on)))
-      (query-exec (current-conn)
-                  (insert #:into nutrient_value_sets
-                          #:set [nutrient_measurement_id ,nm-id]))
-      (define nvs-id (query-value (current-conn)
-                                  (select id
-                                          #:from nutrient_value_sets
-                                          #:where (= nutrient_measurement_id ,nm-id))))
-      (for ([nv nutrient-values])
-        (match nv
-          [(cons n v)
-           (query-exec (current-conn)
-                       (insert #:into nutrient_values
-                               #:set
-                               [value_set_id ,nvs-id]
-                               [nutrient_id  ,(nutrient-id n)]
-                               [value_ppm    ,v]))])))
-    (get-nutrient-measurement #:measured-on measured-on))
-  (or existing-nutrient-measurement
-      (new-nutrient-measurement)))
+  (with-tx
+    (query-exec (current-conn)
+                (insert #:into nutrient_measurements
+                        #:set [measured_on ,measured-on]))
+    (define nm-id (query-value (current-conn)
+                               (select id
+                                       #:from nutrient_measurements
+                                       #:where (= measured_on ,measured-on))))
+    (query-exec (current-conn)
+                (insert #:into nutrient_value_sets
+                        #:set [nutrient_measurement_id ,nm-id]))
+    (define nvs-id (query-value (current-conn)
+                                (select id
+                                        #:from nutrient_value_sets
+                                        #:where (= nutrient_measurement_id ,nm-id))))
+    (for ([nv nutrient-values])
+      (match nv
+        [(cons n v)
+         (query-exec (current-conn)
+                     (insert #:into nutrient_values
+                             #:set
+                             [value_set_id ,nvs-id]
+                             [nutrient_id  ,(nutrient-id n)]
+                             [value_ppm    ,v]))]))
+    (get-nutrient-measurement #:measured-on measured-on)))
 
 
 ;; READ
 
-(define (get-nutrient-measurements)
-  (for/list ([(id* measured-on*)
-              (in-query (current-conn)
-                        (select id measured_on
-                                #:from nutrient_measurements
-                                #:order-by measured_on #:asc))])
-    (nutrient-measurement id* measured-on*)))
+(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)
+      #:on (= nvs.nutrient_measurement_id nm.id))
+     (as nutrient_values nv)
+     #:on (= nv.value_set_id nvs.id))
+    (as nutrients n)
+    #:on (= n.id nv.nutrient_id))))
 
-(define (get-nutrient-measurement #:id [id #f]
+(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 (where-expr)
-    (define clauses
-      (filter values
-              (list
-               (and id (format "id = ~e" id))
-               (and measured-on (format "measured_on = ~e" measured-on)))))
+  (define where
     (cond
-      [(null? clauses) ""]
-      [else (format "WHERE ~a" (string-join clauses " AND "))]))
-  (define query (string-join
-                 `("SELECT id, measured_on"
-                   "FROM nutrient_measurements"
-                   ,(where-expr)
-                   "ORDER BY id ASC"
-                   "LIMIT 1")))
-  (match (query-maybe-row (current-conn) query)
-    [(vector id* measured-on*)
-     (nutrient-measurement id* measured-on*)]
-    [#f #f]))
+      [(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
+                        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 rows belonging to the single 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))))]))
 
 (define (get-nutrient-measurement-values nutrient-measurement)
   (for/list ([(nutrient-id name formula value_ppm)
diff --git a/tests/nutrient-measurement-model.rkt b/tests/nutrient-measurement-model.rkt
index b0b053d..d6b2b60 100644
--- a/tests/nutrient-measurement-model.rkt
+++ b/tests/nutrient-measurement-model.rkt
@@ -8,7 +8,7 @@
            "../models/nutrient.rkt"
            "../models/nutrient-measurement.rkt")
 
-  (define measured-on "2025-09-01")
+  (define measurement-date "2025-09-01")
 
   (run-tests
    (test-suite
@@ -26,46 +26,20 @@
     (test-case "Create measurement with values"
       (define nitrogen (get-nutrient #:name "Nitrogen"))
       (define phosphorus (get-nutrient #:name "Phosphorus"))
-      (create-nutrient-measurement! measured-on (list
-                                                 (cons nitrogen 12.3)
-                                                 (cons phosphorus 4.5)))
+      (create-nutrient-measurement! measurement-date
+                                    `((,nitrogen . 12.3)
+                                      (,phosphorus . 4.5)))
       (check-equal? (length (get-nutrient-measurements)) 1)
-      (define nm (get-nutrient-measurement #:measured-on measured-on))
+      (define nm (get-nutrient-measurement #:measured-on measurement-date))
       (check-true (nutrient-measurement? nm))
-      (check-equal? (nutrient-measurement-measured-on nm) measured-on)
-      (define mvs (get-nutrient-measurement-values nm))
-      (check-equal? (length mvs) 2)
-      (check-equal? (cdr (assoc nitrogen mvs)) 12.3)
-      (check-equal? (cdr (assoc phosphorus mvs)) 4.5)
-      )
-
-    #;(test-case "Update a single measurement value"
-        (define nitrogen (get-nutrient #:name "Nitrogen"))
-        (define nm (get-nutrient-measurement #:measured-on measured-on))
-        (update-nutrient-measurement! nm #:nutrient-values (list (cons nitrogen 1.1)))
-        (define mvs (get-nutrient-measurement-values nm))
-        (check-equal? (length mvs) 2)
-        (check-equal? (cdr (assoc nitrogen mvs)) 1.1))
-
-    #;(test-case "Upsert measurement values"
-        (define nitrogen (get-nutrient #:name "Nitrogen"))
-        (define phosphorus (get-nutrient #:name "Phosphorus"))
-        (define potassium (get-nutrient #:name "Potassium"))
-        (define nm (get-nutrient-measurement #:measured-on measured-on))
-        ;; Upsert: set K=8.8 and change N to 10.0, keep P as-is
-        (update-nutrient-measurement! nm
-                                      #:nutrient-values (list
-                                                         (cons nitrogen 10.0)
-                                                         (cons potassium 8.8)))
-        (define mvs (get-nutrient-measurement-values nm))
-        (check-equal? (length mvs) 3)
-        (check-equal? (cdr (assoc nitrogen mvs)) 10.0)
-        (check-equal? (cdr (assoc potassium mvs)) 8.8)
-        ;; P should still be present at 4.5
-        (check-equal? (cdr (assoc phosphorus mvs)) 4.5))
+      (check-equal? (nutrient-measurement-date nm) measurement-date)
+      (define nmv (nutrient-measurement-values nm))
+      (check-equal? (length nmv) 2)
+      (check-equal? (cdr (assoc nitrogen nmv)) 12.3)
+      (check-equal? (cdr (assoc phosphorus nmv)) 4.5))
 
     (test-case "Delete measurement cascades its values"
-      (define nm (get-nutrient-measurement #:measured-on measured-on))
+      (define nm (get-nutrient-measurement #:measured-on measurement-date))
       (delete-nutrient-measurement! nm)
       (check-false (get-nutrient-measurement #:id (nutrient-measurement-id nm)))
       (check-equal? (length (get-nutrient-measurements)) 0)