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
|
#lang racket
(provide measurements-formlet
rotation-formlet
fertilizer-formlet)
(require gregor
web-server/formlets
"models/nutrient.rkt"
"models/nutrient-measurement.rkt"
"models/fertilizer-product.rkt"
"models/crop.rkt"
"models/crop-requirement.rkt")
(define (measurements-formlet)
(formlet* (#%# `(div ((class "mb-3")) (h5 "Date du relevé") ,{=>* (date-formlet) measurement-date*})
`(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"))) _})
(values measurement-date nutrient-values))))
(let ([id (first id*)]
[measurement-date (first measurement-date*)]
[nutrient-values (make-immutable-hash nutrient-values*)])
(define (rotation-formlet #:date [date-string #f])
(formlet* (#%# `(div ((class "mb-3"))
(h5 "Date de l'assolement")
,{=>* (date-formlet #:date 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 (for/hash ([nv nutrient-values*])
(values (car nv) (cdr nv)))])
(fertilizer-product id 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 #:date [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)]
[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 #:value [str #f])
(to-string (required (text-input #:attributes `((class "form-control") [required "required"]
[value ,(or str "")])))))
|
