blob: 9653c7f782f2f9ad249a9d2a2ac2874c817bc727 (
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
#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)))]
[get-sorted-nutrient-values
(-> nutrient-value-hash/c (listof (cons/c nutrient? nutrient-value?)))]
[update-nutrient-values! (-> connection? db-id? nutrient-value-hash/c void?)]
[residuals->nutrient-value-hash
(-> (listof residual-vector/c) nutrient-value-hash/c)]))
(require db
sql
racket/hash
"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 (get-sorted-nutrient-values nv)
(sort (hash->list (hash-filter-values nv positive?)) > #:key cdr))
(define (update-nutrient-values! conn nvs-id nutrient-values)
(for ([(n v) (in-hash nutrient-values)])
(query-exec conn
(update nutrient_values
#:set [value_ppm ,v]
#:where (and (= value_set_id ,nvs-id) (= nutrient_id ,(nutrient-id n)))))))
(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)))
|
