diff options
| -rw-r--r-- | models/nutrient-measurement.rkt | 154 | ||||
| -rw-r--r-- | tests/nutrient-measurement-model.rkt | 48 |
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) |