[Racket] Ferti hydroponic nutrient solver, redux.
Add crop new/show/edit logic.
Changed files
formlets.rkt
@@ -3,6 +3,7 @@
3
3
(provide measurements-formlet
4
4
rotation-formlet
5
5
fertilizer-formlet
6
Added:
crop-formlet
6
7
crop-requirements-formlet)
7
8
8
9
(require gregor
@@ -85,6 +86,24 @@
85
86
[brand-name (first brand-name*)]
86
87
[nutrient-values (make-immutable-hash nutrient-values*)])
87
88
(fertilizer-product id canonical-name brand-name nutrient-values))))
89
Added:
90
Added:
(define (crop-formlet #:value [c #f])
91
Added:
(formlet* (#%# (=>* (to-string (required (hidden (if c
92
Added:
(number->string (crop-id c))
93
Added:
""))))
94
Added:
id*)
95
Added:
`(div ((class "mb-3"))
96
Added:
(h5 "Culture")
97
Added:
,(=>* (required-string-input #:value (if c
98
Added:
(crop-name c)
99
Added:
""))
100
Added:
crop-name*))
101
Added:
(=>* (submit (string-join (list (if c "Modifier" "Enregistrer") "la culture"))
102
Added:
#:attributes '((class "btn btn-primary")))
103
Added:
_))
104
Added:
(let ([id (string->number (first id*))]
105
Added:
[crop-name (first crop-name*)])
106
Added:
(crop id crop-name))))
88
107
89
108
(define (crop-requirements-formlet #:value [cr #f])
90
109
(formlet* (#%# (=>* (to-string (required (hidden (if cr
handlers.rkt
@@ -11,6 +11,7 @@
11
11
"formlets.rkt"
12
12
"models/user.rkt"
13
13
"models/nutrient-measurement.rkt"
14
Added:
"models/crop.rkt"
14
15
"models/crop-requirement.rkt"
15
16
"models/crop-rotation.rkt"
16
17
"models/fertilizer-product.rkt"
@@ -35,6 +36,13 @@
35
36
[("ferti" "measurements" (integer-arg) "edit") #:method "get" edit-measurement]
36
37
[("ferti" "measurements" "update") #:method "post" update-measurement]
37
38
[("ferti" "measurements" (integer-arg) "destroy") #:method "get" destroy-measurement]
39
Added:
;; Crops
40
Added:
[("ferti" "crops" "new") #:method "get" new-crop]
41
Added:
[("ferti" "crops" "create") #:method "post" create-crop]
42
Added:
[("ferti" "crops" (integer-arg)) #:method "get" show-crop]
43
Added:
[("ferti" "crops" (integer-arg) "edit") #:method "get" edit-crop]
44
Added:
[("ferti" "crops" "update") #:method "post" update-crop]
45
Added:
[("ferti" "crops" (integer-arg) "destroy") #:method "get" destroy-crop]
38
46
;; Crop rotations
39
47
[("ferti" "rotations" "new") #:method "get" new-rotation]
40
48
[("ferti" "rotations" "new" (string-arg)) #:method "get" new-rotation-for-date]
@@ -116,6 +124,35 @@
116
124
(define (destroy-measurement _ id)
117
125
(delete-nutrient-measurement! id)
118
126
(redirect-to "/ferti/measurements-and-rotations"))
127
Added:
128
Added:
;; Crops
129
Added:
130
Added:
(define (new-crop _)
131
Added:
(render-page (new-crop-page)))
132
Added:
133
Added:
(define (create-crop req)
134
Added:
(define new-crop (formlet-process (crop-formlet) req))
135
Added:
(if (get-crop #:name (crop-name new-crop))
136
Added:
(update-crop! new-crop)
137
Added:
(create-crop! new-crop))
138
Added:
(redirect-to "/ferti/crop-requirements"))
139
Added:
140
Added:
(define (show-crop _ id)
141
Added:
(define crop (get-crop #:id id))
142
Added:
(render-page (show-crop-page crop)))
143
Added:
144
Added:
(define (edit-crop _ id)
145
Added:
(define crop (get-crop #:id id))
146
Added:
(render-page (edit-crop-page crop)))
147
Added:
148
Added:
(define (update-crop req)
149
Added:
(define edited-crop (formlet-process (crop-formlet) req))
150
Added:
(update-crop! edited-crop)
151
Added:
(redirect-to "/ferti/crop-requirements"))
152
Added:
153
Added:
(define (destroy-crop _ id)
154
Added:
(delete-crop! id)
155
Added:
(redirect-to "/ferti/crop-requirements"))
119
156
120
157
;; Crop rotations
121
158
models/crop.rkt
@@ -4,7 +4,7 @@
4
4
crop?
5
5
crop-id
6
6
crop-name
7
Removed:
(contract-out [create-crop! (-> string? crop?)]
7
Added:
(contract-out [create-crop! (-> crop? crop?)]
8
8
[get-crops (-> (listof crop?))]
9
9
[get-crop (->* () (#:id db-id? #:name string?) (or/c crop? #f))]
10
10
[update-crop! (->* (db-id?) (#:name string?) (or/c crop? #f))]
@@ -19,7 +19,8 @@
19
19
20
20
;; CREATE
21
21
22
Removed:
(define (create-crop! name)
22
Added:
(define (create-crop! c)
23
Added:
(define name (crop-name c))
23
24
(or (get-crop #:name name)
24
25
(with-tx (query-exec (current-conn) (insert #:into crops #:set [canonical_name ,name]))
25
26
(get-crop #:name name))))
views.rkt
@@ -9,14 +9,17 @@
9
9
new-measurement-page
10
10
new-rotation-page
11
11
new-fertilizer-page
12
Added:
new-crop-page
13
Added:
new-crop-requirement-page
12
14
edit-measurement-page
13
15
edit-fertilizer-page
16
Added:
edit-crop-page
17
Added:
edit-crop-requirement-page
14
18
show-measurement-page
15
19
show-rotation-page
16
20
show-fertilizer-page
21
Added:
show-crop-page
17
22
show-crop-requirement-page
18
Removed:
new-crop-requirement-page
19
Removed:
edit-crop-requirement-page
20
23
fallback-page)
21
24
22
25
(require gregor
@@ -167,17 +170,19 @@
167
170
`(table ((class "table table-striped"))
168
171
(tr (th "Profil") (th "Culture"))
169
172
,@(for/list ([cr crop-requirements])
170
Removed:
(define crop-id (crop-requirement-crop-id cr))
173
Added:
(define cid (crop-requirement-crop-id cr))
171
174
`(tr (td (a ((href ,(format "/ferti/crop-requirements/~a" (crop-requirement-id cr))))
172
175
,(string-titlecase (crop-requirement-profile cr))))
173
Removed:
(td ,(if crop-id
174
Removed:
(string-titlecase (crop-name (get-crop #:id crop-id)))
176
Added:
(td ,(if cid
177
Added:
(let ([crop (get-crop #:id cid)])
178
Added:
`(a ((href ,(format "/ferti/crops/~a" cid)))
179
Added:
,(string-titlecase (crop-name crop))))
175
180
"—"))))))
176
181
(define button-group
177
182
'(div ((class "btn-group mb-3"))
178
183
(a ((class "btn btn-primary") [href "/ferti/crop-requirements/new"]) "Ajouter un profil")
179
Removed:
(a ((class "btn btn-secondary") [href "/ferti/crop/new"]) "Ajouter une culture")))
180
Removed:
(ferti-template "Cultures" `(,button-group ,table)))
184
Added:
(a ((class "btn btn-secondary") [href "/ferti/crops/new"]) "Ajouter une culture")))
185
Added:
(ferti-template "Cultures" (list button-group accordion)))
181
186
182
187
;; TODO: add bar chart for comparing to target concentrations
183
188
(define (ferti-recipe-page recipe-date fertilizer-recipe)
@@ -218,6 +223,9 @@
218
223
(define (new-fertilizer-page)
219
224
(form-page-template "Nouvel intrant" "/ferti/fertilizers/create" (fertilizer-formlet)))
220
225
226
Added:
(define (new-crop-page)
227
Added:
(form-page-template "Nouvelle culture" "/ferti/crops/create" (crop-formlet)))
228
Added:
221
229
(define (new-crop-requirement-page)
222
230
(form-page-template "Nouveau profil" "/ferti/crop-requirements/create" (crop-requirements-formlet)))
223
231
@@ -229,8 +237,13 @@
229
237
(measurements-formlet #:value nm)))
230
238
231
239
(define (edit-fertilizer-page fp)
232
Removed:
(form-page-template "Modifier intrant" "/ferti/fertilizers/update" (fertilizer-formlet #:value fp)))
240
Added:
(form-page-template "Modifier l'intrant"
241
Added:
"/ferti/fertilizers/update"
242
Added:
(fertilizer-formlet #:value fp)))
233
243
244
Added:
(define (edit-crop-page crop)
245
Added:
(form-page-template "Modifier la culture" "/ferti/crops/update" (crop-formlet #:value crop)))
246
Added:
234
247
(define (edit-crop-requirement-page cr)
235
248
(form-page-template "Modifier profil"
236
249
"/ferti/crop-requirements/update"
@@ -285,7 +298,7 @@
285
298
286
299
(define (show-fertilizer-page fp)
287
300
(define id (fertilizer-product-id fp))
288
Removed:
(define product-name (fertilizer-product-name fp))
301
Added:
(define product-name (string-titlecase (fertilizer-product-name fp)))
289
302
(define brand-name (fertilizer-brand-name fp))
290
303
(define sorted-nutrient-values (get-sorted-nutrient-values (fertilizer-product-values fp)))
291
304
(define table
@@ -307,9 +320,33 @@
307
320
,button-group
308
321
,table)))
309
322
323
Added:
(define (show-crop-page crop)
324
Added:
(define id (crop-id crop))
325
Added:
(define name (string-titlecase (crop-name crop)))
326
Added:
(define crop-requirements-for-crop
327
Added:
(filter (λ (cr) (equal? (crop-requirement-crop-id cr) (crop-id crop))) (get-crop-requirements)))
328
Added:
(define profile-list
329
Added:
`(ul ,@(for/list ([cr crop-requirements-for-crop])
330
Added:
`(li (a ([href ,(format "/ferti/crop-requirements/~a" (crop-requirement-id cr))])
331
Added:
,(string-titlecase crop-requirement-profile cr))))))
332
Added:
(define button-group
333
Added:
`(div ((class "btn-group mb-3"))
334
Added:
(a ((class "btn btn-primary") [href ,(format "/ferti/crops/~a/edit" id)]) "Modifier")
335
Added:
(a ((class "btn btn-danger") [href ,(format "/ferti/crops/~a/destroy" id)]) "Supprimer")))
336
Added:
(page-template name `((h1 ((class "display-1 mb-3")) ,name) ,button-group ,profile-list)))
337
Added:
310
338
(define (show-crop-requirement-page cr)
311
339
(define id (crop-requirement-id cr))
312
Removed:
(define title (string-titlecase (crop-requirement-profile cr)))
340
Added:
(define cid (crop-requirement-crop-id cr))
341
Added:
(define crop
342
Added:
(if cid
343
Added:
(string-titlecase (crop-name (get-crop #:id cid)))
344
Added:
#f))
345
Added:
(define profile (string-titlecase (crop-requirement-profile cr)))
346
Added:
(define title
347
Added:
(if crop
348
Added:
(format "~a — ~a" crop profile)
349
Added:
profile))
313
350
(define table
314
351
`(table ((class "table") (style "max-width: 30em"))
315
352
(thead (tr (th "Nutriment") (th ((class "text-end")) "Concentration (mg/L)")))
@@ -323,7 +360,11 @@
323
360
"Modifier")
324
361
(a ((class "btn btn-danger") [href ,(format "/ferti/crop-requirements/~a/destroy" id)])
325
362
"Supprimer")))
326
Removed:
(page-template title `((h1 ((class "display-1 mb-3")) ,title) ,button-group ,table)))
363
Added:
(page-template title
364
Added:
`((h1 ((class "display-1 mb-3")) ,profile) (h5 ((class "display-5 mb-3"))
365
Added:
,(or crop "Profil générique"))
366
Added:
,button-group
367
Added:
,table)))
327
368
328
369
(define (index-page user)
329
370
(page-template