From 3008eb25f79ef1ed54fcc2b3f5b6635b34394680 Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sun, 19 Oct 2025 21:15:18 +0200 Subject: Absorb existing domain data. --- models/nutrient-value-set.rkt | 98 +++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 98 insertions(+) create mode 100644 models/nutrient-value-set.rkt (limited to 'models/nutrient-value-set.rkt') diff --git a/models/nutrient-value-set.rkt b/models/nutrient-value-set.rkt new file mode 100644 index 0000000..5f3759a --- /dev/null +++ b/models/nutrient-value-set.rkt @@ -0,0 +1,98 @@ +#lang racket + +(provide nutrient-value-set + nutrient-value-set? + nutrient-value-set-id + ;; nutrient-value-set-nm-id + ;; nutrient-value-set-nt-id + ;; nutrient-value-set-cr-id + ;; nutrient-value-set-fp-id + ;; SQL CRUD + (contract-out + [create-nutrient-value-set! (-> symbol? + exact-nonnegative-integer? + (listof (cons/c + nutrient? + number?)) + void?)] + [get-nutrient-value-set (->* () + (#:id exact-nonnegative-integer? + #:nutrient-measurement-id exact-nonnegative-integer? + #:nutrient-target-id exact-nonnegative-integer? + #:crop-requirement-id exact-nonnegative-integer? + #:fertilizer-product-id exact-nonnegative-integer?) + (or/c nutrient-value-set? #f))])) + +(require racket/contract + db + sql + "../db/conn.rkt" + "nutrient.rkt") + +(struct nutrient-value-set (id nm-id nt-id cr-id fp-id) #:transparent) + + +;; CREATE + +(define (create-nutrient-value-set! type id nutrient-values) + (define nvs (case type + [(nutrient-measurement) + (query-exec (current-conn) + (insert #:into nutrient_value_sets + #:set [nutrient_measurement_id ,id])) + (get-nutrient-value-set #:nutrient-measurement-id id)] + [(nutrient-target) + (query-exec (current-conn) + (insert #:into nutrient_value_sets + #:set [nutrient_target_id ,id])) + (get-nutrient-value-set #:nutrient-target-id id)] + [(crop-requirement) + (query-exec (current-conn) + (insert #:into nutrient_value_sets + #:set [crop_requirement_id ,id])) + (get-nutrient-value-set #:crop-requirement-id id)] + [(fertilizer-product) + (query-exec (current-conn) + (insert #:into nutrient_value_sets + #:set [fertilizer_product_id ,id])) + (get-nutrient-value-set #:fertilizer-product-id id)])) + (for ([nv nutrient-values]) + (match nv + [(cons n v) + (query-exec (current-conn) + (insert #:into nutrient_values + #:set + [value_set_id ,(nutrient-value-set-id nvs)] + [nutrient_id ,(nutrient-id n)] + [value_ppm ,v]))]))) + + +;; READ + +(define (get-nutrient-value-set #:id [id #f] + #:nutrient-measurement-id [nm #f] + #:nutrient-target-id [nt #f] + #:crop-requirement-id [cr #f] + #:fertilizer-product-id [fp #f]) + (define (where-expr) + (define clauses + (filter values + (list + (and id (format "id = ~e" id)) + (and nm (format "nutrient_measurement_id = ~e" nm)) + (and nt (format "nutrient_target_id = ~e" nt)) + (and cr (format "crop_requirement = ~e" cr)) + (and fp (format "fertilizer_product = ~e" fp))))) + (cond + [(null? clauses) ""] + [else (format "WHERE ~a" (string-join clauses " AND "))])) + (define query (string-join + `("SELECT *" + "FROM nutrient_value_sets" + ,(where-expr) + "ORDER BY id ASC" + "LIMIT 1"))) + (match (query-maybe-row (current-conn) query) + [(vector id* nm-id* nt-id* cr-id* fp-id*) + (nutrient-value-set id* nm-id* nt-id* cr-id* fp-id*)] + [#f #f])) -- cgit v1.2.3