1 #lang racket 2 3 (provide measurements-formlet 4 rotation-formlet 5 fertilizer-formlet 6 crop-formlet 7 crop-requirements-formlet) 8 9 (require gregor 10 web-server/formlets 11 "models/nutrient.rkt" 12 "models/nutrient-measurement.rkt" 13 "models/fertilizer-product.rkt" 14 "models/crop.rkt" 15 "models/crop-rotation.rkt" 16 "models/crop-requirement.rkt") 17 18 (define (measurements-formlet #:value [nm #f]) 19 (formlet* (#%# (=>* (to-string (required (hidden (if nm 20 (number->string (nutrient-measurement-id nm)) 21 "")))) 22 id*) 23 `(div ((class "mb-3")) 24 (h5 "Date du relevé") 25 ,(=>* (date-formlet #:value (if nm 26 (nutrient-measurement-date nm) 27 (date->iso8601 (today)))) 28 measurement-date*)) 29 `(div ((class "mb-3")) 30 (h5 "Valeurs du relevé") 31 ,@(for/list ([n (get-nutrients)]) 32 (define v 33 (if nm 34 (nutrient-measurement-value nm n) 35 0)) 36 (=>* (nutrient-value-formlet n v) nutrient-values*))) 37 {=>* (submit "Enregistrer le relevé" #:attributes '((class "btn btn-primary"))) _}) 38 (let ([id (first id*)] 39 [measurement-date (first measurement-date*)] 40 [nutrient-values (make-immutable-hash nutrient-values*)]) 41 (nutrient-measurement id measurement-date nutrient-values)))) 42 43 (define (rotation-formlet #:date [date-string #f]) 44 (formlet* (#%# `(div ((class "mb-3")) 45 (h5 "Date de l'assolement") 46 ,{=>* (date-formlet #:value date-string) rotation-date*}) 47 `(div ((class "mb-3")) 48 (h5 "Répartition des cultures (%)") 49 ,@(for/list ([requirement (get-crop-requirements)]) 50 {=>* (crop-requirement-formlet requirement) requirements*})) 51 {=>* (submit "Enregistrer la cible" #:attributes '((class "btn btn-primary"))) _}) 52 (let ([rotation-date (first rotation-date*)] 53 [requirement-proportions (make-immutable-hash requirements*)]) 54 (values rotation-date requirement-proportions)))) 55 56 (define (fertilizer-formlet #:value [fp #f]) 57 (formlet* (#%# (=>* (to-string (required (hidden (if fp 58 (number->string (fertilizer-product-id fp)) 59 "")))) 60 id*) 61 `(div ((class "mb-3")) 62 (h5 "Nom de référence") 63 ,(=>* (required-string-input #:value (if fp 64 (fertilizer-product-name fp) 65 "")) 66 canonical-name*)) 67 `(div ((class "mb-3")) 68 (h5 "Nom de marque") 69 ,(=>* (required-string-input #:value (if fp 70 (fertilizer-brand-name fp) 71 "")) 72 brand-name*)) 73 `(div ((class "mb-3")) 74 (h5 "Valeurs de l'intrant") 75 ,@(for/list ([n (get-nutrients)]) 76 (define v 77 (if fp 78 (fertilizer-product-value fp n) 79 0)) 80 (=>* (nutrient-value-formlet n v) nutrient-values*))) 81 (=>* (submit (string-join (list (if fp "Modifier" "Enregistrer") "l'intrant")) 82 #:attributes '((class "btn btn-primary"))) 83 _)) 84 (let ([id (string->number (first id*))] 85 [canonical-name (first canonical-name*)] 86 [brand-name (first brand-name*)] 87 [nutrient-values (make-immutable-hash nutrient-values*)]) 88 (fertilizer-product id canonical-name brand-name nutrient-values)))) 89 90 (define (crop-formlet #:value [c #f]) 91 (formlet* (#%# (=>* (to-string (required (hidden (if c 92 (number->string (crop-id c)) 93 "")))) 94 id*) 95 `(div ((class "mb-3")) 96 (h5 "Culture") 97 ,(=>* (required-string-input #:value (if c 98 (crop-name c) 99 "")) 100 crop-name*)) 101 (=>* (submit (string-join (list (if c "Modifier" "Enregistrer") "la culture")) 102 #:attributes '((class "btn btn-primary"))) 103 _)) 104 (let ([id (string->number (first id*))] 105 [crop-name (first crop-name*)]) 106 (crop id crop-name)))) 107 108 (define (crop-requirements-formlet #:value [cr #f]) 109 (formlet* (#%# (=>* (to-string (required (hidden (if cr 110 (number->string (crop-requirement-id cr)) 111 "")))) 112 id*) 113 `(div ((class "mb-3")) 114 (h5 "Profil de culture") 115 ,(=>* (required-string-input #:value (if cr 116 (crop-requirement-profile cr) 117 "")) 118 profile*)) 119 `(div ((class "mb-3")) 120 (h5 "Culture associée") 121 ,(=>* (select-input (cons (crop #f "<aucune>") (get-crops)) 122 #:attributes '((class "form-select")) 123 #:display crop-name) 124 crop*)) 125 `(div ((class "mb-3")) 126 (h5 "Valeurs du profil") 127 ,@(for/list ([n (get-nutrients)]) 128 (define v 129 (if cr 130 (crop-requirement-value cr n) 131 0)) 132 (=>* (nutrient-value-formlet n v) nutrient-values*))) 133 (=>* (submit (string-join (list (if cr "Modifier" "Enregistrer") "l'intrant")) 134 #:attributes '((class "btn btn-primary"))) 135 _)) 136 (let ([id (string->number (first id*))] 137 [profile (first profile*)] 138 [crop-id (crop-id (first crop*))] 139 [nutrient-values (make-immutable-hash nutrient-values*)]) 140 (crop-requirement id profile crop-id nutrient-values)))) 141 142 (define (crop-requirement-formlet requirement) 143 (define id (number->string (crop-requirement-id requirement))) 144 (define profile (crop-requirement-profile requirement)) 145 (define maybe-crop (crop-requirement-crop-id requirement)) 146 (define crop 147 (if maybe-crop 148 (crop-name (get-crop #:id maybe-crop)) 149 #f)) 150 (define percentage-input 151 (to-number (to-string (required (input #:type "number" 152 #:attributes 153 `((class "form-control") [required "required"] 154 [id ,id] 155 [name ,id] 156 [min "0"] 157 [max "100"] 158 [step "1"] 159 [placeholder ,profile])))))) 160 (define input-label 161 `(label ((for ,id 162 )) 163 ,(if crop 164 (format "~a (~a)" crop profile) 165 (format "~a" profile)))) 166 (formlet 167 (div ((class "form-floating mb-3")) ,{=> percentage-input requirement-percentage} ,input-label) 168 (cons requirement requirement-percentage))) 169 170 (define (date-formlet #:value [date-string #f]) 171 (to-string (required (input #:type "date" 172 #:value (or date-string (date->iso8601 (today))) 173 #:attributes '((class "form-control") [required "required"]))))) 174 175 (define (nutrient-value-formlet nutrient value) 176 (define id (number->string (nutrient-id nutrient))) 177 (define number-input 178 (to-number (to-string (required (input #:type "number" 179 #:attributes 180 `((class "form-control") 181 [required "required"] 182 [id ,id] 183 [name ,id] 184 [value ,(number->string value)] 185 [placeholder ,(nutrient-french-name nutrient)])))))) 186 (define input-label 187 `(label ((for ,id 188 )) 189 ,(nutrient-french-name nutrient))) 190 (formlet (div ((class "form-floating mb-3")) ,{=> number-input nutrient-value} ,input-label) 191 (cons nutrient nutrient-value))) 192 193 (define (required-string-input #:value [str #f]) 194 (to-string (required (text-input #:attributes `((class "form-control") [required "required"] 195 [value ,(or str "")]))))) 196