Massive nutrient measurement overhaul.

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

Commit
0fc6231625943ad8b8faac8c0519f8599b5b8e84
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
models/nutrient-measurement.rkt
index 0f664661..7ccc7f39 100644..100644
@@ -4,7 +4,10 @@
4 4 ;; Struct definitions
5 5 nutrient-measurement
6 6 nutrient-measurement?
7 Removed: nutrient-measurement-id nutrient-measurement-measured-on
7 Added: nutrient-measurement-id
8 Added: (rename-out
9 Added: [nutrient-measurement-measured-on nutrient-measurement-date]
10 Added: [nutrient-measurement-nutrient-values nutrient-measurement-values])
8 11 ;; SQL CRUD
9 12 (contract-out
10 13 [create-nutrient-measurement! (-> string?
@@ -28,71 +31,114 @@
28 31 "nutrient.rkt")
29 32
30 33 ;; Instances of this struct are persisted in the nutrient_measurements table.
31 Removed: (struct nutrient-measurement (id measured-on) #:transparent)
34 Added: (struct nutrient-measurement (id measured-on nutrient-values) #:transparent)
32 35
33 36
34 37 ;; CREATE
35 38
36 39 (define (create-nutrient-measurement! measured-on nutrient-values)
37 Removed: (define existing-nutrient-measurement (get-nutrient-measurement #:measured-on measured-on))
38 Removed: (define (new-nutrient-measurement)
39 Removed: (with-tx
40 Removed: (query-exec (current-conn)
41 Removed: (insert #:into nutrient_measurements
42 Removed: #:set [measured_on ,measured-on]))
43 Removed: (define nm-id (nutrient-measurement-id (get-nutrient-measurement #:measured-on measured-on)))
44 Removed: (query-exec (current-conn)
45 Removed: (insert #:into nutrient_value_sets
46 Removed: #:set [nutrient_measurement_id ,nm-id]))
47 Removed: (define nvs-id (query-value (current-conn)
48 Removed: (select id
49 Removed: #:from nutrient_value_sets
50 Removed: #:where (= nutrient_measurement_id ,nm-id))))
51 Removed: (for ([nv nutrient-values])
52 Removed: (match nv
53 Removed: [(cons n v)
54 Removed: (query-exec (current-conn)
55 Removed: (insert #:into nutrient_values
56 Removed: #:set
57 Removed: [value_set_id ,nvs-id]
58 Removed: [nutrient_id ,(nutrient-id n)]
59 Removed: [value_ppm ,v]))])))
60 Removed: (get-nutrient-measurement #:measured-on measured-on))
61 Removed: (or existing-nutrient-measurement
62 Removed: (new-nutrient-measurement)))
40 Added: (with-tx
41 Added: (query-exec (current-conn)
42 Added: (insert #:into nutrient_measurements
43 Added: #:set [measured_on ,measured-on]))
44 Added: (define nm-id (query-value (current-conn)
45 Added: (select id
46 Added: #:from nutrient_measurements
47 Added: #:where (= measured_on ,measured-on))))
48 Added: (query-exec (current-conn)
49 Added: (insert #:into nutrient_value_sets
50 Added: #:set [nutrient_measurement_id ,nm-id]))
51 Added: (define nvs-id (query-value (current-conn)
52 Added: (select id
53 Added: #:from nutrient_value_sets
54 Added: #:where (= nutrient_measurement_id ,nm-id))))
55 Added: (for ([nv nutrient-values])
56 Added: (match nv
57 Added: [(cons n v)
58 Added: (query-exec (current-conn)
59 Added: (insert #:into nutrient_values
60 Added: #:set
61 Added: [value_set_id ,nvs-id]
62 Added: [nutrient_id ,(nutrient-id n)]
63 Added: [value_ppm ,v]))]))
64 Added: (get-nutrient-measurement #:measured-on measured-on)))
63 65
64 66
65 67 ;; READ
66 68
69 Added: (struct acc (measured-on pairs) #:transparent)
70 Added:
71 Added: (define joined
72 Added: (table-expr-qq
73 Added: (inner-join
74 Added: (inner-join
75 Added: (inner-join
76 Added: (as nutrient_measurements nm)
77 Added: (as nutrient_value_sets nvs)
78 Added: #:on (= nvs.nutrient_measurement_id nm.id))
79 Added: (as nutrient_values nv)
80 Added: #:on (= nv.value_set_id nvs.id))
81 Added: (as nutrients n)
82 Added: #:on (= n.id nv.nutrient_id))))
83 Added:
67 84 (define (get-nutrient-measurements)
68 Removed: (for/list ([(id* measured-on*)
69 Removed: (in-query (current-conn)
70 Removed: (select id measured_on
71 Removed: #:from nutrient_measurements
72 Removed: #:order-by measured_on #:asc))])
73 Removed: (nutrient-measurement id* measured-on*)))
85 Added: (define query (select nm.id nm.measured_on
86 Added: n.id n.canonical_name n.formula
87 Added: nv.value_ppm
88 Added: #:from (TableExpr:AST ,joined)
89 Added: #:order-by nm.measured_on #:desc))
90 Added: (define rows (query-rows (current-conn) query))
91 Added: (define by-id
92 Added: (for/fold ([h (hash)]) ([row (in-list rows)])
93 Added: (match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row)
94 Added: (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
95 Added: (hash-update h nm-id
96 Added: (λ (old-acc)
97 Added: (acc (acc-measured-on old-acc)
98 Added: (cons nv-pair (acc-pairs old-acc))))
99 Added: (λ ()
100 Added: (acc measured-on
101 Added: (list nv-pair))))))
102 Added: (for/list ([(id a) (in-hash by-id)])
103 Added: (nutrient-measurement id
104 Added: (acc-measured-on a)
105 Added: (reverse (acc-pairs a)))))
74 106
75 Removed: (define (get-nutrient-measurement #:id [id #f]
107 Added: (define (get-nutrient-measurement #:id [nm-id #f]
76 108 #:measured-on [measured-on #f])
77 Removed: (define (where-expr)
78 Removed: (define clauses
79 Removed: (filter values
80 Removed: (list
81 Removed: (and id (format "id = ~e" id))
82 Removed: (and measured-on (format "measured_on = ~e" measured-on)))))
109 Added: (define where
83 110 (cond
84 Removed: [(null? clauses) ""]
85 Removed: [else (format "WHERE ~a" (string-join clauses " AND "))]))
86 Removed: (define query (string-join
87 Removed: `("SELECT id, measured_on"
88 Removed: "FROM nutrient_measurements"
89 Removed: ,(where-expr)
90 Removed: "ORDER BY id ASC"
91 Removed: "LIMIT 1")))
92 Removed: (match (query-maybe-row (current-conn) query)
93 Removed: [(vector id* measured-on*)
94 Removed: (nutrient-measurement id* measured-on*)]
95 Removed: [#f #f]))
111 Added: [(and nm-id measured-on)
112 Added: (scalar-expr-qq (and (= nm.id ,nm-id)
113 Added: (= nm.measured_on ,measured-on)))]
114 Added: [nm-id
115 Added: (scalar-expr-qq (= nm.id ,nm-id))]
116 Added: [measured-on
117 Added: (scalar-expr-qq (= nm.measured_on ,measured-on))]))
118 Added: (define query (select nm.id nm.measured_on
119 Added: n.id n.canonical_name n.formula
120 Added: nv.value_ppm
121 Added: #:from (TableExpr:AST ,joined)
122 Added: #:where (ScalarExpr:AST ,where)))
123 Added: (define rows (query-rows (current-conn) query))
124 Added: (cond
125 Added: [(null? rows) #f]
126 Added: [else
127 Added: ;; Fold all nutrient rows belonging to the single measurement into one struct
128 Added: (define the-id #f)
129 Added: (define A #f)
130 Added: (for ([row (in-list rows)])
131 Added: (match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row)
132 Added: (unless the-id (set! the-id nm-id))
133 Added: (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
134 Added: (set! A (if A
135 Added: (acc (acc-measured-on A)
136 Added: (cons nv-pair (acc-pairs A)))
137 Added: (acc measured-on (list nv-pair)))))
138 Added: (and A
139 Added: (nutrient-measurement the-id
140 Added: (acc-measured-on A)
141 Added: (reverse (acc-pairs A))))]))
96 142
97 143 (define (get-nutrient-measurement-values nutrient-measurement)
98 144 (for/list ([(nutrient-id name formula value_ppm)
tests/nutrient-measurement-model.rkt
index b0b053d3..d6b2b604 100644..100644
@@ -8,7 +8,7 @@
8 8 "../models/nutrient.rkt"
9 9 "../models/nutrient-measurement.rkt")
10 10
11 Removed: (define measured-on "2025-09-01")
11 Added: (define measurement-date "2025-09-01")
12 12
13 13 (run-tests
14 14 (test-suite
@@ -26,46 +26,20 @@
26 26 (test-case "Create measurement with values"
27 27 (define nitrogen (get-nutrient #:name "Nitrogen"))
28 28 (define phosphorus (get-nutrient #:name "Phosphorus"))
29 Removed: (create-nutrient-measurement! measured-on (list
30 Removed: (cons nitrogen 12.3)
31 Removed: (cons phosphorus 4.5)))
29 Added: (create-nutrient-measurement! measurement-date
30 Added: `((,nitrogen . 12.3)
31 Added: (,phosphorus . 4.5)))
32 32 (check-equal? (length (get-nutrient-measurements)) 1)
33 Removed: (define nm (get-nutrient-measurement #:measured-on measured-on))
33 Added: (define nm (get-nutrient-measurement #:measured-on measurement-date))
34 34 (check-true (nutrient-measurement? nm))
35 Removed: (check-equal? (nutrient-measurement-measured-on nm) measured-on)
36 Removed: (define mvs (get-nutrient-measurement-values nm))
37 Removed: (check-equal? (length mvs) 2)
38 Removed: (check-equal? (cdr (assoc nitrogen mvs)) 12.3)
39 Removed: (check-equal? (cdr (assoc phosphorus mvs)) 4.5)
40 Removed: )
35 Added: (check-equal? (nutrient-measurement-date nm) measurement-date)
36 Added: (define nmv (nutrient-measurement-values nm))
37 Added: (check-equal? (length nmv) 2)
38 Added: (check-equal? (cdr (assoc nitrogen nmv)) 12.3)
39 Added: (check-equal? (cdr (assoc phosphorus nmv)) 4.5))
41 40
42 Removed: #;(test-case "Update a single measurement value"
43 Removed: (define nitrogen (get-nutrient #:name "Nitrogen"))
44 Removed: (define nm (get-nutrient-measurement #:measured-on measured-on))
45 Removed: (update-nutrient-measurement! nm #:nutrient-values (list (cons nitrogen 1.1)))
46 Removed: (define mvs (get-nutrient-measurement-values nm))
47 Removed: (check-equal? (length mvs) 2)
48 Removed: (check-equal? (cdr (assoc nitrogen mvs)) 1.1))
49 Removed:
50 Removed: #;(test-case "Upsert measurement values"
51 Removed: (define nitrogen (get-nutrient #:name "Nitrogen"))
52 Removed: (define phosphorus (get-nutrient #:name "Phosphorus"))
53 Removed: (define potassium (get-nutrient #:name "Potassium"))
54 Removed: (define nm (get-nutrient-measurement #:measured-on measured-on))
55 Removed: ;; Upsert: set K=8.8 and change N to 10.0, keep P as-is
56 Removed: (update-nutrient-measurement! nm
57 Removed: #:nutrient-values (list
58 Removed: (cons nitrogen 10.0)
59 Removed: (cons potassium 8.8)))
60 Removed: (define mvs (get-nutrient-measurement-values nm))
61 Removed: (check-equal? (length mvs) 3)
62 Removed: (check-equal? (cdr (assoc nitrogen mvs)) 10.0)
63 Removed: (check-equal? (cdr (assoc potassium mvs)) 8.8)
64 Removed: ;; P should still be present at 4.5
65 Removed: (check-equal? (cdr (assoc phosphorus mvs)) 4.5))
66 Removed:
67 41 (test-case "Delete measurement cascades its values"
68 Removed: (define nm (get-nutrient-measurement #:measured-on measured-on))
42 Added: (define nm (get-nutrient-measurement #:measured-on measurement-date))
69 43 (delete-nutrient-measurement! nm)
70 44 (check-false (get-nutrient-measurement #:id (nutrient-measurement-id nm)))
71 45 (check-equal? (length (get-nutrient-measurements)) 0)