[Racket] Ferti hydroponic nutrient solver, redux.
Add fertilizer product updating logic.
Changed files
formlets.rkt
@@ -8,6 +8,7 @@
8
8
web-server/formlets
9
9
"models/nutrient.rkt"
10
10
"models/nutrient-measurement.rkt"
11
Added:
"models/fertilizer-product.rkt"
11
12
"models/crop.rkt"
12
13
"models/crop-requirement.rkt")
13
14
@@ -38,20 +39,42 @@
38
39
(values req proportion))])
39
40
(values rotation-date requirement-proportions))))
40
41
41
Removed:
(define (fertilizer-formlet)
42
Removed:
(formlet*
43
Removed:
(#%# `(div ((class "mb-3")) (h5 "Nom de référence") ,{=>* required-string-input canonical-name*})
44
Removed:
`(div ((class "mb-3")) (h5 "Nom de marque") ,{=>* required-string-input brand-name*})
45
Removed:
`(div ((class "mb-3"))
46
Removed:
(h5 "Valeurs de l'intrant")
47
Removed:
,@(for/list ([nutrient (get-nutrients)])
48
Removed:
{=>* (nutrient-value-formlet nutrient) nutrient-values*}))
49
Removed:
{=>* (submit "Enregistrer l'intrant" #:attributes '((class "btn btn-primary"))) _})
50
Removed:
(let ([canonical-name (first canonical-name*)]
51
Removed:
[nutrient-values (for/hash ([nv nutrient-values*])
52
Removed:
(values (car nv) (cdr nv)))]
53
Removed:
[brand-name (first brand-name*)])
54
Removed:
(values canonical-name brand-name nutrient-values))))
42
Added:
(define (fertilizer-formlet #:value [fp #f])
43
Added:
(formlet* (#%# (=>* (to-string (required (hidden (if fp
44
Added:
(number->string (fertilizer-product-id fp))
45
Added:
""))))
46
Added:
id*)
47
Added:
`(div ((class "mb-3"))
48
Added:
(h5 "Nom de référence")
49
Added:
,{=>*
50
Added:
(required-string-input #:value (if fp
51
Added:
(fertilizer-product-name fp)
52
Added:
""))
53
Added:
canonical-name*})
54
Added:
`(div ((class "mb-3"))
55
Added:
(h5 "Nom de marque")
56
Added:
,{=>*
57
Added:
(required-string-input #:value (if fp
58
Added:
(fertilizer-brand-name fp)
59
Added:
""))
60
Added:
brand-name*})
61
Added:
`(div ((class "mb-3"))
62
Added:
(h5 "Valeurs de l'intrant")
63
Added:
,@(for/list ([n (get-nutrients)])
64
Added:
(define v
65
Added:
(if fp
66
Added:
(fertilizer-product-value fp n)
67
Added:
0))
68
Added:
(=>* (nutrient-value-formlet n v) nutrient-values*)))
69
Added:
(=>* (submit (string-join (list (if fp "Modifier" "Enregistrer") "l'intrant"))
70
Added:
#:attributes '((class "btn btn-primary")))
71
Added:
_))
72
Added:
(let ([id (string->number (first id*))]
73
Added:
[canonical-name (first canonical-name*)]
74
Added:
[brand-name (first brand-name*)]
75
Added:
[nutrient-values (for/hash ([nv nutrient-values*])
76
Added:
(values (car nv) (cdr nv)))])
77
Added:
(fertilizer-product id canonical-name brand-name nutrient-values))))
55
78
56
79
(define (crop-requirement-formlet requirement)
57
80
(define id (number->string (crop-requirement-id requirement)))
@@ -86,7 +109,7 @@
86
109
#:value (or date-string (date->iso8601 (today)))
87
110
#:attributes '((class "form-control") [required "required"])))))
88
111
89
Removed:
(define (nutrient-value-formlet nutrient)
112
Added:
(define (nutrient-value-formlet nutrient value)
90
113
(define id (number->string (nutrient-id nutrient)))
91
114
(define number-input
92
115
(to-number (to-string (required (input #:type "number"
@@ -95,6 +118,7 @@
95
118
[required "required"]
96
119
[id ,id]
97
120
[name ,id]
121
Added:
[value ,(number->string value)]
98
122
[step "0.1"]
99
123
[placeholder ,(nutrient-french-name nutrient)]))))))
100
124
(define input-label
@@ -104,5 +128,6 @@
104
128
(formlet (div ((class "form-floating mb-3")) ,{=> number-input nutrient-value} ,input-label)
105
129
(cons nutrient nutrient-value)))
106
130
107
Removed:
(define required-string-input
108
Removed:
(to-string (required (text-input #:attributes '((class "form-control") [required "required"])))))
131
Added:
(define (required-string-input #:value [str #f])
132
Added:
(to-string (required (text-input #:attributes `((class "form-control") [required "required"]
133
Added:
[value ,(or str "")])))))
handlers.rkt
@@ -43,7 +43,9 @@
43
43
[("ferti" "fertilizers" "new") #:method "get" new-fertilizer]
44
44
[("ferti" "fertilizers" "create") #:method "post" create-fertilizer]
45
45
[("ferti" "fertilizers" (integer-arg)) #:method "get" show-fertilizer]
46
Removed:
[("ferti" "fertilizers" "destroy" (integer-arg)) #:method "get" destroy-fertilizer]
46
Added:
[("ferti" "fertilizers" (integer-arg) "edit") #:method "get" edit-fertilizer]
47
Added:
[("ferti" "fertilizers" "update") #:method "post" update-fertilizer]
48
Added:
[("ferti" "fertilizers" (integer-arg) "destroy") #:method "get" destroy-fertilizer]
47
49
;; Default
48
50
[("") #:method "get" index]
49
51
[else fallback]))
@@ -122,14 +124,22 @@
122
124
(render-page (new-fertilizer-page)))
123
125
124
126
(define (create-fertilizer req)
125
Removed:
(define-values (canonical-name brand-name nutrient-values)
126
Removed:
(formlet-process (fertilizer-formlet) req))
127
Removed:
(create-fertilizer-product! canonical-name brand-name nutrient-values)
127
Added:
(define new-fertilizer-product (formlet-process (fertilizer-formlet) req))
128
Added:
(create-fertilizer-product! new-fertilizer-product)
128
129
(redirect-to "/ferti/fertilizers"))
129
130
130
131
(define (show-fertilizer _ id)
131
132
(define fp (get-fertilizer-product #:id id))
132
133
(render-page (show-fertilizer-page fp)))
134
Added:
135
Added:
(define (edit-fertilizer _ id)
136
Added:
(define fp (get-fertilizer-product #:id id))
137
Added:
(render-page (edit-fertilizer-page fp)))
138
Added:
139
Added:
(define (update-fertilizer req)
140
Added:
(define edited-fertilizer-product (formlet-process (fertilizer-formlet) req))
141
Added:
(update-fertilizer-product! edited-fertilizer-product)
142
Added:
(redirect-to "/ferti/fertilizers"))
133
143
134
144
(define (destroy-fertilizer _ id)
135
145
(delete-fertilizer-product! id)
models/fertilizer-product.rkt
@@ -3,18 +3,20 @@
3
3
(provide fertilizer-product
4
4
fertilizer-product?
5
5
fertilizer-product-id
6
Added:
fertilizer-product-value
6
7
(rename-out [fertilizer-product-canonical-name fertilizer-product-name]
7
8
[fertilizer-product-nutrient-values fertilizer-product-values]
8
9
[fertilizer-product-brand-name fertilizer-brand-name])
9
Removed:
(contract-out
10
Removed:
[create-fertilizer-product! (-> string? string? nutrient-value-hash/c fertilizer-product?)]
11
Removed:
[get-fertilizer-products (-> (listof fertilizer-product?))]
12
Removed:
[get-fertilizer-product
13
Removed:
(->* () (#:id db-id? #:canonical-name string?) (or/c fertilizer-product? #f))]
14
Removed:
[get-fertilizer-product-values (-> fertilizer-product-or-id/c nutrient-value-hash/c)]
15
Removed:
[get-fertilizer-product-value
16
Removed:
(-> fertilizer-product-or-id/c nutrient? maybe-nutrient-value?)]
17
Removed:
[delete-fertilizer-product! (-> fertilizer-product-or-id/c void?)]))
10
Added:
(contract-out [create-fertilizer-product! (-> fertilizer-product? fertilizer-product?)]
11
Added:
[get-fertilizer-products (-> (listof fertilizer-product?))]
12
Added:
[get-fertilizer-product
13
Added:
(->* () (#:id db-id? #:canonical-name string?) (or/c fertilizer-product? #f))]
14
Added:
[get-fertilizer-product-values
15
Added:
(-> fertilizer-product-or-id/c nutrient-value-hash/c)]
16
Added:
[get-fertilizer-product-value
17
Added:
(-> fertilizer-product-or-id/c nutrient? maybe-nutrient-value?)]
18
Added:
[update-fertilizer-product! (-> fertilizer-product? void?)]
19
Added:
[delete-fertilizer-product! (-> fertilizer-product-or-id/c void?)]))
18
20
19
21
(require racket/contract
20
22
db
@@ -46,6 +48,9 @@
46
48
(~a (nutrient-canonical-name n) #:min-width 14)
47
49
(~a v #:max-width 6 #:align 'right)))))
48
50
51
Added:
(define (fertilizer-product-value fp nutrient)
52
Added:
(hash-ref (fertilizer-product-nutrient-values fp) nutrient #f))
53
Added:
49
54
(define fertilizer-product-or-id/c (or/c fertilizer-product? db-id?))
50
55
51
56
(define (->fp-id fp-or-id)
@@ -55,7 +60,10 @@
55
60
56
61
;; CREATE
57
62
58
Removed:
(define (create-fertilizer-product! canonical-name brand-name nutrient-values)
63
Added:
(define (create-fertilizer-product! fp)
64
Added:
(define canonical-name (fertilizer-product-canonical-name fp))
65
Added:
(define brand-name (fertilizer-product-brand-name fp))
66
Added:
(define nutrient-values (fertilizer-product-nutrient-values fp))
59
67
(with-tx (define fp-id
60
68
(insert-id (query (current-conn)
61
69
(insert #:into fertilizer_products
@@ -66,7 +74,7 @@
66
74
(insert #:into nutrient_value_sets
67
75
#:set [fertilizer_product_id ,fp-id]))))
68
76
(insert-nutrient-values (current-conn) nvs-id nutrient-values)
69
Removed:
(fertilizer-product nvs-id canonical-name brand-name nutrient-values)))
77
Added:
(fertilizer-product fp-id canonical-name brand-name nutrient-values)))
70
78
71
79
;; READ
72
80
@@ -149,6 +157,21 @@
149
157
150
158
;; UPDATE
151
159
160
Added:
(define (update-fertilizer-product! fp)
161
Added:
(define id
162
Added:
(or (fertilizer-product-id fp)
163
Added:
(raise-argument-error 'update-fertilizer-product! "db-id?" (fertilizer-product-id fp))))
164
Added:
(with-tx
165
Added:
(query-exec (current-conn)
166
Added:
(update fertilizer_products
167
Added:
#:set [canonical_name ,(fertilizer-product-canonical-name fp)]
168
Added:
[brand_name ,(fertilizer-product-brand-name fp)]
169
Added:
#:where [= id ,id]))
170
Added:
(define nvs-id
171
Added:
(query-value (current-conn)
172
Added:
(select id #:from nutrient_value_sets #:where [= fertilizer_product_id ,id])))
173
Added:
(update-nutrient-values! (current-conn) nvs-id (fertilizer-product-nutrient-values fp))))
174
Added:
152
175
;; DELETE
153
176
154
177
(define (delete-fertilizer-product! fp-or-id)
@@ -177,9 +200,10 @@
177
200
(define nitrogen (get-nutrient #:name "Nitrogen"))
178
201
(define phosphorus (get-nutrient #:name "Phosphorus"))
179
202
180
Removed:
(create-fertilizer-product! canonical-product-name
181
Removed:
"MasterBlend"
182
Removed:
(hash nitrogen 40 phosphorus 200))
203
Added:
(create-fertilizer-product! (fertilizer-product #f
204
Added:
canonical-product-name
205
Added:
"MasterBlend"
206
Added:
(hash nitrogen 40 phosphorus 200)))
183
207
184
208
(check-equal? (length (get-fertilizer-products)) 1)
185
209
@@ -188,13 +212,6 @@
188
212
(check-equal? (fertilizer-product-canonical-name fp) canonical-product-name)
189
213
(check-equal? (fertilizer-product-brand-name fp) "MasterBlend"))
190
214
191
Removed:
(test-case "Create product without brand name"
192
Removed:
(define nitrogen (get-nutrient #:name "Nitrogen"))
193
Removed:
194
Removed:
(define fp (create-fertilizer-product! "Generic N" "" (hash nitrogen 100)))
195
Removed:
196
Removed:
(check-false (fertilizer-product-brand-name fp)))
197
Removed:
198
215
(test-case "Check all product values"
199
216
(define nitrogen (get-nutrient #:name "Nitrogen"))
200
217
(define phosphorus (get-nutrient #:name "Phosphorus"))
@@ -225,7 +242,9 @@
225
242
226
243
(test-case "Custom write property formatting"
227
244
(define nitrogen (get-nutrient #:name "Nitrogen"))
228
Removed:
(define fp (create-fertilizer-product! "Test Fertilizer" "TestBrand" (hash nitrogen 50)))
245
Added:
(define fp
246
Added:
(create-fertilizer-product!
247
Added:
(fertilizer-product #f "Test Fertilizer" "TestBrand" (hash nitrogen 50))))
229
248
230
249
(define output (open-output-string))
231
250
(write fp output)
@@ -240,6 +259,6 @@
240
259
(delete-fertilizer-product! fp)
241
260
(check-false (get-fertilizer-product #:id (fertilizer-product-id fp)))
242
261
(check-equal? (length (get-fertilizer-products))
243
Removed:
2
262
Added:
1
244
263
"wrong number of fertilizer products were deleted")
245
264
(check-true (hash-empty? (get-fertilizer-product-values fp)))))))
models/nutrient-value.rkt
@@ -5,6 +5,7 @@
5
5
nutrient-value-hash/c
6
6
(contract-out [insert-nutrient-values
7
7
(-> connection? db-id? nutrient-value-hash/c (listof (cons/c symbol? any/c)))]
8
Added:
[update-nutrient-values! (-> connection? db-id? nutrient-value-hash/c void?)]
8
9
[residuals->nutrient-value-hash
9
10
(-> (listof residual-vector/c) nutrient-value-hash/c)]))
10
11
@@ -32,6 +33,13 @@
32
33
value_ppm
33
34
#:from (TableExpr:AST ,(make-values*-table-expr-ast nv-rows)))))
34
35
(simple-result-info result))
36
Added:
37
Added:
(define (update-nutrient-values! conn nvs-id nutrient-values)
38
Added:
(for ([(n v) (in-hash nutrient-values)])
39
Added:
(query-exec conn
40
Added:
(update nutrient_values
41
Added:
#:set [value_ppm ,v]
42
Added:
#:where (and (= value_set_id ,nvs-id) (= nutrient_id ,(nutrient-id n)))))))
35
43
36
44
(define (residuals->nutrient-value-hash residuals)
37
45
(for/hash ([r (in-list residuals)])
views.rkt
@@ -9,6 +9,7 @@
9
9
new-measurement-page
10
10
new-rotation-page
11
11
new-fertilizer-page
12
Added:
edit-fertilizer-page
12
13
show-measurement-page
13
14
show-rotation-page
14
15
show-fertilizer-page
@@ -16,6 +17,7 @@
16
17
17
18
(require gregor
18
19
web-server/formlets
20
Added:
racket/hash
19
21
"formlets.rkt"
20
22
"models/user.rkt"
21
23
"models/nutrient.rkt"
@@ -187,10 +189,15 @@
187
189
(define (new-measurement-page)
188
190
(page-template "Nouveau relevé"
189
191
`((h1 ((class "display-1 mb-3")) "Nouveau relevé")
192
Added:
;; New
193
Added:
194
Added:
(define (form-page-template title action formlet)
195
Added:
(page-template title
196
Added:
`((h1 ((class "display-1 mb-3")) ,title)
190
197
(div ((class "mb-3") [style "max-width: 30em"])
191
Removed:
(form ([action "/ferti/measurements/create"] [method "POST"])
192
Removed:
,@(formlet-display (measurements-formlet)))))))
198
Added:
(form ([action ,action] [method "POST"]) ,@(formlet-display formlet))))))
193
199
200
Added:
194
201
(define (new-rotation-page #:date [date-string #f])
195
202
(page-template "Nouvel assolement"
196
203
`((h1 ((class "display-1 mb-3")) "Nouvel assolement")
@@ -204,7 +211,18 @@
204
211
(div ((class "mb-3") [style "max-width: 30em"])
205
212
(form ([action "/ferti/fertilizers/create"] [method "POST"])
206
213
,@(formlet-display (fertilizer-formlet)))))))
214
Added:
;; Edit
207
215
216
Added:
(define (edit-fertilizer-page fp)
217
Added:
(form-page-template "Modifier intrant" "/ferti/fertilizers/update" (fertilizer-formlet #:value fp)))
218
Added:
219
Added:
;; (define (new-crop-requirement-page)
220
Added:
;; (page-template "Nouveau profil"
221
Added:
;; `((h1 ((class "display-1 mb-3")) "Nouveau profil")
222
Added:
;; (div ((class "mb-3") [style "max-width: 30em"])
223
Added:
;; (form ([action "/ferti/crop-requirements/create"] [method "POST"])
224
Added:
;; ,@(formlet-display (crop-requirement-formlet)))))))
225
Added:
208
226
(define (show-measurement-page nm)
209
227
(define title (format "Relevé du ~a" (normal-date (nutrient-measurement-date nm))))
210
228
(define table
@@ -251,12 +269,18 @@
251
269
(match-define (cons n v) nv-pair)
252
270
`(tr (td ,(nutrient-french-name n))
253
271
(td ((class "text-end font-monospace")) ,(round 2 v)))))))
272
Added:
(define button-group
273
Added:
`(div ((class "btn-group"))
274
Added:
(a ((class "btn btn-primary")
275
Added:
[href ,(format "/ferti/fertilizers/~a/edit" (fertilizer-product-id fp))])
276
Added:
"Modifier")
277
Added:
(a ((class "btn btn-danger")
278
Added:
[href ,(format "/ferti/fertilizers/~a/destroy" (fertilizer-product-id fp))])
279
Added:
"Supprimer")))
254
280
(page-template product-name
255
281
`((h1 ((class "display-1 mb-3")) ,(or brand-name "Intrant générique"))
256
282
(h5 ((class "display-5 mb-3")) ,product-name)
257
Removed:
(a ((class "btn btn-danger")
258
Removed:
[href ,(format "/ferti/fertilizers/destroy/~a" (fertilizer-product-id fp))])
259
Removed:
"Supprimer")
283
Added:
,button-group
260
284
,table)))
261
285
262
286
(define (index-page user)