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
|
#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-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 (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 #: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 "")])))))
|
