summaryrefslogtreecommitdiff
path: root/models/nutrient-value.rkt
blob: b5798db44f2cb25531f76ec4ebf684168b633026 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
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)))
Copyright 2019--2026 Marius PETER