Add fertilizer product creation logic.

Commit
5408b445776234c35fb61374d2d3abc6b83b2904
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
formlets.rkt
index f24c84f7..6ae4551e 100644..100644
@@ -1,7 +1,8 @@
1 1 #lang racket
2 2
3 3 (provide measurements-formlet
4 Removed: targets-formlet)
4 Added: targets-formlet
5 Added: fertilizer-formlet)
5 6
6 7 (require gregor
7 8 web-server/http
@@ -19,7 +20,7 @@
19 20 date-b}
20 21 date-b))
21 22
22 Removed: (define (measurement-formlet nutrient)
23 Added: (define (nutrient-value-formlet nutrient)
23 24 (define id (nutrient-id nutrient))
24 25 (define number-input
25 26 (input #:type "number"
@@ -40,7 +41,7 @@
40 41 `(div ((class "mb-3"))
41 42 (h5 "Valeurs du relevé")
42 43 ,@(for/list ([nutrient (get-nutrients)])
43 Removed: {=>* (measurement-formlet nutrient) measurements*}))
44 Added: {=>* (nutrient-value-formlet nutrient) measurements*}))
44 45 {=>* (submit "Enregistrer le relevé" #:attributes '((class "btn btn-primary"))) _})
45 46 (let ([measured-on (first measured-on*)]
46 47 [nutrient-values (for/hash ([nv (in-list (filter pair? measurements*))])
@@ -85,3 +86,22 @@
85 86 [nutrient-values (average-crop-requirement-nutrient-values (filter pair?
86 87 requirements*))])
87 88 (values effective-on nutrient-values))))
89 Added:
90 Added: (define (name-formlet)
91 Added: (define string-input (input #:type "string" #:attributes `((class "form-control"))))
92 Added: (formlet (#%# (div ((class "mb-3")) ,{=> string-input string-value-b}))
93 Added: (bytes->string/utf-8 (binding:form-value string-value-b))))
94 Added:
95 Added: (define (fertilizer-formlet)
96 Added: (formlet* (#%# `(div ((class "mb-3")) (h5 "Nom de référence") ,{=>* (name-formlet) canonical-name*})
97 Added: `(div ((class "mb-3")) (h5 "Nom de marque") ,{=>* (name-formlet) brand-name*})
98 Added: `(div ((class "mb-3"))
99 Added: (h5 "Valeurs de l'intrant")
100 Added: ,@(for/list ([nutrient (get-nutrients)])
101 Added: {=>* (nutrient-value-formlet nutrient) nutrient-values*}))
102 Added: {=>* (submit "Enregistrer l'intrant" #:attributes '((class "btn btn-primary"))) _})
103 Added: (let ([canonical-name (first canonical-name*)]
104 Added: [nutrient-values (for/hash ([nv (filter pair? nutrient-values*)])
105 Added: (values (car nv) (cdr nv)))]
106 Added: [brand-name (first brand-name*)])
107 Added: (values canonical-name nutrient-values brand-name))))
handlers.rkt
index c022c3c8..fb3f8647 100644..100644
@@ -11,6 +11,7 @@
11 11 "models/user.rkt"
12 12 "models/nutrient-measurement.rkt"
13 13 "models/nutrient-target.rkt"
14 Added: "models/fertilizer-product.rkt"
14 15 "services/nnls.rkt")
15 16
16 17 (define (wrap-basic-auth handler)
@@ -34,6 +35,8 @@
34 35 [("measurement" "destroy") #:method "post" destroy-measurement]
35 36 [("target" "new") #:method "get" new-target]
36 37 [("target" "create") #:method "post" create-target]
38 Added: [("fertilizer" "new") #:method "get" new-fertilizer]
39 Added: [("fertilizer" "create") #:method "post" create-fertilizer]
37 40 [("") #:method "get" index]
38 41 [else fallback]))
39 42
@@ -73,6 +76,19 @@
73 76 (define-values (effective-on nutrient-values) (formlet-process (targets-formlet) req))
74 77 (create-nutrient-target! effective-on nutrient-values)
75 78 (redirect-to "/ferti"))
79 Added:
80 Added: ;; Fertilizer products
81 Added:
82 Added: (define (new-fertilizer _)
83 Added: (response/xexpr #:preamble #"<!DOCTYPE html>" (new-fertilizer-page)))
84 Added:
85 Added: (define (create-fertilizer req)
86 Added: (define-values (canonical-name nutrient-values brand-name)
87 Added: (formlet-process (fertilizer-formlet) req))
88 Added: (create-fertilizer-product! canonical-name nutrient-values brand-name)
89 Added: (redirect-to "/ferti"))
90 Added:
91 Added: ;; Fallback
76 92
77 93 (define (fallback _)
78 94 (response/xexpr #:preamble #"<!DOCTYPE html>" (fallback-page 404)))
views.rkt
index 9323896d..00af4b68 100644..100644
@@ -4,6 +4,7 @@
4 4 ferti-page
5 5 new-measurement-page
6 6 new-target-page
7 Added: new-fertilizer-page
7 8 fallback-page)
8 9
9 10 (require gregor
@@ -12,7 +13,6 @@
12 13 "models/user.rkt"
13 14 "models/nutrient.rkt"
14 15 "models/nutrient-measurement.rkt"
15 Removed: "models/nutrient-target.rkt"
16 16 "models/fertilizer-product.rkt")
17 17
18 18 (define (page-template title body-xexpr)
@@ -71,10 +71,19 @@
71 71 (page-template
72 72 "Ferti"
73 73 `((h1 ((class "display-1 mb-3")) "Ferti")
74 Added: ,ferti-actions
74 75 ,@(ferti-recipe fertilizer-recipe)
75 76 ,@(ferti-targets latest-measurement-hash latest-target-hash)
76 Removed: ,@(ferti-measurements measurements))))
77 Added: ,@(ferti-measurements measurements)
78 Added: ,@(ferti-fertilizers))))
77 79
80 Added: (define ferti-actions
81 Added: `(div ((class "btn-group mb-3"))
82 Added: (a ((class "btn btn-outline-primary") [href "/target/new"]) "Créer une cible")
83 Added: (a ((class "btn btn-outline-primary") [href "/measurement/new"]) "Ajouter un relevé")
84 Added: (a ((class "btn btn-outline-primary") [href "/fertilizer/new"]) "Ajouter un intrant")))
85 Added:
86 Added:
78 87 (define (ferti-recipe ferti-recipe)
79 88 `((h2 () "Recette")
80 89 ,(if (ormap (λ (pair) (not (zero? (cdr pair)))) ferti-recipe)
@@ -89,7 +98,6 @@
89 98
90 99 (define (ferti-targets latest-measurement-hash latest-target-hash)
91 100 `((h2 () "Dernière Cible")
92 Removed: (a ((class "btn btn-primary mb-3") [href "/target/new"]) "Créer une cible")
93 101 (table ((class "table"))
94 102 (tr (th "Nutriment")
95 103 (th ((class "text-end")) "Dernier Relevé")
@@ -121,7 +129,6 @@
121 129
122 130 (define (ferti-measurements measurements)
123 131 `((h2 () "Relevés")
124 Removed: (a ((class "btn btn-primary mb-3") [href "/measurement/new"]) "Ajouter un relevé")
125 132 (table ((class "table table-striped"))
126 133 (tr (th "Date")
127 134 (th ((class "text-end")) "N")
@@ -142,6 +149,15 @@
142 149 (td ((class "text-end font-monospace")) ,p)
143 150 (td ((class "text-end font-monospace")) ,k))))))
144 151
152 Added: (define (ferti-fertilizers)
153 Added: `((h2 () "Intrants")
154 Added: (table ((class "table table-striped"))
155 Added: (tr (th () "Nom de référence")
156 Added: (th () "Nom de marque"))
157 Added: ,@(for/list ([fertilizer (get-fertilizer-products)])
158 Added: `(tr (td ,(fertilizer-name fertilizer))
159 Added: (td ,(or (fertilizer-brand-name fertilizer) "—")))))))
160 Added:
145 161 (define (new-measurement-page)
146 162 (page-template "Nouveau relevé"
147 163 `((h1 ((class "display-1 mb-3")) "Nouveau relevé")
@@ -155,6 +171,13 @@
155 171 (div ((class "mb-3") [style "max-width: 30em"])
156 172 (form ([action "/target/create"] [method "POST"])
157 173 ,@(formlet-display (targets-formlet)))))))
174 Added:
175 Added: (define (new-fertilizer-page)
176 Added: (page-template "Nouvel intrant"
177 Added: `((h1 ((class "display-1 mb-3")) "Nouvel intrant")
178 Added: (div ((class "mb-3") [style "max-width: 30em"])
179 Added: (form ([action "/fertilizer/create"] [method "POST"])
180 Added: ,@(formlet-display (fertilizer-formlet)))))))
158 181
159 182 (define (index-page user)
160 183 (page-template