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
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
|
#lang racket
(provide fertilizer-product
fertilizer-product?
fertilizer-product-id
(rename-out [fertilizer-product-canonical-name fertilizer-name]
[fertilizer-product-nutrient-values fertilizer-product-values]
[fertilizer-product-brand-name fertilizer-brand-name])
(contract-out
[create-fertilizer-product!
(->* (string? (listof nutrient-value-pair/c)) (string?) fertilizer-product?)]
[get-fertilizer-products (-> (listof fertilizer-product?))]
[get-fertilizer-product
(->* ()
(#:id (or/c #f exact-nonnegative-integer?) #:canonical-name (or/c #f string?))
(or/c fertilizer-product? #f))]
[get-fertilizer-product-values (-> fertilizer-product? (listof nutrient-value-pair/c))]
[get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
[delete-fertilizer-product! (-> fertilizer-product? void?)]))
(require racket/contract
db
sql
"../db/conn.rkt"
"nutrient.rkt")
(struct fertilizer-product (id canonical-name nutrient-values brand-name)
#:transparent
#:guard (λ (id canonical-name nutrient-values brand-name _)
(values id canonical-name nutrient-values (if (sql-null? brand-name) #f brand-name)))
#:property prop:custom-write
(λ (v out _mode)
(fprintf out "Fertilizer #~a\n" (fertilizer-product-id v))
(if (fertilizer-product-brand-name v)
(fprintf out
"~a (~a)\n"
(fertilizer-product-canonical-name v)
(fertilizer-product-brand-name v))
(fprintf out "~a\n" (fertilizer-product-canonical-name v)))
(for ([nv (in-list (fertilizer-product-nutrient-values v))])
(match-define (cons n v) nv)
(fprintf out
"~a ~a\n"
(~a (nutrient-name n) #:min-width 14)
(~a v #:max-width 6 #:align 'right)))))
;; CREATE
(define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f])
(or
(get-fertilizer-product #:canonical-name canonical-name)
(with-tx
(query-exec (current-conn)
(cond
[brand-name
(insert #:into fertilizer_products
#:set [canonical_name ,canonical-name]
[brand_name ,brand-name])]
[else (insert #:into fertilizer_products #:set [canonical_name ,canonical-name])]))
(define fp-id
(query-value (current-conn)
(select id #:from fertilizer_products #:where (= canonical_name ,canonical-name))))
(query-exec (current-conn)
(insert #:into nutrient_value_sets #:set [fertilizer_product_id ,fp-id]))
(define nvs-id
(query-value (current-conn)
(select id #:from nutrient_value_sets #:where (= fertilizer_product_id ,fp-id))))
(for ([nv nutrient-values])
(match-define (cons n v) nv)
(query-exec (current-conn)
(insert #:into nutrient_values
#:set [value_set_id ,nvs-id]
[nutrient_id ,(nutrient-id n)]
[value_ppm ,v])))
(get-fertilizer-product #:canonical-name canonical-name))))
;; READ
(define joined
(table-expr-qq (inner-join (inner-join (inner-join (as fertilizer_products fp)
(as nutrient_value_sets nvs)
#:on (= nvs.fertilizer_product_id fp.id))
(as nutrient_values nv)
#:on (= nv.value_set_id nvs.id))
(as nutrients n)
#:on (= n.id nv.nutrient_id))))
(define (grouped-row->fertilizer-product row)
(match-define (vector fp-id canonical-name brand-name residuals) row)
(define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
(fertilizer-product fp-id canonical-name nutrient-value-pairs brand-name))
(define (get-fertilizer-products)
(define grouped-rows (query-rows (current-conn)
(select fp.id
fp.canonical_name
fp.brand_name
n.id
n.canonical_name
n.formula
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:order-by fp.canonical_name
#:asc)
#:group '#(0 1 2)))
(for/list ([row grouped-rows])
(grouped-row->fertilizer-product row)))
(define (get-fertilizer-product #:id [fp-id #f] #:canonical-name [canonical-name #f])
(define where
(cond
[(and fp-id canonical-name)
(scalar-expr-qq (and (= fp.id ,fp-id) (= fp.canonical_name ,canonical-name)))]
[fp-id (scalar-expr-qq (= fp.id ,fp-id))]
[canonical-name (scalar-expr-qq (= fp.canonical_name ,canonical-name))]
[else (error 'get-fertilizer-product "either #:id or #:canonical-name must be provided")]))
(define grouped-rows
(query-rows (current-conn)
(select fp.id
fp.canonical_name
fp.brand_name
n.id
n.canonical_name
n.formula
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:where (ScalarExpr:AST ,where)
#:order-by fp.canonical_name
#:asc)
#:group '#(0 1 2)))
(match grouped-rows
['() #f]
[(list row) (grouped-row->fertilizer-product row)]
[many (error 'get-fertilizer-product "expected 1 fertilizer product, got ~a" (length many))]))
(define (get-fertilizer-product-values fertilizer-product)
(for/list ([(nutrient-id name formula value_ppm)
(in-query (current-conn)
(select n.id
n.canonical_name
n.formula
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:where (= fp.id ,(fertilizer-product-id fertilizer-product))))])
(cons (nutrient nutrient-id name formula) value_ppm)))
(define (get-fertilizer-product-value fertilizer-product nutrient)
(query-maybe-value (current-conn)
(select value_ppm
#:from (TableExpr:AST ,joined)
#:where (and (= fp.id ,(fertilizer-product-id fertilizer-product))
(= nv.nutrient_id ,(nutrient-id nutrient))))))
;; UPDATE
;; DELETE
(define (delete-fertilizer-product! fertilizer-product)
(define id (fertilizer-product-id fertilizer-product))
(query-exec (current-conn) (delete #:from fertilizer_products #:where (= id ,id))))
|
