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
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
|
#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? string? nutrient-value-hash/c 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-or-id/c nutrient-value-hash/c)]
[get-fertilizer-product-value
(-> fertilizer-product-or-id/c nutrient? maybe-nutrient-value?)]
[delete-fertilizer-product! (-> fertilizer-product-or-id/c 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 (or (sql-null? brand-name) (= (string-length brand-name) 0)) #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 ([(n v) (in-hash (fertilizer-product-nutrient-values v))])
(fprintf out
"~a ~a\n"
(~a (nutrient-canonical-name n) #:min-width 14)
(~a v #:max-width 6 #:align 'right)))))
(define fertilizer-product-id? exact-nonnegative-integer?)
(define fertilizer-product-or-id/c (or/c fertilizer-product? fertilizer-product-id?))
(define (->fp-id fp-or-id)
(match fp-or-id
[(? fertilizer-product-id? id) id]
[(fertilizer-product id _ _ _) id]))
;; CREATE
(define (create-fertilizer-product! canonical-name brand-name nutrient-values)
(or
(get-fertilizer-product #:canonical-name canonical-name)
(with-tx
(query-exec (current-conn)
(insert #:into fertilizer_products
#:set [canonical_name ,canonical-name]
[brand_name ,brand-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 ([(n v) (in-hash nutrient-values)])
(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)
(fertilizer-product fp-id canonical-name (residuals->nutrient-value-hash residuals) 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.french_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.french_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 fp-or-id)
(for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
(in-query (current-conn)
(select n.id
n.canonical_name
n.french_name
n.formula
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:where (= fp.id ,(->fp-id fp-or-id))))])
(values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
(define (get-fertilizer-product-value fp-or-id nutrient)
(query-maybe-value (current-conn)
(select value_ppm
#:from (TableExpr:AST ,joined)
#:where (and (= fp.id ,(->fp-id fp-or-id))
(= nv.nutrient_id ,(nutrient-id nutrient))))))
;; UPDATE
;; DELETE
(define (delete-fertilizer-product! fp-or-id)
(query-exec (current-conn) (delete #:from fertilizer_products #:where (= id ,(->fp-id fp-or-id)))))
(module+ test
(require rackunit
rackunit/text-ui
"../db/conn.rkt"
"../db/migrations.rkt"
"../models/nutrient.rkt")
(define canonical-product-name "MasterBlend 4-20")
(run-tests
(test-suite "Fertilizer product model"
#:before (λ ()
(connect! #:path 'memory)
(migrate-all!)
(create-nutrient! "Nitrogen" "Azote" "N")
(create-nutrient! "Phosphorus" "Phosphore" "P")
(create-nutrient! "Potassium" "Potassium" "K"))
#:after (λ () (disconnect!))
(test-case "Create product with name, brand, and values"
(define nitrogen (get-nutrient #:name "Nitrogen"))
(define phosphorus (get-nutrient #:name "Phosphorus"))
(create-fertilizer-product! canonical-product-name
"MasterBlend"
(hash nitrogen 40 phosphorus 200))
(check-equal? (length (get-fertilizer-products)) 1)
(define fp (get-fertilizer-product #:canonical-name canonical-product-name))
(check-true (fertilizer-product? fp))
(check-equal? (fertilizer-product-canonical-name fp) canonical-product-name)
(check-equal? (fertilizer-product-brand-name fp) "MasterBlend"))
(test-case "Create product without brand name"
(define nitrogen (get-nutrient #:name "Nitrogen"))
(define fp (create-fertilizer-product! "Generic N" "" (hash nitrogen 100)))
(check-false (fertilizer-product-brand-name fp)))
(test-case "Check all product values"
(define nitrogen (get-nutrient #:name "Nitrogen"))
(define phosphorus (get-nutrient #:name "Phosphorus"))
(define fp (get-fertilizer-product #:canonical-name canonical-product-name))
(check-= (get-fertilizer-product-value fp nitrogen) 40 0)
(check-= (get-fertilizer-product-value fp phosphorus) 200 0)
(define fpv (fertilizer-product-nutrient-values fp))
(check-equal?
(get-fertilizer-product-values fp)
fpv
"return value of get-fertilizer-product-values ≠ fertilizer-product-values struct accessor")
(check-equal? (hash-count fpv) 2))
(test-case "Get product by id"
(define fp (get-fertilizer-product #:canonical-name canonical-product-name))
(define fp-by-id (get-fertilizer-product #:id (fertilizer-product-id fp)))
(check-equal? fp fp-by-id))
(test-case "Handle missing nutrient in product"
(define nitrogen (get-nutrient #:name "Nitrogen"))
(define potassium (get-nutrient #:name "Potassium"))
(define fp (get-fertilizer-product #:canonical-name canonical-product-name))
(check-false (get-fertilizer-product-value fp potassium)))
(test-case "Custom write property formatting"
(define nitrogen (get-nutrient #:name "Nitrogen"))
(define fp (create-fertilizer-product! "Test Fertilizer" "TestBrand" (hash nitrogen 50)))
(define output (open-output-string))
(write fp output)
(define result (get-output-string output))
(check-true (string-contains? result "Fertilizer #"))
(check-true (string-contains? result "Test Fertilizer"))
(check-true (string-contains? result "TestBrand")))
(test-case "Delete product and cascade to product values"
(define fp (get-fertilizer-product #:canonical-name canonical-product-name))
(delete-fertilizer-product! fp)
(check-false (get-fertilizer-product #:id (fertilizer-product-id fp)))
(check-equal? (length (get-fertilizer-products))
2
"wrong number of fertilizer products were deleted")
(check-true (hash-empty? (get-fertilizer-product-values fp)))))))
|
