From dda53eeb77977b42ae2f50fa7113f195a15bed5f Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sat, 1 Nov 2025 15:23:08 +0100 Subject: Realign fertilizer-product model with nutrient-measurement. --- models/fertilizer-product.rkt | 208 ++++++++++++++++++++++++------------------ 1 file changed, 117 insertions(+), 91 deletions(-) diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt index f9cf5fd..9859537 100644 --- a/models/fertilizer-product.rkt +++ b/models/fertilizer-product.rkt @@ -14,11 +14,11 @@ [get-fertilizer-products (-> (listof fertilizer-product?))] [get-fertilizer-product (->* () (#:id (or/c #f exact-nonnegative-integer?) - #:brand-name (or/c #f string?)) + #:canonical-name (or/c #f string?)) (or/c fertilizer-product? #f))] - [get-fertilizer-product-values (-> fertilizer-product? (listof (cons/c nutrient? number?)))] + [get-fertilizer-product-values (-> fertilizer-product? + (listof (cons/c nutrient? number?)))] [get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)] - [get-latest-fertilizer-product-value (-> nutrient? number?)] [delete-fertilizer-product! (-> fertilizer-product? void?)])) (require racket/contract @@ -34,108 +34,134 @@ ;; CREATE (define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f]) - (define existing-fertilizer-product (get-fertilizer-product #:canonical-name canonical-name)) - (define (new-fertilizer-product) - (with-tx - (query-exec (current-conn) - (cond - [brand-name - (insert #:into fertilizer_products - #:set [canonical_name ,canonical-name] [brand_name ,brand-name])] - [else - (insert #:into fertilizer_products - #:set [canonical_name ,canonical-name])])) - (define nm-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name))) - (query-exec (current-conn) - (insert #:into nutrient_value_sets - #:set [fertilizer_product_id ,nm-id])) - (define nvs-id (query-value (current-conn) - (select id - #:from nutrient_value_sets - #:where (= fertilizer_product_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-fertilizer-product #:canonical-name canonical-name)) - (or existing-fertilizer-product - (new-fertilizer-product))) + (or (get-fertilizer-product #:canonical-name canonical-name) + (with-tx + (query-exec (current-conn) + (cond + [brand-name + (insert #:into fertilizer_products + #:set [canonical_name ,canonical-name] [brand_name ,brand-name])] + [else + (insert #:into fertilizer_products + #:set [canonical_name ,canonical-name])])) + (define fp-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name))) + (query-exec (current-conn) + (insert #:into nutrient_value_sets + #:set [fertilizer_product_id ,fp-id])) + (define nvs-id (query-value (current-conn) + (select id + #:from nutrient_value_sets + #:where (= fertilizer_product_id ,fp-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-fertilizer-product #:canonical-name canonical-name))) ;; READ +(struct acc (canonical-name brand-name pairs) #:transparent) + +(define joined + (table-expr-qq + (inner-join + (inner-join + (inner-join + (as fertilizer_products fp) + (as nutrient_value_sets nvs) + #:on (= nvs.fertilizer_product_id fp.id)) + (as nutrient_values nv) + #:on (= nv.value_set_id nvs.id)) + (as nutrients n) + #:on (= n.id nv.nutrient_id)))) + (define (get-fertilizer-products) - (for/list ([(id* brand-name*) - (in-query (current-conn) - (select id brand_name - #:from fertilizer_products - #:order-by canonical_name #:asc))]) - (fertilizer-product id* brand-name*))) - -(define (get-fertilizer-product #:id [id #f] - #:canonical-name [canonical-name #f] - #:brand-name [brand-name #f]) - (define (where-expr) - (define clauses - (filter values - (list - (and id (format "id = ~e" id)) - (and canonical-name (format "canonical_name = ~e" canonical-name)) - (and brand-name (format "brand_name = ~e" brand-name))))) + (define query (select fp.id fp.canonical_name fp.brand_name + n.id n.canonical_name n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by canonical_name #:asc)) + (define rows (query-rows (current-conn) query)) + (define by-id + (for/fold ([h (hash)]) ([row (in-list rows)]) + (match-define (vector fp-id canonical-name brand-name 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 fp-id + (λ (old-acc) + (acc (acc-canonical-name old-acc) + (acc-brand-name old-acc) + (cons nv-pair (acc-pairs old-acc)))) + (λ () + (acc canonical-name + brand-name + (list nv-pair)))))) + (for/list ([(id a) (in-hash by-id)]) + (fertilizer-product id + (acc-canonical-name a) + (reverse (acc-pairs a)) + (acc-brand-name a)))) + +(define (get-fertilizer-product #:id [fp-id #f] + #:canonical-name [canonical-name #f]) + (define where (cond - [(null? clauses) ""] - [else (format "WHERE ~a" (string-join clauses " AND "))])) - (match (query-maybe-row (current-conn) - (string-join - `("SELECT id, canonical_name, brand_name" - "FROM fertilizer_products" - ,(where-expr) - "ORDER BY id ASC" - "LIMIT 1"))) - [(vector id* canonical-name* brand-name*) - (fertilizer-product id* canonical-name* brand-name*)] - [#f #f])) + [(and fp-id canonical-name) + (scalar-expr-qq (and (= fp.id ,fp-id) + (= fp.canonical_name ,canonical-name)))] + [fp-id + (scalar-expr-qq (= fp.id ,fp-id))] + [canonical-name + (scalar-expr-qq (= fp.canonical_name ,canonical-name))])) + (define query (select fp.id fp.canonical_name fp.brand_name + n.id n.canonical_name n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:where (ScalarExpr:AST ,where) + #:limit 1)) + (define rows (query-rows (current-conn) query)) + (cond + [(null? rows) #f] + [else + ;; Fold all nutrient value rows belonging to the single fertilizer product into one struct + (define the-id #f) + (define A #f) + (for ([row (in-list rows)]) + (match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row) + (unless the-id (set! the-id fp-id)) + (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm)) + (set! A (if A + (acc (acc-canonical-name A) + (acc-brand-name A) + (cons nv-pair (acc-pairs A))) + (acc canonical-name + brand-name + (list nv-pair))))) + (and A + (fertilizer-product the-id + (acc-canonical-name A) + (reverse (acc-pairs A)) + (acc-brand-name A)))])) (define (get-fertilizer-product-values fertilizer-product) (for/list ([(nutrient-id name formula value_ppm) (in-query (current-conn) - (string-join - '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm" - "FROM nutrient_values nv" - "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id" - "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id" - "JOIN nutrients n ON n.id = nv.nutrient_id" - "WHERE nm.id = $1")) - (fertilizer-product-id fertilizer-product))]) + (select n.id n.canonical_name n.formula nv.value_ppm + #:from (TableExpr:AST ,joined) + #:where (= nm.id ,(fertilizer-product-id fertilizer-product))))]) (cons (nutrient nutrient-id name formula) value_ppm))) (define (get-fertilizer-product-value fertilizer-product nutrient) (query-maybe-value (current-conn) - (string-join - '("SELECT value_ppm" - "FROM nutrient_values nv" - "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id" - "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id" - "WHERE nm.id = $1 AND nv.nutrient_id = $2")) - (fertilizer-product-id fertilizer-product) - (nutrient-id nutrient))) - -(define (get-latest-fertilizer-product-value nutrient) - (query-maybe-value (current-conn) - (string-join - '("SELECT value_ppm" - "FROM nutrient_values nv" - "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id" - "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id" - "WHERE nv.nutrient_id = $1" - "ORDER BY nm.brand_name DESC" - "LIMIT 1")) - (nutrient-id nutrient))) + (select value_ppm + #:from (TableExpr:AST ,joined) + #:where (and (= nm.id ,(fertilizer-product-id fertilizer-product)) + (= nv.nutrient_id ,(nutrient-id nutrient)))))) ;; UPDATE -- cgit v1.2.3