From b4b113796455b85389df1c826f6e7ec93e804001 Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Mon, 24 Nov 2025 15:44:58 +0100 Subject: Add French name to nutrient model. --- models/crop-requirement.rkt | 9 ++--- models/fertilizer-product.rkt | 9 +++-- models/nutrient-measurement.rkt | 35 +++++++++++-------- models/nutrient-target.rkt | 35 +++++++++++-------- models/nutrient.rkt | 75 ++++++++++++++++++++++++----------------- 5 files changed, 97 insertions(+), 66 deletions(-) (limited to 'models') diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt index fb14777..c0eb753 100644 --- a/models/crop-requirement.rkt +++ b/models/crop-requirement.rkt @@ -80,6 +80,7 @@ cr.crop_id n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) @@ -98,7 +99,6 @@ [profile (scalar-expr-qq (= cr.profile ,profile))] [crop-id (scalar-expr-qq (= cr.crop_id ,crop-id))] [else (error 'get-crop-requirement "one of #:id, #:profile or #:crop-id must be provided")])) - (define grouped-rows (query-rows (current-conn) (select cr.id @@ -106,27 +106,28 @@ cr.crop_id n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) #:where (ScalarExpr:AST ,where)) #:group '#(0 1 2))) - (match grouped-rows ['() #f] [(list row) (grouped-row->crop-requirement row)] [many (error 'get-crop-requirement "expected 1 crop requirement, got ~a" (length many))])) (define (get-crop-requirement-values crop-requirement) - (for/hash ([(nutrient-id name formula value_ppm) + (for/hash ([(nutrient-id canonical-name french-name formula value_ppm) (in-query (current-conn) (select n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) #:where (= cr.id ,(crop-requirement-id crop-requirement))))]) - (values (nutrient nutrient-id name formula) value_ppm))) + (values (nutrient nutrient-id canonical-name french-name formula) value_ppm))) (define (get-crop-requirement-value crop-requirement nutrient) (query-maybe-value (current-conn) diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt index 347d141..b0ac7de 100644 --- a/models/fertilizer-product.rkt +++ b/models/fertilizer-product.rkt @@ -39,7 +39,7 @@ (for ([(n v) (in-hash (fertilizer-product-nutrient-values v))]) (fprintf out "~a ~a\n" - (~a (nutrient-name n) #:min-width 14) + (~a (nutrient-canonical-name n) #:min-width 14) (~a v #:max-width 6 #:align 'right))))) ;; CREATE @@ -91,6 +91,7 @@ fp.brand_name n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) @@ -115,6 +116,7 @@ fp.brand_name n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) @@ -128,15 +130,16 @@ [many (error 'get-fertilizer-product "expected 1 fertilizer product, got ~a" (length many))])) (define (get-fertilizer-product-values fertilizer-product) - (for/hash ([(nutrient-id name formula value_ppm) + (for/hash ([(nutrient-id canonical-name french-name formula value_ppm) (in-query (current-conn) (select n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) #:where (= fp.id ,(fertilizer-product-id fertilizer-product))))]) - (values (nutrient nutrient-id name formula) value_ppm))) + (values (nutrient nutrient-id canonical-name french-name formula) value_ppm))) (define (get-fertilizer-product-value fertilizer-product nutrient) (query-maybe-value (current-conn) diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt index 3e8213d..5b5f93d 100644 --- a/models/nutrient-measurement.rkt +++ b/models/nutrient-measurement.rkt @@ -35,7 +35,7 @@ (for ([(n v) (in-hash (nutrient-measurement-nutrient-values v))]) (fprintf out "~a ~a\n" - (~a (nutrient-name n) #:min-width 14) + (~a (nutrient-canonical-name n) #:min-width 14) (~a v #:max-width 6 #:align 'right))))) ;; CREATE @@ -83,6 +83,7 @@ nm.measured_on n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) @@ -106,6 +107,7 @@ nm.measured_on n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) @@ -119,15 +121,16 @@ [many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))])) (define (get-nutrient-measurement-values nutrient-measurement) - (for/hash ([(nutrient-id name formula value_ppm) + (for/hash ([(nutrient-id canonical-name french-name formula value_ppm) (in-query (current-conn) (select n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) #:where (= nm.id ,(nutrient-measurement-id nutrient-measurement))))]) - (values (nutrient nutrient-id name formula) value_ppm))) + (values (nutrient nutrient-id canonical-name french-name formula) value_ppm))) (define (get-nutrient-measurement-value nutrient-measurement nutrient) (query-maybe-value (current-conn) @@ -146,19 +149,23 @@ #:limit 1))) (define (get-latest-nutrient-measurement-hash) - (for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn) - (select n.id - n.canonical_name - n.formula - nm.measured_on - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by nm.measured_on - #:desc) - #:group '(#(0 1 2)))]) + (define grouped-rows + (query-rows (current-conn) + (select n.id + n.canonical_name + n.french_name + n.formula + nm.measured_on + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by nm.measured_on + #:desc) + #:group '(#(0 1 2 3)))) + (for/hash ([row grouped-rows]) + (match-define (vector n-id n-canonical-name n-french-name n-formula residual-rows) row) ;; residual-rows is a non-empty list of vectors: #(measured_on value_ppm) (match-define (vector _measured-on value-ppm) (first residual-rows)) - (values (nutrient n-id n-name n-formula) value-ppm))) + (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm))) ;; UPDATE diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt index ce4d561..cffa657 100644 --- a/models/nutrient-target.rkt +++ b/models/nutrient-target.rkt @@ -32,7 +32,7 @@ (for ([(n v) (in-hash (nutrient-target-nutrient-values v))]) (fprintf out "~a ~a\n" - (~a (nutrient-name n) #:min-width 14) + (~a (nutrient-canonical-name n) #:min-width 14) (~a v #:max-width 6 #:align 'right))))) ;; CREATE @@ -78,6 +78,7 @@ nt.effective_on n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) @@ -100,6 +101,7 @@ nt.effective_on n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) @@ -113,15 +115,16 @@ [many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))])) (define (get-nutrient-target-values nutrient-target) - (for/hash ([(nutrient-id name formula value_ppm) + (for/hash ([(nutrient-id canonical-name french-name formula value_ppm) (in-query (current-conn) (select n.id n.canonical_name + n.french_name n.formula nv.value_ppm #:from (TableExpr:AST ,joined) #:where (= nt.id ,(nutrient-target-id nutrient-target))))]) - (values (nutrient nutrient-id name formula) value_ppm))) + (values (nutrient nutrient-id canonical-name french-name formula) value_ppm))) (define (get-nutrient-target-value nutrient-target nutrient) (query-maybe-value (current-conn) @@ -140,19 +143,23 @@ #:limit 1))) (define (get-latest-nutrient-target-hash) - (for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn) - (select n.id - n.canonical_name - n.formula - nt.effective_on - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by nt.effective_on - #:desc) - #:group '(#(0 1 2)))]) + (define grouped-rows + (query-rows (current-conn) + (select n.id + n.canonical_name + n.french_name + n.formula + nt.effective_on + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by nt.effective_on + #:desc) + #:group '(#(0 1 2 3)))) + (for/hash ([row grouped-rows]) + (match-define (vector n-id n-canonical-name n-french-name n-formula residual-rows) row) ;; residual-rows is a non-empty list of vectors: #(effective_on value_ppm) (match-define (vector _effective-on value-ppm) (first residual-rows)) - (values (nutrient n-id n-name n-formula) value-ppm))) + (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm))) ;; UPDATE diff --git a/models/nutrient.rkt b/models/nutrient.rkt index 3e2767b..fd78cc8 100644 --- a/models/nutrient.rkt +++ b/models/nutrient.rkt @@ -3,10 +3,11 @@ (provide nutrient nutrient? nutrient-id - nutrient-name + nutrient-canonical-name + nutrient-french-name nutrient-formula nutrient-value-hash/c - (contract-out [create-nutrient! (-> string? string? nutrient?)] + (contract-out [create-nutrient! (-> string? string? string? nutrient?)] [get-nutrients (-> (listof nutrient?))] [get-nutrient (->* () @@ -27,54 +28,66 @@ sql "../db/conn.rkt") -(struct nutrient (id name formula) +(struct nutrient (id canonical-name french-name formula) #:transparent #:property prop:custom-write - (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-name v)))) + (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-canonical-name v)))) (define nutrient-value-hash/c (hash/c nutrient? (and/c real? (>=/c 0)) #:immutable #t)) -;; vector/c id, nutrient name, nutrient formula, value (ppm) -(define residual-vector/c (vector/c exact-nonnegative-integer? string? string? real?)) +;; vector/c id, canonical name, french name, nutrient formula, value (ppm) +(define residual-vector/c (vector/c exact-nonnegative-integer? string? string? string? real?)) (define (residuals->nutrient-value-hash residuals) (for/hash ([r (in-list residuals)]) - (match-define (vector n-id n-name n-formula value-ppm) r) - (values (nutrient n-id n-name n-formula) value-ppm))) + (match-define (vector n-id n-canonical-name n-french-name n-formula value-ppm) r) + (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm))) ;; CREATE -(define (create-nutrient! name formula) - (or (get-nutrient #:name name #:formula formula) +(define (create-nutrient! canonical-name french-name formula) + (or (get-nutrient #:name canonical-name #:formula formula) (begin (query-exec (current-conn) - (insert #:into nutrients #:set [canonical_name ,name] [formula ,formula])) - (get-nutrient #:name name)))) + (insert #:into nutrients + #:set [canonical_name ,canonical-name] + [french_name ,french-name] + [formula ,formula])) + (get-nutrient #:name canonical-name)))) ;; READ +(define (row->nutrient row) + (match-define (vector id canonical-name french-name formula) row) + (nutrient id canonical-name french-name formula)) + (define (get-nutrients) - (for/list ([(id name formula) - (in-query (current-conn) - (select id canonical_name formula #:from nutrients #:order-by id #:asc))]) - (nutrient id name formula))) - -(define (get-nutrient #:id [id #f] #:name [name #f] #:formula [formula #f]) - (define (where-expr) - (define clauses - (filter values - (list (and id (format "id = ~e" id)) - (and name (format "canonical_name = ~e" name)) - (and formula (format "formula = ~e" formula))))) + (define rows + (query-rows (current-conn) + (select id canonical_name french_name formula #:from nutrients #:order-by id #:asc))) + (map row->nutrient rows)) + +(define (get-nutrient #:id [id #f] #:name [canonical-name #f] #:formula [formula #f]) + (define where (cond - [(null? clauses) ""] - [else (format "WHERE ~a" (string-join clauses " AND "))])) + [(and id canonical-name formula) + (scalar-expr-qq (and (= id ,id) (= canonical_name ,canonical-name)))] + [id (scalar-expr-qq (= id ,id))] + [(and canonical-name formula) + (scalar-expr-qq (and (= canonical_name ,canonical-name) (= formula ,formula)))] + [canonical-name (scalar-expr-qq (= canonical_name ,canonical-name))] + [formula (scalar-expr-qq (= formula ,formula))])) (match (query-maybe-row (current-conn) - (string-join `("SELECT id, canonical_name, formula" "FROM nutrients" - ,(where-expr) - "ORDER BY id ASC" - "LIMIT 1"))) - [(vector id* name* formula*) (nutrient id* name* formula*)] + (select id + canonical_name + french_name + formula + #:from nutrients + #:where (ScalarExpr:AST ,where) + #:order-by id + #:asc + #:limit 1)) + [(vector id canonical-name french-name formula) (nutrient id canonical-name french-name formula)] [#f #f])) ;; UPDATE -- cgit v1.2.3