From c7ec194f4a6c3dc879c24d8075bfe05a7687f976 Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sat, 6 Dec 2025 17:44:46 +0100 Subject: Introduce nutrient-value module. --- models/nutrient-value.rkt | 39 +++++++++++++++++++++++++++++++++++++++ models/nutrient.rkt | 22 +++------------------- 2 files changed, 42 insertions(+), 19 deletions(-) create mode 100644 models/nutrient-value.rkt diff --git a/models/nutrient-value.rkt b/models/nutrient-value.rkt new file mode 100644 index 0000000..b5798db --- /dev/null +++ b/models/nutrient-value.rkt @@ -0,0 +1,39 @@ +#lang racket + +(provide nutrient-value? + maybe-nutrient-value? + nutrient-value-hash/c + (contract-out [insert-nutrient-values + (-> connection? db-id? nutrient-value-hash/c (listof (cons/c symbol? any/c)))] + [residuals->nutrient-value-hash + (-> (listof residual-vector/c) nutrient-value-hash/c)])) + +(require db + sql + "nutrient.rkt" + "utils.rkt") + +(define nutrient-value? (and/c real? (>=/c 0))) +(define maybe-nutrient-value? (or/c nutrient-value? #f)) +(define nutrient-value-hash/c (hash/c nutrient? nutrient-value? #:immutable #t)) + +;; vector/c id, canonical name, french name, nutrient formula, value (ppm) +(define residual-vector/c (vector/c db-id? string? string? string? real?)) + +(define (insert-nutrient-values conn nvs-id nutrient-values) + (define nv-rows + (for/list ([(n v) (in-hash nutrient-values)]) + (map value->scalar-expr-ast (list nvs-id (nutrient-id n) v)))) + (define result + (query conn + (insert #:into nutrient_values + #:columns value_set_id + nutrient_id + value_ppm + #:from (TableExpr:AST ,(make-values*-table-expr-ast nv-rows))))) + (simple-result-info result)) + +(define (residuals->nutrient-value-hash residuals) + (for/hash ([r (in-list residuals)]) + (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))) diff --git a/models/nutrient.rkt b/models/nutrient.rkt index 4748083..cbf6bb1 100644 --- a/models/nutrient.rkt +++ b/models/nutrient.rkt @@ -6,9 +6,6 @@ nutrient-canonical-name nutrient-french-name nutrient-formula - nutrient-value? - maybe-nutrient-value? - nutrient-value-hash/c (contract-out [create-nutrient! (-> string? string? string? nutrient?)] [get-nutrients (-> (listof nutrient?))] [get-nutrient @@ -21,32 +18,19 @@ (->* (nutrient?) (#:name (or/c #f string?) #:formula (or/c #f string?)) (or/c nutrient? #f))] - [delete-nutrient! (-> nutrient? void?)] - [residuals->nutrient-value-hash - (-> (listof residual-vector/c) nutrient-value-hash/c)])) + [delete-nutrient! (-> nutrient? void?)])) (require racket/contract db sql - "../db/conn.rkt") + "../db/conn.rkt" + "utils.rkt") (struct nutrient (id canonical-name french-name formula) #:transparent #:property prop:custom-write (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-canonical-name v)))) -(define nutrient-value? (and/c real? (>=/c 0))) -(define maybe-nutrient-value? (or/c nutrient-value? #f)) -(define nutrient-value-hash/c (hash/c nutrient? nutrient-value? #:immutable #t)) - -;; 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-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! canonical-name french-name formula) -- cgit v1.2.3