[Racket] Ferti hydroponic nutrient solver, redux.
Add crop requirement new/show/edit logic.
Changed files
db/seed.rkt
@@ -86,11 +86,9 @@
86
86
(define v (string->number (cdr crop-requirement)))
87
87
(values n v)))
88
88
(unless (get-crop-requirement #:profile profile)
89
Removed:
(cond
90
Removed:
[(non-empty-string? crop-name)
91
Removed:
(define crop (get-crop #:name crop-name))
92
Removed:
(create-crop-requirement! profile nutrient-values crop)]
93
Removed:
[else (create-crop-requirement! profile nutrient-values)])))
89
Added:
(if (non-empty-string? crop-name)
90
Added:
(create-crop-requirement! profile nutrient-values (get-crop #:name crop-name))
91
Added:
(create-crop-requirement! profile nutrient-values))))
94
92
(with-tx (csv-for-each row->seed! next-row)))
95
93
96
94
(define (seed-initial-crop-rotation!)
formlets.rkt
@@ -2,7 +2,8 @@
2
2
3
3
(provide measurements-formlet
4
4
rotation-formlet
5
Removed:
fertilizer-formlet)
5
Added:
fertilizer-formlet
6
Added:
crop-requirements-formlet)
6
7
7
8
(require gregor
8
9
web-server/formlets
@@ -82,9 +83,42 @@
82
83
(let ([id (string->number (first id*))]
83
84
[canonical-name (first canonical-name*)]
84
85
[brand-name (first brand-name*)]
85
Removed:
[nutrient-values (for/hash ([nv nutrient-values*])
86
Removed:
(values (car nv) (cdr nv)))])
86
Added:
[nutrient-values (make-immutable-hash nutrient-values*)])
87
87
(fertilizer-product id canonical-name brand-name nutrient-values))))
88
Added:
89
Added:
(define (crop-requirements-formlet #:value [cr #f])
90
Added:
(formlet* (#%# (=>* (to-string (required (hidden (if cr
91
Added:
(number->string (crop-requirement-id cr))
92
Added:
""))))
93
Added:
id*)
94
Added:
`(div ((class "mb-3"))
95
Added:
(h5 "Profil de culture")
96
Added:
,(=>* (required-string-input #:value (if cr
97
Added:
(crop-requirement-profile cr)
98
Added:
""))
99
Added:
profile*))
100
Added:
`(div ((class "mb-3"))
101
Added:
(h5 "Culture associée")
102
Added:
,(=>* (select-input (cons (crop #f "<aucune>") (get-crops))
103
Added:
#:attributes '((class "form-select"))
104
Added:
#:display crop-name)
105
Added:
crop*))
106
Added:
`(div ((class "mb-3"))
107
Added:
(h5 "Valeurs du profil")
108
Added:
,@(for/list ([n (get-nutrients)])
109
Added:
(define v
110
Added:
(if cr
111
Added:
(crop-requirement-value cr n)
112
Added:
0))
113
Added:
(=>* (nutrient-value-formlet n v) nutrient-values*)))
114
Added:
(=>* (submit (string-join (list (if cr "Modifier" "Enregistrer") "l'intrant"))
115
Added:
#:attributes '((class "btn btn-primary")))
116
Added:
_))
117
Added:
(let ([id (string->number (first id*))]
118
Added:
[profile (first profile*)]
119
Added:
[crop-id (crop-id (first crop*))]
120
Added:
[nutrient-values (make-immutable-hash nutrient-values*)])
121
Added:
(crop-requirement id profile crop-id nutrient-values))))
88
122
89
123
(define (crop-requirement-formlet requirement)
90
124
(define id (number->string (crop-requirement-id requirement)))
handlers.rkt
@@ -48,6 +48,13 @@
48
48
[("ferti" "fertilizers" (integer-arg) "edit") #:method "get" edit-fertilizer]
49
49
[("ferti" "fertilizers" "update") #:method "post" update-fertilizer]
50
50
[("ferti" "fertilizers" (integer-arg) "destroy") #:method "get" destroy-fertilizer]
51
Added:
;; Crop requirements
52
Added:
[("ferti" "crop-requirements" "new") #:method "get" new-requirement]
53
Added:
[("ferti" "crop-requirements" "create") #:method "post" create-requirement]
54
Added:
[("ferti" "crop-requirements" (integer-arg)) #:method "get" show-requirement]
55
Added:
[("ferti" "crop-requirements" (integer-arg) "edit") #:method "get" edit-requirement]
56
Added:
[("ferti" "crop-requirements" "update") #:method "post" update-requirement]
57
Added:
[("ferti" "crop-requirements" (integer-arg) "destroy") #:method "get" destroy-requirement]
51
58
;; Default
52
59
[("") #:method "get" index]
53
60
[else fallback]))
@@ -157,6 +164,35 @@
157
164
(define (destroy-fertilizer _ id)
158
165
(delete-fertilizer-product! id)
159
166
(redirect-to "/ferti/fertilizers"))
167
Added:
168
Added:
;; Crop requirements
169
Added:
170
Added:
(define (new-requirement _)
171
Added:
(render-page (new-crop-requirement-page)))
172
Added:
173
Added:
(define (create-requirement req)
174
Added:
(define new-requirement (formlet-process (crop-requirements-formlet) req))
175
Added:
(if (get-crop-requirement #:profile (crop-requirement-profile new-requirement))
176
Added:
(update-crop-requirement! new-requirement)
177
Added:
(create-crop-requirement! new-requirement))
178
Added:
(redirect-to "/ferti/crop-requirements"))
179
Added:
180
Added:
(define (show-requirement _ id)
181
Added:
(define cr (get-crop-requirement #:id id))
182
Added:
(render-page (show-crop-requirement-page cr)))
183
Added:
184
Added:
(define (edit-requirement _ id)
185
Added:
(define cr (get-crop-requirement #:id id))
186
Added:
(render-page (edit-crop-requirement-page cr)))
187
Added:
188
Added:
(define (update-requirement req)
189
Added:
(define edited-nutrient-requirement (formlet-process (crop-requirements-formlet) req))
190
Added:
(update-crop-requirement! edited-nutrient-requirement)
191
Added:
(redirect-to "/ferti/crop-requirements"))
192
Added:
193
Added:
(define (destroy-requirement _ id)
194
Added:
(delete-crop-requirement! id)
195
Added:
(redirect-to "/ferti/crop-requirements"))
160
196
161
197
;; Fallback
162
198
models/crop-requirement.rkt
@@ -5,13 +5,18 @@
5
5
crop-requirement-id
6
6
crop-requirement-profile
7
7
crop-requirement-crop-id
8
Added:
crop-requirement-value
8
9
(rename-out [crop-requirement-nutrient-values crop-requirement-values])
9
10
(contract-out
10
Removed:
[create-crop-requirement! (->* (string? nutrient-value-hash/c) (crop?) crop-requirement?)]
11
Added:
[create-crop-requirement!
12
Added:
(case-> (-> crop-requirement? crop-requirement?)
13
Added:
(-> string? nutrient-value-hash/c crop-requirement?)
14
Added:
(-> string? nutrient-value-hash/c crop? crop-requirement?))]
11
15
[get-crop-requirements (-> (listof crop-requirement?))]
12
16
[get-crop-requirement (->* () (#:id db-id? #:profile string?) (or/c crop-requirement? #f))]
13
17
[get-crop-requirement-values (-> crop-requirement-or-id/c nutrient-value-hash/c)]
14
18
[get-crop-requirement-value (-> crop-requirement-or-id/c nutrient? maybe-nutrient-value?)]
19
Added:
[update-crop-requirement! (-> crop-requirement? void?)]
15
20
[delete-crop-requirement! (-> crop-requirement-or-id/c void?)]
16
21
[average-crop-requirement-nutrient-values
17
22
(-> (hash/c crop-requirement? (between/c 0 100)) nutrient-value-hash/c)]))
@@ -29,6 +34,9 @@
29
34
#:guard (λ (id profile crop-id nutrient-values _)
30
35
(values id profile (if (sql-null? crop-id) #f crop-id) nutrient-values)))
31
36
37
Added:
(define (crop-requirement-value cr nutrient)
38
Added:
(hash-ref (crop-requirement-nutrient-values cr) nutrient #f))
39
Added:
32
40
(define crop-requirement-or-id/c (or/c crop-requirement? db-id?))
33
41
34
42
(define (->cr-id cr-or-id)
@@ -38,25 +46,31 @@
38
46
39
47
;; CREATE
40
48
41
Removed:
(define (create-crop-requirement! profile nutrient-values [crop #f])
42
Removed:
(with-tx
43
Removed:
(define cr-id
44
Removed:
(insert-id
45
Removed:
(query (current-conn)
46
Removed:
(if crop
47
Removed:
(insert #:into crop_requirements #:set [crop_id ,(crop-id crop)] [profile ,profile])
48
Removed:
(insert #:into crop_requirements #:set [profile ,profile])))))
49
Removed:
(define nvs-id
50
Removed:
(insert-id (query (current-conn)
51
Removed:
(insert #:into nutrient_value_sets #:set [crop_requirement_id ,cr-id]))))
52
Removed:
(insert-nutrient-values (current-conn) nvs-id nutrient-values)
53
Removed:
(crop-requirement cr-id
54
Removed:
profile
55
Removed:
(if crop
56
Removed:
(crop-id crop)
57
Removed:
#f)
58
Removed:
nutrient-values)))
49
Added:
(define create-crop-requirement!
50
Added:
(case-lambda
51
Added:
[(cr) (create-crop-requirement!/cr cr)]
52
Added:
[(profile nutrient-values)
53
Added:
(create-crop-requirement!/cr (crop-requirement #f profile #f nutrient-values))]
54
Added:
[(profile nutrient-values crop)
55
Added:
(create-crop-requirement!/cr (crop-requirement #f profile (crop-id crop) nutrient-values))]))
59
56
57
Added:
(define (create-crop-requirement!/cr cr)
58
Added:
(define profile (crop-requirement-profile cr))
59
Added:
(define nutrient-values (crop-requirement-nutrient-values cr))
60
Added:
(define crop-id (crop-requirement-crop-id cr))
61
Added:
(with-tx (define cr-id
62
Added:
(insert-id
63
Added:
(query (current-conn)
64
Added:
(if crop-id
65
Added:
(insert #:into crop_requirements #:set [crop_id ,crop-id] [profile ,profile])
66
Added:
(insert #:into crop_requirements #:set [profile ,profile])))))
67
Added:
(define nvs-id
68
Added:
(insert-id (query (current-conn)
69
Added:
(insert #:into nutrient_value_sets
70
Added:
#:set [crop_requirement_id ,cr-id]))))
71
Added:
(insert-nutrient-values (current-conn) nvs-id nutrient-values)
72
Added:
(crop-requirement cr-id profile crop-id nutrient-values)))
73
Added:
60
74
;; READ
61
75
62
76
(define joined
@@ -134,6 +148,23 @@
134
148
(= nv.nutrient_id ,(nutrient-id nutrient))))))
135
149
136
150
;; UPDATE
151
Added:
152
Added:
(define (update-crop-requirement! cr)
153
Added:
(define id
154
Added:
(or (crop-requirement-id cr)
155
Added:
(raise-argument-error 'update-crop-requirement! "db-id?" (crop-requirement-id cr))))
156
Added:
(define profile (crop-requirement-profile cr))
157
Added:
(define crop-id (crop-requirement-crop-id cr))
158
Added:
(with-tx
159
Added:
(query-exec
160
Added:
(current-conn)
161
Added:
(if crop-id
162
Added:
(update crop_requirements #:set [profile ,profile] [crop_id ,crop-id] #:where [= id ,id])
163
Added:
(update crop_requirements #:set [profile ,profile] #:where [= id ,id])))
164
Added:
(define nvs-id
165
Added:
(query-value (current-conn)
166
Added:
(select id #:from nutrient_value_sets #:where [= crop_requirement_id ,id])))
167
Added:
(update-nutrient-values! (current-conn) nvs-id (crop-requirement-nutrient-values cr))))
137
168
138
169
;; DELETE
139
170
views.rkt
@@ -14,6 +14,9 @@
14
14
show-measurement-page
15
15
show-rotation-page
16
16
show-fertilizer-page
17
Added:
show-crop-requirement-page
18
Added:
new-crop-requirement-page
19
Added:
edit-crop-requirement-page
17
20
fallback-page)
18
21
19
22
(require gregor
@@ -206,6 +209,9 @@
206
209
(define (new-fertilizer-page)
207
210
(form-page-template "Nouvel intrant" "/ferti/fertilizers/create" (fertilizer-formlet)))
208
211
212
Added:
(define (new-crop-requirement-page)
213
Added:
(form-page-template "Nouveau profil" "/ferti/crop-requirements/create" (crop-requirements-formlet)))
214
Added:
209
215
;; Edit
210
216
211
217
(define (edit-measurement-page nm)
@@ -216,13 +222,13 @@
216
222
(define (edit-fertilizer-page fp)
217
223
(form-page-template "Modifier intrant" "/ferti/fertilizers/update" (fertilizer-formlet #:value fp)))
218
224
219
Removed:
;; (define (new-crop-requirement-page)
220
Removed:
;; (page-template "Nouveau profil"
221
Removed:
;; `((h1 ((class "display-1 mb-3")) "Nouveau profil")
222
Removed:
;; (div ((class "mb-3") [style "max-width: 30em"])
223
Removed:
;; (form ([action "/ferti/crop-requirements/create"] [method "POST"])
224
Removed:
;; ,@(formlet-display (crop-requirement-formlet)))))))
225
Added:
(define (edit-crop-requirement-page cr)
226
Added:
(form-page-template "Modifier profil"
227
Added:
"/ferti/crop-requirements/update"
228
Added:
(crop-requirements-formlet #:value cr)))
225
229
230
Added:
;; Show
231
Added:
226
232
(define (show-measurement-page nm)
227
233
(define title (format "Relevé du ~a" (normal-date (nutrient-measurement-date nm))))
228
234
(define table
@@ -284,6 +290,24 @@
284
290
(h5 ((class "display-5 mb-3")) ,product-name)
285
291
,button-group
286
292
,table)))
293
Added:
294
Added:
(define (show-crop-requirement-page cr)
295
Added:
(define id (crop-requirement-id cr))
296
Added:
(define title (string-titlecase (crop-requirement-profile cr)))
297
Added:
(define table
298
Added:
`(table ((class "table") (style "max-width: 30em"))
299
Added:
(thead (tr (th "Nutriment") (th ((class "text-end")) "Concentration (mg/L)")))
300
Added:
(tbody ,@(for/list ([n (get-nutrients)])
301
Added:
(define nutrient-value (hash-ref (crop-requirement-values cr) n 0))
302
Added:
`(tr (td ,(nutrient-french-name n))
303
Added:
(td ((class "text-end font-monospace")) ,(round 2 nutrient-value)))))))
304
Added:
(define button-group
305
Added:
`(div ((class "btn-group"))
306
Added:
(a ((class "btn btn-primary") [href ,(format "/ferti/crop-requirements/~a/edit" id)])
307
Added:
"Modifier")
308
Added:
(a ((class "btn btn-danger") [href ,(format "/ferti/crop-requirements/~a/destroy" id)])
309
Added:
"Supprimer")))
310
Added:
(page-template title `((h1 ((class "display-1 mb-3")) ,title) ,button-group ,table)))
287
311
288
312
(define (index-page user)
289
313
(page-template