Added views, formlets, and handlers for nutrient target management.

Commit
86b5343292e852155dab10fc8db39c2dd2b932eb
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
formlets.rkt
index 406a54a2..d0067e36 100644..100644
@@ -1,11 +1,14 @@
1 1 #lang racket
2 2
3 Removed: (provide measurements-formlet)
3 Added: (provide measurements-formlet
4 Added: targets-formlet)
4 5
5 6 (require gregor
6 7 web-server/http
7 8 web-server/formlets
8 Removed: "models/nutrient.rkt")
9 Added: "models/nutrient.rkt"
10 Added: "models/crop.rkt"
11 Added: "models/crop-requirement.rkt")
9 12
10 13
11 14 (define date-formlet
@@ -26,7 +29,7 @@
26 29 [id ,(number->string id)]
27 30 [step "0.1"]
28 31 [placeholder ,(nutrient-name nutrient)])))
29 Removed: (define input-label `(label ((for ,(number->string id))) ,(nutrient-name nutrient)))
32 Added: (define input-label `(label ([for ,(number->string id)]) ,(nutrient-name nutrient)))
30 33 (formlet
31 34 (#%#
32 35 (div ([class "form-floating mb-3"])
@@ -51,3 +54,43 @@
51 54 (let ([measured-on (first measured-on*)]
52 55 [measurements (filter pair? measurements*)]) ; drop #f’s from empty values
53 56 (values measured-on measurements))))
57 Added:
58 Added: (define (crop-requirement-formlet requirement)
59 Added: (define id (crop-requirement-id requirement))
60 Added: (define profile (crop-requirement-profile requirement))
61 Added: (define maybe-crop (crop-requirement-crop-id requirement))
62 Added: (define crop (if maybe-crop (crop-name (get-crop #:id maybe-crop)) #f))
63 Added: (define number-input
64 Added: (input #:type "number"
65 Added: #:attributes `([class "form-control"]
66 Added: [id ,(number->string id)]
67 Added: [step "1"]
68 Added: [placeholder ,profile])))
69 Added: (define input-label `(label ([for ,(number->string id)])
70 Added: ,(if crop
71 Added: (format "~a (~a)" crop profile)
72 Added: (format "~a" profile))))
73 Added: (formlet
74 Added: (#%#
75 Added: (div ([class "form-floating mb-3"])
76 Added: ,{=> number-input requirement-proportion-b}
77 Added: ,input-label))
78 Added: (let ([requirement-proportion (string->number
79 Added: (bytes->string/utf-8
80 Added: (binding:form-value requirement-proportion-b)))])
81 Added: (and requirement-proportion (cons requirement requirement-proportion)))))
82 Added:
83 Added: (define (targets-formlet)
84 Added: (formlet*
85 Added: (#%#
86 Added: `(div ([class "mb-3"])
87 Added: (h5 "Date ciblée")
88 Added: ,{=>* date-formlet effective-on*})
89 Added: `(div ([class "mb-3"])
90 Added: (h5 "Valeurs cibles")
91 Added: ,@(for/list ([requirement (get-crop-requirements)])
92 Added: {=>* (crop-requirement-formlet requirement) requirements*}))
93 Added: {=>* (submit "Enregistrer la cible" #:attributes '([class "btn btn-primary"])) _})
94 Added: (let ([effective-on (first effective-on*)]
95 Added: [requirements (filter pair? requirements*)]) ; drop #f’s from empty values
96 Added: (values effective-on requirements))))
handlers.rkt
index 42e4a765..aa380aac 100644..100644
@@ -8,8 +8,22 @@
8 8 "views.rkt"
9 9 "formlets.rkt"
10 10 "models/nutrient.rkt"
11 Removed: "models/nutrient-measurement.rkt")
11 Added: "models/nutrient-measurement.rkt"
12 Added: "models/nutrient-target.rkt"
13 Added: "models/crop-requirement.rkt")
12 14
15 Added: (define-values (app-dispatch _)
16 Added: (dispatch-rules
17 Added: ;; Nutrient measurements
18 Added: [("measurement" "new") #:method "get" new-measurement]
19 Added: [("measurement" "create") #:method "post" create-measurement]
20 Added: [("measurement" "destroy") #:method "post" destroy-measurement]
21 Added: ;; Nutrient targets
22 Added: [("target" "new") #:method "get" new-target]
23 Added: [("target" "create") #:method "post" create-target]
24 Added: ;; Index
25 Added: [("") #:method "get" index]
26 Added: [else fallback]))
13 27
14 28 (define (index _)
15 29 (define measurements (get-nutrient-measurements))
@@ -17,6 +31,9 @@
17 31 #:preamble #"<!DOCTYPE html>"
18 32 (index-page measurements)))
19 33
34 Added:
35 Added: ;; Nutrient measurements
36 Added:
20 37 (define (new-measurement _)
21 38 (response/xexpr
22 39 #:preamble #"<!DOCTYPE html>"
@@ -29,20 +46,42 @@
29 46 (redirect-to "/"))
30 47
31 48 (define (destroy-measurement req)
32 Removed: (define-values (measured-on measurements)
33 Removed: (formlet-process (measurements-formlet) req))
34 Removed: (create-nutrient-measurement! measured-on measurements)
49 Added: (delete-nutrient-measurement! req)
35 50 (redirect-to "/"))
36 51
37 Removed: (define (fallback req)
52 Added:
53 Added: ;; Nutrient targets
54 Added:
55 Added: (define (new-target _)
38 56 (response/xexpr
39 57 #:preamble #"<!DOCTYPE html>"
40 Removed: (fallback-page 404)))
58 Added: (new-target-page)))
41 59
42 Removed: (define-values (app-dispatch app-url)
43 Removed: (dispatch-rules
44 Removed: [("measurement" "new") #:method "get" new-measurement]
45 Removed: [("measurement" "create") #:method "post" create-measurement]
46 Removed: [("measurement" "destroy") #:method "post" destroy-measurement]
47 Removed: [("") #:method "get" index]
48 Removed: [else fallback]))
60 Added: (define (create-target req)
61 Added: (define-values (effective-on crop-requirement-mix)
62 Added: (formlet-process (targets-formlet) req))
63 Added:
64 Added: (define (average-nutrient-values mix)
65 Added: (define totals
66 Added: (for/fold ([acc (hash)]) ([pair (in-list mix)])
67 Added: (define crop-requirement (car pair))
68 Added: (define percentage (/ (cdr pair) 100))
69 Added: (for/fold ([acc acc])
70 Added: ([nv (in-list (get-crop-requirement-values crop-requirement))])
71 Added: (define n (car nv))
72 Added: (define v (cdr nv))
73 Added: (hash-update acc n
74 Added: (λ (old) (+ old (* v percentage)))
75 Added: (λ () (* v percentage))))))
76 Added: (for/list ([(k v) (in-hash totals)])
77 Added: (cons k v)))
78 Added:
79 Added: (define target-nutrient-values (average-nutrient-values crop-requirement-mix))
80 Added: (pretty-display target-nutrient-values)
81 Added: (create-nutrient-target! effective-on target-nutrient-values)
82 Added: (redirect-to "/"))
83 Added:
84 Added: (define (fallback _)
85 Added: (response/xexpr
86 Added: #:preamble #"<!DOCTYPE html>"
87 Added: (fallback-page 404)))
views.rkt
index d78c3705..12b5d1ac 100644..100644
@@ -2,12 +2,14 @@
2 2
3 3 (provide index-page
4 4 new-measurement-page
5 Added: new-target-page
5 6 fallback-page)
6 7
7 8 (require web-server/formlets
8 9 "formlets.rkt"
9 10 "models/nutrient.rkt"
10 Removed: "models/nutrient-measurement.rkt")
11 Added: "models/nutrient-measurement.rkt"
12 Added: "models/nutrient-target.rkt")
11 13
12 14
13 15 (define (page-template title body-xexpr)
@@ -77,19 +79,26 @@
77 79 (a ([class "btn btn-primary mb-3"] [href "/target/new"]) "Créer une cible")
78 80 (table ([class "table"])
79 81 (tr (th "Nutriment")
80 Removed: (th ([class "text-end"]) "Dernière Cible")
81 82 (th ([class "text-end"]) "Dernier Relevé")
83 Added: (th ([class "text-end"]) "Dernière Cible")
82 84 (th ([class "text-end"]) "Delta (%)"))
83 85 ,@(for/list ([n (get-nutrients)])
84 Removed: (define latest-target (+ (get-latest-nutrient-measurement-value n) 1))
85 Removed: (define latest-value (get-latest-nutrient-measurement-value n))
86 Removed: (define delta (* 100
87 Removed: (/ (- latest-target latest-value)
88 Removed: latest-target)))
86 Added: (define latest-target (get-latest-nutrient-target-value n))
87 Added: (define latest-measurement (get-latest-nutrient-measurement-value n))
88 Added: (define delta-percentage (cond
89 Added: [(zero? latest-target)
90 Added: -100]
91 Added: [(zero? latest-measurement)
92 Added: 100]
93 Added: [(number? latest-target)
94 Added: (* 100
95 Added: (/ (- latest-target latest-measurement)
96 Added: latest-measurement))]
97 Added: [else #f]))
89 98 `(tr (td ,(nutrient-name n))
90 Removed: (td ([class "text-end"]) ,(round 2 latest-target))
91 Removed: (td ([class "text-end"]) ,(round 2 latest-value))
92 Removed: (td ([class "text-end"]) ,(round 1 delta)))))
99 Added: (td ([class "text-end"]) ,(if latest-measurement (round 2 latest-measurement) "—"))
100 Added: (td ([class "text-end"]) ,(if latest-target (round 2 latest-target) "—"))
101 Added: (td ([class "text-end"]) ,(if delta-percentage (round 1 delta-percentage) "—")))))
93 102
94 103 (a ([class "btn btn-primary mb-3"] [href "/measurement/new"]) "Ajouter un relevé")
95 104 (table ([class "table table-striped"])
@@ -121,6 +130,16 @@
121 130 ([action "/measurement/create"]
122 131 [method "POST"])
123 132 ,@(formlet-display (measurements-formlet)))))))
133 Added:
134 Added: (define (new-target-page)
135 Added: (page-template
136 Added: "Nouvelle cible"
137 Added: `((h1 ([class "display-1 mb-3"]) "Nouvelle cible")
138 Added: (div ([class "mb-3"] [style "max-width: 30em"])
139 Added: (form
140 Added: ([action "/target/create"]
141 Added: [method "POST"])
142 Added: ,@(formlet-display (targets-formlet)))))))
124 143
125 144 (define (fallback-page request-code)
126 145 (page-template