From 0fc6231625943ad8b8faac8c0519f8599b5b8e84 Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Thu, 23 Oct 2025 16:33:17 +0200 Subject: Massive nutrient measurement overhaul. 1. Better struct accessor names (rename-out), 2. Eagerly load nutrient values when getting a nutrient measurement. --- models/nutrient-measurement.rkt | 154 ++++++++++++++++++++++++++-------------- 1 file changed, 100 insertions(+), 54 deletions(-) (limited to 'models') 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) -- cgit v1.2.3