Introduce nutrient-value module.

2 files changed, 42 insertions, 19 deletions

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)