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
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
#lang racket
(provide measurements-formlet
rotation-formlet
fertilizer-formlet
crop-requirements-formlet)
(require gregor
web-server/formlets
"models/nutrient.rkt"
"models/nutrient-measurement.rkt"
"models/fertilizer-product.rkt"
"models/crop.rkt"
"models/crop-rotation.rkt"
"models/crop-requirement.rkt")
(define (measurements-formlet #:value [nm #f])
(formlet* (#%# (=>* (to-string (required (hidden (if nm
(number->string (nutrient-measurement-id nm))
""))))
id*)
`(div ((class "mb-3"))
(h5 "Date du relevé")
,(=>* (date-formlet #:value (if nm
(nutrient-measurement-date nm)
(date->iso8601 (today))))
measurement-date*))
`(div ((class "mb-3"))
(h5 "Valeurs du relevé")
,@(for/list ([n (get-nutrients)])
(define v
(if nm
(nutrient-measurement-value nm n)
0))
(=>* (nutrient-value-formlet n v) nutrient-values*)))
{=>* (submit "Enregistrer le relevé" #:attributes '((class "btn btn-primary"))) _})
(let ([id (first id*)]
[measurement-date (first measurement-date*)]
[nutrient-values (make-immutable-hash nutrient-values*)])
(nutrient-measurement id measurement-date nutrient-values))))
(define (rotation-formlet #:date [date-string #f])
(formlet* (#%# `(div ((class "mb-3"))
(h5 "Date de l'assolement")
,{=>* (date-formlet #:value date-string) rotation-date*})
`(div ((class "mb-3"))
(h5 "Répartition des cultures (%)")
,@(for/list ([requirement (get-crop-requirements)])
{=>* (crop-requirement-formlet requirement) requirements*}))
{=>* (submit "Enregistrer la cible" #:attributes '((class "btn btn-primary"))) _})
(let ([rotation-date (first rotation-date*)]
[requirement-proportions (make-immutable-hash requirements*)])
(values rotation-date requirement-proportions))))
(define (fertilizer-formlet #:value [fp #f])
(formlet* (#%# (=>* (to-string (required (hidden (if fp
(number->string (fertilizer-product-id fp))
""))))
id*)
`(div ((class "mb-3"))
(h5 "Nom de référence")
,(=>* (required-string-input #:value (if fp
(fertilizer-product-name fp)
""))
canonical-name*))
`(div ((class "mb-3"))
(h5 "Nom de marque")
,(=>* (required-string-input #:value (if fp
(fertilizer-brand-name fp)
""))
brand-name*))
`(div ((class "mb-3"))
(h5 "Valeurs de l'intrant")
,@(for/list ([n (get-nutrients)])
(define v
(if fp
(fertilizer-product-value fp n)
0))
(=>* (nutrient-value-formlet n v) nutrient-values*)))
(=>* (submit (string-join (list (if fp "Modifier" "Enregistrer") "l'intrant"))
#:attributes '((class "btn btn-primary")))
_))
(let ([id (string->number (first id*))]
[canonical-name (first canonical-name*)]
[brand-name (first brand-name*)]
[nutrient-values (make-immutable-hash nutrient-values*)])
(fertilizer-product id canonical-name brand-name nutrient-values))))
(define (crop-requirements-formlet #:value [cr #f])
(formlet* (#%# (=>* (to-string (required (hidden (if cr
(number->string (crop-requirement-id cr))
""))))
id*)
`(div ((class "mb-3"))
(h5 "Profil de culture")
,(=>* (required-string-input #:value (if cr
(crop-requirement-profile cr)
""))
profile*))
`(div ((class "mb-3"))
(h5 "Culture associée")
,(=>* (select-input (cons (crop #f "<aucune>") (get-crops))
#:attributes '((class "form-select"))
#:display crop-name)
crop*))
`(div ((class "mb-3"))
(h5 "Valeurs du profil")
,@(for/list ([n (get-nutrients)])
(define v
(if cr
(crop-requirement-value cr n)
0))
(=>* (nutrient-value-formlet n v) nutrient-values*)))
(=>* (submit (string-join (list (if cr "Modifier" "Enregistrer") "l'intrant"))
#:attributes '((class "btn btn-primary")))
_))
(let ([id (string->number (first id*))]
[profile (first profile*)]
[crop-id (crop-id (first crop*))]
[nutrient-values (make-immutable-hash nutrient-values*)])
(crop-requirement id profile crop-id 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 #:value [date-string #f])
(to-string (required (input #:type "date"
#:value (or date-string (date->iso8601 (today)))
#:attributes '((class "form-control") [required "required"])))))
(define (nutrient-value-formlet nutrient value)
(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]
[value ,(number->string value)]
[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 #:value [str #f])
(to-string (required (text-input #:attributes `((class "form-control") [required "required"]
[value ,(or str "")])))))
|
