[Racket] Ferti hydroponic nutrient solver, redux.
1
#lang racket
2
3
(provide production-dispatch
4
fapg-url)
5
6
(require web-server/dispatch
7
web-server/http
8
web-server/formlets
9
"authentication.rkt"
10
"views.rkt"
11
"formlets.rkt"
12
"models/user.rkt"
13
"models/nutrient-measurement.rkt"
14
"models/crop.rkt"
15
"models/crop-requirement.rkt"
16
"models/crop-rotation.rkt"
17
"models/fertilizer-product.rkt"
18
"services/nnls.rkt")
19
20
(define (production-dispatch)
21
(make-auth-dispatch fapg-dispatch))
22
23
(define-values (fapg-dispatch fapg-url)
24
(dispatch-rules
25
[("index") #:method "get" index]
26
;; Ferti
27
[("ferti" "index") #:method "get" ferti-index]
28
[("ferti" "measurements-and-rotations") #:method "get" ferti-measurements-and-rotations]
29
[("ferti" "recipes" (string-arg)) #:method "get" ferti-recipe]
30
[("ferti" "fertilizers") #:method "get" ferti-fertilizers]
31
[("ferti" "crop-requirements") #:method "get" ferti-crop-requirements]
32
;; Nutrient measurements
33
[("ferti" "measurements" "new") #:method "get" new-measurement]
34
[("ferti" "measurements" "create") #:method "post" create-measurement]
35
[("ferti" "measurements" (integer-arg)) #:method "get" show-measurement]
36
[("ferti" "measurements" (integer-arg) "edit") #:method "get" edit-measurement]
37
[("ferti" "measurements" "update") #:method "post" update-measurement]
38
[("ferti" "measurements" (integer-arg) "destroy") #:method "get" destroy-measurement]
39
;; Crops
40
[("ferti" "crops" "new") #:method "get" new-crop]
41
[("ferti" "crops" "create") #:method "post" create-crop]
42
[("ferti" "crops" (integer-arg)) #:method "get" show-crop]
43
[("ferti" "crops" (integer-arg) "edit") #:method "get" edit-crop]
44
[("ferti" "crops" "update") #:method "post" update-crop]
45
[("ferti" "crops" (integer-arg) "destroy") #:method "get" destroy-crop]
46
;; Crop rotations
47
[("ferti" "rotations" "new") #:method "get" new-rotation]
48
[("ferti" "rotations" "new" (string-arg)) #:method "get" new-rotation-for-date]
49
[("ferti" "rotations" "create") #:method "post" create-rotation]
50
[("ferti" "rotations" (integer-arg)) #:method "get" show-rotation]
51
[("ferti" "rotations" (integer-arg) "destroy") #:method "get" destroy-rotation]
52
;; Fertilizer products
53
[("ferti" "fertilizers" "new") #:method "get" new-fertilizer]
54
[("ferti" "fertilizers" "create") #:method "post" create-fertilizer]
55
[("ferti" "fertilizers" (integer-arg)) #:method "get" show-fertilizer]
56
[("ferti" "fertilizers" (integer-arg) "edit") #:method "get" edit-fertilizer]
57
[("ferti" "fertilizers" "update") #:method "post" update-fertilizer]
58
[("ferti" "fertilizers" (integer-arg) "destroy") #:method "get" destroy-fertilizer]
59
;; Crop requirements
60
[("ferti" "crop-requirements" "new") #:method "get" new-requirement]
61
[("ferti" "crop-requirements" "create") #:method "post" create-requirement]
62
[("ferti" "crop-requirements" (integer-arg)) #:method "get" show-requirement]
63
[("ferti" "crop-requirements" (integer-arg) "edit") #:method "get" edit-requirement]
64
[("ferti" "crop-requirements" "update") #:method "post" update-requirement]
65
[("ferti" "crop-requirements" (integer-arg) "destroy") #:method "get" destroy-requirement]
66
;; Default
67
[("") #:method "get" index]
68
[else fallback]))
69
70
(define (render-page xexpr)
71
(response/xexpr #:preamble #"<!DOCTYPE html>" xexpr))
72
73
;; Index
74
75
(define (index _)
76
(define user (get-current-user))
77
(render-page (index-page user)))
78
79
;; Ferti
80
81
(define (ferti-index _)
82
(render-page (ferti-index-page)))
83
84
(define (ferti-measurements-and-rotations _)
85
(define measurements (get-nutrient-measurements))
86
(define rotations (get-crop-rotations))
87
(render-page (ferti-measurements-and-rotations-page measurements rotations)))
88
89
(define (ferti-recipe _ date-string)
90
(define ferti-recipe (find-ferti-recipe date-string))
91
(render-page (ferti-recipe-page date-string ferti-recipe)))
92
93
(define (ferti-fertilizers _)
94
(render-page (ferti-fertilizers-page (get-fertilizer-products))))
95
96
(define (ferti-crop-requirements _)
97
(render-page (ferti-crop-requirements-page (get-crop-requirements))))
98
99
;; Nutrient measurements
100
101
(define (new-measurement _)
102
(render-page (new-measurement-page)))
103
104
(define (create-measurement req)
105
(define new-measurement (formlet-process (measurements-formlet) req))
106
(if (get-nutrient-measurement #:date (nutrient-measurement-date new-measurement))
107
(update-nutrient-measurement! new-measurement)
108
(create-nutrient-measurement! new-measurement))
109
(redirect-to "/ferti/measurements-and-rotations"))
110
111
(define (show-measurement _ id)
112
(define nm (get-nutrient-measurement #:id id))
113
(render-page (show-measurement-page nm)))
114
115
(define (edit-measurement _ id)
116
(define nm (get-nutrient-measurement #:id id))
117
(render-page (edit-measurement-page nm)))
118
119
(define (update-measurement req)
120
(define edited-nutrient-measurement (formlet-process (measurements-formlet) req))
121
(update-nutrient-measurement! edited-nutrient-measurement)
122
(redirect-to "/ferti/measurements-and-rotations"))
123
124
(define (destroy-measurement _ id)
125
(delete-nutrient-measurement! id)
126
(redirect-to "/ferti/measurements-and-rotations"))
127
128
;; Crops
129
130
(define (new-crop _)
131
(render-page (new-crop-page)))
132
133
(define (create-crop req)
134
(define new-crop (formlet-process (crop-formlet) req))
135
(if (get-crop #:name (crop-name new-crop))
136
(update-crop! new-crop)
137
(create-crop! new-crop))
138
(redirect-to "/ferti/crop-requirements"))
139
140
(define (show-crop _ id)
141
(define crop (get-crop #:id id))
142
(render-page (show-crop-page crop)))
143
144
(define (edit-crop _ id)
145
(define crop (get-crop #:id id))
146
(render-page (edit-crop-page crop)))
147
148
(define (update-crop req)
149
(define edited-crop (formlet-process (crop-formlet) req))
150
(update-crop! edited-crop)
151
(redirect-to "/ferti/crop-requirements"))
152
153
(define (destroy-crop _ id)
154
(delete-crop! id)
155
(redirect-to "/ferti/crop-requirements"))
156
157
;; Crop rotations
158
159
(define (new-rotation _)
160
(render-page (new-rotation-page)))
161
162
(define (new-rotation-for-date _ date-string)
163
(render-page (new-rotation-page #:date date-string)))
164
165
(define (create-rotation req)
166
(define-values (rotation-date req-proportions) (formlet-process (rotation-formlet) req))
167
(create-crop-rotation! rotation-date req-proportions)
168
(redirect-to "/ferti/measurements-and-rotations"))
169
170
(define (show-rotation _ id)
171
(define cr (get-crop-rotation #:id id))
172
(render-page (show-rotation-page cr)))
173
174
(define (destroy-rotation _ id)
175
(delete-crop-rotation! id)
176
(redirect-to "/ferti/measurements-and-rotations"))
177
178
;; Fertilizer products
179
180
(define (new-fertilizer _)
181
(render-page (new-fertilizer-page)))
182
183
(define (create-fertilizer req)
184
(define new-fertilizer (formlet-process (fertilizer-formlet) req))
185
(create-fertilizer-product! new-fertilizer)
186
(redirect-to "/ferti/fertilizers"))
187
188
(define (show-fertilizer _ id)
189
(define fp (get-fertilizer-product #:id id))
190
(render-page (show-fertilizer-page fp)))
191
192
(define (edit-fertilizer _ id)
193
(define fp (get-fertilizer-product #:id id))
194
(render-page (edit-fertilizer-page fp)))
195
196
(define (update-fertilizer req)
197
(define edited-fertilizer-product (formlet-process (fertilizer-formlet) req))
198
(update-fertilizer-product! edited-fertilizer-product)
199
(redirect-to "/ferti/fertilizers"))
200
201
(define (destroy-fertilizer _ id)
202
(delete-fertilizer-product! id)
203
(redirect-to "/ferti/fertilizers"))
204
205
;; Crop requirements
206
207
(define (new-requirement _)
208
(render-page (new-crop-requirement-page)))
209
210
(define (create-requirement req)
211
(define new-requirement (formlet-process (crop-requirements-formlet) req))
212
(if (get-crop-requirement #:profile (crop-requirement-profile new-requirement))
213
(update-crop-requirement! new-requirement)
214
(create-crop-requirement! new-requirement))
215
(redirect-to "/ferti/crop-requirements"))
216
217
(define (show-requirement _ id)
218
(define cr (get-crop-requirement #:id id))
219
(render-page (show-crop-requirement-page cr)))
220
221
(define (edit-requirement _ id)
222
(define cr (get-crop-requirement #:id id))
223
(render-page (edit-crop-requirement-page cr)))
224
225
(define (update-requirement req)
226
(define edited-nutrient-requirement (formlet-process (crop-requirements-formlet) req))
227
(update-crop-requirement! edited-nutrient-requirement)
228
(redirect-to "/ferti/crop-requirements"))
229
230
(define (destroy-requirement _ id)
231
(delete-crop-requirement! id)
232
(redirect-to "/ferti/crop-requirements"))
233
234
;; Fallback
235
236
(define (fallback _)
237
(render-page (fallback-page 404)))
238