[Racket] Ferti hydroponic nutrient solver, redux.
Split Ferti into sub-tabs.
Changed files
handlers.rkt
@@ -1,6 +1,7 @@
1
1
#lang racket
2
2
3
Removed:
(provide secured-dispatch)
3
Added:
(provide secured-dispatch
4
Added:
fapg-url)
4
5
5
6
(require web-server/dispatch
6
7
web-server/http
@@ -9,6 +10,7 @@
9
10
"views.rkt"
10
11
"formlets.rkt"
11
12
"models/user.rkt"
13
Added:
"models/nutrient.rkt"
12
14
"models/nutrient-measurement.rkt"
13
15
"models/nutrient-target.rkt"
14
16
"models/fertilizer-product.rkt"
@@ -20,7 +22,7 @@
20
22
(or (getenv "FERTI_PASS") (error 'ferti "FERTI_PASS environment variable is not set")))
21
23
22
24
(define (secured-dispatch)
23
Removed:
(wrap-basic-auth app-dispatch))
25
Added:
(wrap-basic-auth fapg-dispatch))
24
26
25
27
(define (wrap-basic-auth handler)
26
28
(lambda (req)
@@ -44,8 +46,12 @@
44
46
(list (make-basic-auth-header (format "Basic Auth Test: ~a" (gensym))))
45
47
void))
46
48
47
Removed:
(define-values (app-dispatch _)
48
Removed:
(dispatch-rules [("ferti") #:method "get" ferti]
49
Added:
(define-values (fapg-dispatch fapg-url)
50
Added:
(dispatch-rules [("ferti" "index") #:method "get" ferti-index]
51
Added:
[("ferti" "measurements") #:method "get" ferti-measurements]
52
Added:
[("ferti" "targets") #:method "get" ferti-targets]
53
Added:
[("ferti" "recipe") #:method "get" ferti-recipe]
54
Added:
[("ferti" "fertilizers") #:method "get" ferti-fertilizers]
49
55
[("measurement" "new") #:method "get" new-measurement]
50
56
[("measurement" "create") #:method "post" create-measurement]
51
57
[("measurement" "destroy") #:method "post" destroy-measurement]
@@ -59,18 +65,35 @@
59
65
(define (render-page xexpr)
60
66
(response/xexpr #:preamble #"<!DOCTYPE html>" xexpr))
61
67
62
Removed:
(define (ferti _)
63
Removed:
(define ferti-recipe (find-ferti-recipe))
64
Removed:
(define latest-measurement-hash (get-latest-nutrient-measurement-hash))
65
Removed:
(define latest-target-hash (get-latest-nutrient-target-hash))
66
Removed:
(define latest-measurements (take (get-nutrient-measurements) 10))
67
Removed:
(render-page
68
Removed:
(ferti-page ferti-recipe latest-measurement-hash latest-target-hash latest-measurements)))
68
Added:
;; Index
69
69
70
70
(define (index _)
71
71
(define user (get-current-user))
72
72
(render-page (index-page user)))
73
73
74
Added:
;; Ferti
75
Added:
76
Added:
(define (ferti-index _)
77
Added:
(render-page (ferti-index-page)))
78
Added:
79
Added:
(define (ferti-measurements _)
80
Added:
(define nutrients (get-nutrients))
81
Added:
(define measurements (get-nutrient-measurements))
82
Added:
(render-page (ferti-measurements-page nutrients measurements)))
83
Added:
84
Added:
(define (ferti-targets _)
85
Added:
(define latest-measurement-hash (get-latest-nutrient-measurement-hash))
86
Added:
(define latest-target-hash (get-latest-nutrient-target-hash))
87
Added:
(render-page (ferti-targets-page latest-measurement-hash latest-target-hash)))
88
Added:
89
Added:
(define (ferti-recipe _)
90
Added:
(define ferti-recipe (find-ferti-recipe))
91
Added:
(render-page (ferti-recipe-page ferti-recipe)))
92
Added:
93
Added:
(define (ferti-fertilizers _)
94
Added:
(define fertilizers (get-fertilizer-products))
95
Added:
(render-page (ferti-fertilizers-page fertilizers)))
96
Added:
74
97
;; Nutrient measurements
75
98
76
99
(define (new-measurement _)
@@ -79,11 +102,11 @@
79
102
(define (create-measurement req)
80
103
(define-values (measured-on nutrient-values) (formlet-process (measurements-formlet) req))
81
104
(create-nutrient-measurement! measured-on nutrient-values)
82
Removed:
(redirect-to "/ferti"))
105
Added:
(redirect-to "/ferti/measurements"))
83
106
84
107
(define (destroy-measurement req)
85
108
(delete-nutrient-measurement! req)
86
Removed:
(redirect-to "/ferti"))
109
Added:
(redirect-to "/ferti/index"))
87
110
88
111
;; Nutrient targets
89
112
@@ -93,7 +116,7 @@
93
116
(define (create-target req)
94
117
(define-values (effective-on nutrient-values) (formlet-process (targets-formlet) req))
95
118
(create-nutrient-target! effective-on nutrient-values)
96
Removed:
(redirect-to "/ferti"))
119
Added:
(redirect-to "/ferti/targets"))
97
120
98
121
;; Fertilizer products
99
122
@@ -104,7 +127,7 @@
104
127
(define-values (canonical-name brand-name nutrient-values)
105
128
(formlet-process (fertilizer-formlet) req))
106
129
(create-fertilizer-product! canonical-name brand-name nutrient-values)
107
Removed:
(redirect-to "/ferti"))
130
Added:
(redirect-to "/ferti/fertilizers"))
108
131
109
132
;; Fallback
110
133
views.rkt
@@ -1,7 +1,11 @@
1
1
#lang racket
2
2
3
3
(provide index-page
4
Removed:
ferti-page
4
Added:
ferti-index-page
5
Added:
ferti-measurements-page
6
Added:
ferti-targets-page
7
Added:
ferti-recipe-page
8
Added:
ferti-fertilizers-page
5
9
new-measurement-page
6
10
new-target-page
7
11
new-fertilizer-page
@@ -54,7 +58,7 @@
54
58
(a ((class "nav-link disabled") [href "#"] [tabindex "-1"] [aria-disabled "true"])
55
59
"Clients"))
56
60
(li ((class "nav-item"))
57
Removed:
(a ((class "nav-link active") [aria-current "page"] [href "/ferti"]) "Ferti"))
61
Added:
(a ((class "nav-link active") [aria-current "page"] [href "/ferti/index"]) "Ferti"))
58
62
(li ((class "nav-item"))
59
63
(a ((class "nav-link disabled") [href "#"] [tabindex "-1"] [aria-disabled "true"])
60
64
"Cultures"))
@@ -67,88 +71,101 @@
67
71
68
72
;; Pages
69
73
70
Removed:
(define (ferti-page fertilizer-recipe latest-measurement-hash latest-target-hash measurements)
71
Removed:
(page-template "Ferti"
72
Removed:
`((h1 ((class "display-1 mb-3")) "Ferti") ,ferti-actions
73
Removed:
,@(ferti-recipe fertilizer-recipe)
74
Removed:
,@(ferti-targets latest-measurement-hash
75
Removed:
latest-target-hash)
76
Removed:
,@(ferti-measurements measurements)
77
Removed:
,@(ferti-fertilizers))))
74
Added:
(define (ferti-template body-xexpr)
75
Added:
(page-template "Ferti" `((h1 ((class "display-1 mb-3")) "Ferti") ,ferti-tabs ,@body-xexpr)))
78
76
79
Removed:
(define ferti-actions
80
Removed:
`(div ((class "btn-group mb-3"))
81
Removed:
(a ((class "btn btn-outline-primary") [href "/target/new"]) "Créer une cible")
82
Removed:
(a ((class "btn btn-outline-primary") [href "/measurement/new"]) "Ajouter un relevé")
83
Removed:
(a ((class "btn btn-outline-primary") [href "/fertilizer/new"]) "Ajouter un intrant")))
77
Added:
(define ferti-tabs
78
Added:
'(ul ((class "nav nav-tabs mb-3"))
79
Added:
(li ((class "nav-item"))
80
Added:
(a ((class "nav-link") (aria-current "page") (href "/ferti/index")) "Accueil"))
81
Added:
(li ((class "nav-item"))
82
Added:
(a ((class "nav-link") (aria-current "page") (href "/ferti/measurements")) "Relevés"))
83
Added:
(li ((class "nav-item"))
84
Added:
(a ((class "nav-link") (aria-current "page") (href "/ferti/targets")) "Cibles"))
85
Added:
(li ((class "nav-item"))
86
Added:
(a ((class "nav-link") (aria-current "page") (href "/ferti/fertilizers")) "Intrants"))
87
Added:
(li ((class "nav-item"))
88
Added:
(a ((class "nav-link") (aria-current "page") (href "/ferti/recipe")) "Recette Ferti©"))))
84
89
85
Removed:
(define (ferti-recipe ferti-recipe)
86
Removed:
`((h2 () "Recette")
87
Removed:
,(if (ormap (λ (pair) (not (zero? (cdr pair)))) ferti-recipe)
88
Removed:
`(table ((class "table"))
89
Removed:
(tr (th "Intrant") (th ((class "text-end")) "Quantité (g/L)"))
90
Removed:
,@(for/list ([fertilizer-amount ferti-recipe]
91
Removed:
#:when (not (zero? (cdr fertilizer-amount))))
92
Removed:
(match-define (cons fertilizer amount) fertilizer-amount)
93
Removed:
`(tr (td ()
94
Removed:
,(let ([canonical-name (fertilizer-name fertilizer)]
95
Removed:
[brand-name (fertilizer-brand-name fertilizer)])
96
Removed:
(if brand-name
97
Removed:
(format "~a (~a)" brand-name canonical-name)
98
Removed:
canonical-name)))
99
Removed:
(td ((class "text-end font-monospace")) ,(round 2 amount)))))
100
Removed:
`(p "La recette Ferti requiert au moins un relevé et une cible."))))
90
Added:
(define (ferti-index-page)
91
Added:
(ferti-template
92
Added:
'((p "La recette Ferti© est calculée en fonction d'un relevé de nutriments et d'une cible.")
93
Added:
(div ((class "btn-group-vertical"))
94
Added:
(a ((class "btn btn-outline-primary") [href "/measurement/new"]) "Ajouter un relevé")
95
Added:
(a ((class "btn btn-outline-primary") [href "/target/new"]) "Créer une cible")
96
Added:
(a ((class "btn btn-outline-primary") [href "/fertilizer/new"]) "Ajouter un intrant")))))
101
97
102
Removed:
(define (ferti-targets latest-measurement-hash latest-target-hash)
103
Removed:
`((h2 () "Dernière Cible") (table ((class "table"))
104
Removed:
(tr (th "Nutriment")
105
Removed:
(th ((class "text-end")) "Dernier Relevé")
106
Removed:
(th ((class "text-end")) "Dernière Cible"))
107
Removed:
,@(for/list ([n (get-nutrients)])
108
Removed:
(define latest-measurement
109
Removed:
(hash-ref latest-measurement-hash n #f))
110
Removed:
(define latest-target (hash-ref latest-target-hash n #f))
111
Removed:
`(tr (td ,(nutrient-french-name n))
112
Removed:
(td ((class "text-end font-monospace"))
113
Removed:
,(if latest-measurement
114
Removed:
(round 2 latest-measurement)
115
Removed:
"—"))
116
Removed:
(td ((class "text-end font-monospace"))
117
Removed:
,(if latest-target
118
Removed:
(round 2 latest-target)
119
Removed:
"—")))))))
98
Added:
(define (ferti-measurements-page nutrients measurements)
99
Added:
(define table
100
Added:
`(table ((class "table table-striped"))
101
Added:
(thead (tr (th "Date")
102
Added:
,@(for/list ([n nutrients])
103
Added:
`(th ((class "text-end")) ,(nutrient-formula n)))))
104
Added:
(tbody ,@
105
Added:
(for/list ([m measurements])
106
Added:
`(tr (td ,(nutrient-measurement-date m))
107
Added:
,@(for/list ([n nutrients])
108
Added:
(define nutrient-value (hash-ref (nutrient-measurement-values m) n #f))
109
Added:
`(td ((class "text-end"))
110
Added:
,(if nutrient-value
111
Added:
(round 2 nutrient-value)
112
Added:
"—"))))))))
113
Added:
(ferti-template `((h2 () "Relevés") (a ((class "btn btn-primary mb-3") [href "/measurement/new"])
114
Added:
"Ajouter un relevé")
115
Added:
,table)))
120
116
121
Removed:
(define (ferti-measurements measurements)
122
Removed:
`((h2 () "Relevés") (table ((class "table table-striped"))
123
Removed:
(tr (th "Date")
124
Removed:
(th ((class "text-end")) "N")
125
Removed:
(th ((class "text-end")) "P")
126
Removed:
(th ((class "text-end")) "K"))
127
Removed:
,@(for/list ([m measurements])
128
Removed:
(define measured-on (nutrient-measurement-date m))
129
Removed:
;; TODO: use new nutrient-value hash, available
130
Removed:
;; immediately in this context.
131
Removed:
(define-values (n p k)
132
Removed:
(apply values
133
Removed:
(for/list ([nutrient '("Nitrate Nitrogen" "Phosphorus"
134
Removed:
"Potassium")])
135
Removed:
(define n (get-nutrient #:name nutrient))
136
Removed:
(define mnv (get-nutrient-measurement-value m n))
137
Removed:
(if (real? mnv)
138
Removed:
(round 2 mnv)
139
Removed:
"—"))))
140
Removed:
`(tr (td ,measured-on)
141
Removed:
(td ((class "text-end font-monospace")) ,n)
142
Removed:
(td ((class "text-end font-monospace")) ,p)
143
Removed:
(td ((class "text-end font-monospace")) ,k))))))
117
Added:
(define (ferti-targets-page latest-measurement-hash latest-target-hash)
118
Added:
(define table
119
Added:
`(table ((class "table"))
120
Added:
(thead (tr (th "Nutriment")
121
Added:
(th ((class "text-end")) "Dernier Relevé")
122
Added:
(th ((class "text-end")) "Dernière Cible")))
123
Added:
(tbody ,@(for/list ([n (get-nutrients)])
124
Added:
(define latest-measurement (hash-ref latest-measurement-hash n #f))
125
Added:
(define latest-target (hash-ref latest-target-hash n #f))
126
Added:
`(tr (td ,(nutrient-french-name n))
127
Added:
(td ((class "text-end font-monospace"))
128
Added:
,(if latest-measurement
129
Added:
(round 2 latest-measurement)
130
Added:
"—"))
131
Added:
(td ((class "text-end font-monospace"))
132
Added:
,(if latest-target
133
Added:
(round 2 latest-target)
134
Added:
"—")))))))
135
Added:
(ferti-template `((h2 () "Dernière Cible") (a ((class "btn btn-primary mb-3") [href "/target/new"])
136
Added:
"Créer une cible")
137
Added:
,table)))
144
138
145
Removed:
(define (ferti-fertilizers)
146
Removed:
`((h2 () "Intrants") (table ((class "table table-striped"))
147
Removed:
(tr (th () "Nom de référence") (th () "Nom de marque"))
148
Removed:
,@(for/list ([fertilizer (get-fertilizer-products)])
149
Removed:
`(tr (td ,(fertilizer-name fertilizer))
150
Removed:
(td ,(or (fertilizer-brand-name fertilizer) "—")))))))
139
Added:
(define (ferti-recipe-page fertilizer-recipe)
140
Added:
(define table
141
Added:
`(table ((class "table"))
142
Added:
(thead (tr (th "Intrant") (th ((class "text-end")) "Quantité (g/L)")))
143
Added:
(tbody ,@(for/list ([fertilizer-amount fertilizer-recipe]
144
Added:
#:when (not (zero? (cdr fertilizer-amount))))
145
Added:
(match-define (cons fertilizer amount) fertilizer-amount)
146
Added:
`(tr (td ()
147
Added:
,(let ([canonical-name (fertilizer-name fertilizer)]
148
Added:
[brand-name (fertilizer-brand-name fertilizer)])
149
Added:
(if brand-name
150
Added:
(format "~a (~a)" brand-name canonical-name)
151
Added:
canonical-name)))
152
Added:
(td ((class "text-end font-monospace")) ,(round 2 amount)))))))
153
Added:
(ferti-template `((h2 () "Recette")
154
Added:
,(if (ormap (λ (pair) (not (zero? (cdr pair)))) fertilizer-recipe)
155
Added:
table
156
Added:
`(p "La recette Ferti requiert au moins un relevé et une cible.")))))
151
157
158
Added:
(define (ferti-fertilizers-page fertilizers)
159
Added:
(define table
160
Added:
`(table ((class "table table-striped"))
161
Added:
(tr (th () "Nom de référence") (th () "Nom de marque"))
162
Added:
,@(for/list ([fertilizer fertilizers])
163
Added:
`(tr (td ,(fertilizer-name fertilizer))
164
Added:
(td ,(or (fertilizer-brand-name fertilizer) "—"))))))
165
Added:
(ferti-template `((h2 () "Intrants") (a ((class "btn btn-primary mb-3") [href "/fertilizer/new"])
166
Added:
"Ajouter un intrant")
167
Added:
,table)))
168
Added:
152
169
(define (new-measurement-page)
153
170
(page-template "Nouveau relevé"
154
171
`((h1 ((class "display-1 mb-3")) "Nouveau relevé")
@@ -179,7 +196,7 @@
179
196
(if user
180
197
(user-name user)
181
198
"et bienvenue")))
182
Removed:
(a ((class "btn btn-primary mb-3") [href "/ferti"]) "Accéder à Ferti"))))
199
Added:
(a ((class "btn btn-primary mb-3") [href "/ferti/index"]) "Accéder à Ferti"))))
183
200
184
201
(define (fallback-page request-code)
185
202
(page-template (format "Réponse: ~a" request-code)