1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
|
#lang racket
(provide measurements-formlet
targets-formlet
fertilizer-formlet)
(require gregor
web-server/formlets
"models/nutrient.rkt"
"models/crop.rkt"
"models/crop-requirement.rkt")
(define (measurements-formlet)
(formlet* (#%# `(div ((class "mb-3")) (h5 "Date du relevé") ,{=>* date-formlet measured-on*})
`(div ((class "mb-3"))
(h5 "Valeurs du relevé")
,@(for/list ([nutrient (get-nutrients)])
{=>* (nutrient-value-formlet nutrient) nutrient-values*}))
{=>* (submit "Enregistrer le relevé" #:attributes '((class "btn btn-primary"))) _})
(let ([measured-on (first measured-on*)]
[nutrient-values (for/hash ([nv nutrient-values*])
(values (car nv) (cdr nv)))])
(values measured-on nutrient-values))))
(define (targets-formlet)
(formlet* (#%# `(div ((class "mb-3")) (h5 "Date ciblée") ,{=>* date-formlet effective-on*})
`(div ((class "mb-3"))
(h5 "Valeurs cibles (%)")
,@(for/list ([requirement (get-crop-requirements)])
{=>* (crop-requirement-formlet requirement) requirements*}))
{=>* (submit "Enregistrer la cible" #:attributes '((class "btn btn-primary"))) _})
(let ([effective-on (first effective-on*)]
[nutrient-values (average-crop-requirement-nutrient-values (filter pair?
requirements*))])
(values effective-on nutrient-values))))
(define (fertilizer-formlet)
(formlet*
(#%# `(div ((class "mb-3")) (h5 "Nom de référence") ,{=>* required-string-input canonical-name*})
`(div ((class "mb-3")) (h5 "Nom de marque") ,{=>* required-string-input brand-name*})
`(div ((class "mb-3"))
(h5 "Valeurs de l'intrant")
,@(for/list ([nutrient (get-nutrients)])
{=>* (nutrient-value-formlet nutrient) nutrient-values*}))
{=>* (submit "Enregistrer l'intrant" #:attributes '((class "btn btn-primary"))) _})
(let ([canonical-name (first canonical-name*)]
[nutrient-values (for/hash ([nv nutrient-values*])
(values (car nv) (cdr nv)))]
[brand-name (first brand-name*)])
(values canonical-name brand-name nutrient-values))))
(define (crop-requirement-formlet requirement)
(define id (number->string (crop-requirement-id requirement)))
(define profile (crop-requirement-profile requirement))
(define maybe-crop (crop-requirement-crop-id requirement))
(define crop
(if maybe-crop
(crop-name (get-crop #:id maybe-crop))
#f))
(define percentage-input
(to-number (to-string (required (input #:type "number"
#:attributes
`((class "form-control") [required "required"]
[id ,id]
[name ,id]
[min "0"]
[max "100"]
[step "1"]
[placeholder ,profile]))))))
(define input-label
`(label ((for ,id
))
,(if crop
(format "~a (~a)" crop profile)
(format "~a" profile))))
(formlet
(div ((class "form-floating mb-3")) ,{=> percentage-input requirement-percentage} ,input-label)
(cons requirement requirement-percentage)))
(define date-formlet
(to-string (required (input #:type "date"
#:value (date->iso8601 (today))
#:attributes '((class "form-control") [required "required"])))))
(define (nutrient-value-formlet nutrient)
(define id (number->string (nutrient-id nutrient)))
(define number-input
(to-number (to-string (required (input #:type "number"
#:attributes
`((class "form-control")
[required "required"]
[id ,id]
[name ,id]
[step "0.1"]
[placeholder ,(nutrient-french-name nutrient)]))))))
(define input-label
`(label ((for ,id
))
,(nutrient-french-name nutrient)))
(formlet (div ((class "form-floating mb-3")) ,{=> number-input nutrient-value} ,input-label)
(cons nutrient nutrient-value)))
(define required-string-input
(to-string (required (text-input #:attributes '((class "form-control") [required "required"])))))
|
