1 #lang racket 2 3 (provide index-page 4 ferti-index-page 5 ferti-measurements-and-rotations-page 6 ferti-recipe-page 7 ferti-fertilizers-page 8 ferti-crop-requirements-page 9 new-measurement-page 10 new-rotation-page 11 new-fertilizer-page 12 new-crop-page 13 new-crop-requirement-page 14 edit-measurement-page 15 edit-fertilizer-page 16 edit-crop-page 17 edit-crop-requirement-page 18 show-measurement-page 19 show-rotation-page 20 show-fertilizer-page 21 show-crop-page 22 show-crop-requirement-page 23 fallback-page) 24 25 (require gregor 26 web-server/formlets 27 "formlets.rkt" 28 "models/user.rkt" 29 "models/nutrient.rkt" 30 "models/nutrient-value.rkt" 31 "models/nutrient-measurement.rkt" 32 "models/crop.rkt" 33 "models/crop-rotation.rkt" 34 "models/crop-requirement.rkt" 35 "models/fertilizer-product.rkt") 36 37 (define (page-template title body-xexpr) 38 `(html (head (meta ([charset "utf-8"])) 39 (meta ([name "viewport"] [content "width=device-width, initial-scale=1"])) 40 (title ,title) 41 ;; Bootstrap CSS 42 (link ([href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/css/bootstrap.min.css"] 43 [rel "stylesheet"] 44 [integrity 45 "sha384-QWTKZyjpPEjISv5WaRU9OFeRpok6YctnYmDr5pNlyT2bRjXh0JMhjY6hW+ALEwIH"] 46 [crossorigin "anonymous"]))) 47 (body ,navbar 48 (div ((class "container")) ,@body-xexpr) 49 ;; Bootstrap JS bundle 50 (script 51 ([src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/js/bootstrap.bundle.min.js"] 52 [integrity "sha384-YvpcrYf0tY3lHB60NNkmXc5s9fDVZLESaAA55NDzOxhy9GkcIdslK1eN7N6jIeHz"] 53 [crossorigin "anonymous"]))))) 54 55 ;; Page components 56 57 (define navbar 58 '(nav 59 ((class "navbar navbar-expand-lg navbar-light bg-light")) 60 (div 61 ((class "container-fluid")) 62 (a ((class "navbar-brand") [href "/"]) "FAPG") 63 (button ((class "navbar-toggler") [type "button"] 64 [data-bs-toggle "collapse"] 65 [data-bs-target "#navbarSupportedContent"] 66 [aria-controls "navbarSupportedContent"] 67 [aria-expanded "false"] 68 [aria-label "Toggle navigation"]) 69 (span ((class "navbar-toggler-icon")))) 70 (div ((class "collapse navbar-collapse") [id "navbarSupportedContent"]) 71 (ul ((class "navbar-nav me-auto mb-2 mb-lg-0")) 72 (li ((class "nav-item")) 73 (a ((class "nav-link disabled") [href "#"] [tabindex "-1"] [aria-disabled "true"]) 74 "Facturation Pro")) 75 (li ((class "nav-item")) 76 (a ((class "nav-link active") [aria-current "page"] [href "/ferti/index"]) "Ferti")) 77 (li ((class "nav-item")) 78 (a ((class "nav-link disabled") [href "#"] [tabindex "-1"] [aria-disabled "true"]) 79 "Inventaire")) 80 (li ((class "nav-item")) (a ((class "nav-link") [href "/contact"]) "Contact"))))))) 81 82 ;; Page helpers 83 84 (define (round n number) 85 (~r number #:precision `(= ,n))) 86 87 (define (normal-date date-string) 88 (~t (iso8601->date date-string) "dd/MM/yyyy")) 89 90 ;; Ferti 91 92 (define (ferti-template active-tab body-xexpr) 93 (page-template (format "Ferti — ~a" active-tab) `(,(ferti-tabs-bar active-tab) ,@body-xexpr))) 94 95 (define (ferti-tabs-bar active-tab) 96 `(ul ((class "nav nav-tabs my-3")) 97 ,@ 98 (for/list ([tab ferti-tabs]) 99 (match-define (cons tab-title tab-action) tab) 100 `(li ((class "nav-item")) 101 (a ((class ,(string-append "nav-link" (if (equal? tab-title active-tab) " active" ""))) 102 (aria-current "page") 103 (href ,tab-action)) 104 ,tab-title))))) 105 106 (define ferti-tabs 107 '(("Accueil" . "/ferti/index") ("Relevés et Assolements" . "/ferti/measurements-and-rotations") 108 ("Intrants" . "/ferti/fertilizers") 109 ("Cultures" . "/ferti/crop-requirements"))) 110 111 (define (ferti-index-page) 112 (ferti-template 113 "Accueil" 114 `((p "La recette Ferti© est calculée en fonction d'un relevé de nutriments et d'un assolement.") 115 (div 116 ((class "btn-group-vertical")) 117 (a ((class "btn btn-outline-primary") [href "/ferti/measurements/new"]) "Ajouter un relevé") 118 (a ((class "btn btn-outline-primary") [href "/ferti/rotations/new"]) "Ajouter un assolement") 119 (a ((class "btn btn-outline-primary") [href "/ferti/fertilizers/new"]) "Ajouter un intrant"))))) 120 121 (define (ferti-measurements-and-rotations-page measurements rotations) 122 (define (maybe-rotation-for-measurement m) 123 (findf (λ (r) (equal? (crop-rotation-date r) (nutrient-measurement-date m))) rotations)) 124 (define table 125 `(table 126 ((class "table")) 127 (thead (tr (th "Date du relevé") (th "Relevé") (th "Assolement") (th "Recette"))) 128 (tbody 129 ,@(for/list ([m measurements]) 130 (define maybe-rotation (maybe-rotation-for-measurement m)) 131 `(tr 132 (td ((class "font-monospace align-middle")) ,(normal-date (nutrient-measurement-date m))) 133 (td (a ((class "btn btn-outline-secondary btn-sm") 134 (href ,(format "/ferti/measurements/~a" (nutrient-measurement-id m)))) 135 "Consulter")) 136 (td ,(if maybe-rotation 137 `(a ((class "btn btn-outline-secondary btn-sm") 138 (href ,(format "/ferti/rotations/~a" (crop-rotation-id maybe-rotation)))) 139 "Consulter") 140 `(a ((class "btn btn-outline-primary btn-sm") 141 (href ,(format "/ferti/rotations/new/~a" (nutrient-measurement-date m)))) 142 "Ajouter"))) 143 (td ,(if maybe-rotation 144 `(a ((class "btn btn-outline-secondary btn-sm") 145 (href ,(format "/ferti/recipes/~a" (crop-rotation-date maybe-rotation)))) 146 "Consulter") 147 "—"))))))) 148 (ferti-template "Relevés et Assolements" 149 `((div ((class "btn-group mb-3")) 150 (a ((class "btn btn-primary") [href "/ferti/measurements/new"]) 151 "Ajouter un relevé")) 152 (div ((class "overflow-auto")) ,table)))) 153 154 (define (ferti-fertilizers-page fertilizers) 155 (define table 156 `(table ((class "table table-striped")) 157 (tr (th () "Nom de référence") (th () "Nom de marque")) 158 ,@(for/list ([fp fertilizers]) 159 (define brand-name (fertilizer-brand-name fp)) 160 `(tr (td (a ([href ,(format "/ferti/fertilizers/~a" (fertilizer-product-id fp))]) 161 ,(fertilizer-product-name fp))) 162 (td ,(if (and brand-name (non-empty-string? brand-name)) brand-name "—")))))) 163 (ferti-template "Intrants" 164 `((a ((class "btn btn-primary mb-3") [href "/ferti/fertilizers/new"]) 165 "Ajouter un intrant") 166 ,table))) 167 168 (define (ferti-crop-requirements-page crop-requirements) 169 (define table 170 `(table ((class "table table-striped")) 171 (tr (th "Profil") (th "Culture")) 172 ,@(for/list ([cr crop-requirements]) 173 (define cid (crop-requirement-crop-id cr)) 174 `(tr (td (a ((href ,(format "/ferti/crop-requirements/~a" (crop-requirement-id cr)))) 175 ,(string-titlecase (crop-requirement-profile cr)))) 176 (td ,(if cid 177 (let ([crop (get-crop #:id cid)]) 178 `(a ((href ,(format "/ferti/crops/~a" cid))) 179 ,(string-titlecase (crop-name crop)))) 180 "—")))))) 181 (define button-group 182 '(div ((class "btn-group mb-3")) 183 (a ((class "btn btn-primary") [href "/ferti/crop-requirements/new"]) "Ajouter un profil") 184 (a ((class "btn btn-secondary") [href "/ferti/crops/new"]) "Ajouter une culture"))) 185 (ferti-template "Cultures" (list button-group table))) 186 187 ;; TODO: add bar chart for comparing to target concentrations 188 (define (ferti-recipe-page recipe-date fertilizer-recipe) 189 (define normal-recipe-date (normal-date recipe-date)) 190 (define title (format "Recette du ~a" normal-recipe-date)) 191 (define table 192 `(table ((class "table")) 193 (thead (tr (th "Intrant") (th "Marque") (th ((class "text-end")) "Quantité (g)"))) 194 (tbody ,@(for/list ([(fertilizer quantity) (in-hash fertilizer-recipe)] 195 #:when (not (zero? quantity))) 196 (define canonical-name (fertilizer-product-name fertilizer)) 197 (define brand-name (fertilizer-brand-name fertilizer)) 198 `(tr (td ,canonical-name) 199 (td ,(if (non-empty-string? brand-name) brand-name "—")) 200 (td ((class "text-end font-monospace")) ,(round 2 (* 100 quantity)))))))) 201 (page-template title 202 `((h1 ((class "display-1 mb-3")) "Recette Ferti") 203 (h5 ((class "display-5 mb-3")) ,normal-recipe-date) 204 (p "Quantités calculées pour 100'000 L.") 205 ,table))) 206 207 ;; New 208 209 (define (form-page-template title action formlet) 210 (page-template title 211 `((h1 ((class "display-1 mb-3")) ,title) 212 (div ((class "mb-3") [style "max-width: 30em"]) 213 (form ([action ,action] [method "POST"]) ,@(formlet-display formlet)))))) 214 215 (define (new-measurement-page) 216 (form-page-template "Nouveau relevé" "/ferti/measurements/create" (measurements-formlet))) 217 218 (define (new-rotation-page #:date [date-string #f]) 219 (form-page-template "Nouvel assolement" 220 "/ferti/rotations/create" 221 (rotation-formlet #:date date-string))) 222 223 (define (new-fertilizer-page) 224 (form-page-template "Nouvel intrant" "/ferti/fertilizers/create" (fertilizer-formlet))) 225 226 (define (new-crop-page) 227 (form-page-template "Nouvelle culture" "/ferti/crops/create" (crop-formlet))) 228 229 (define (new-crop-requirement-page) 230 (form-page-template "Nouveau profil" "/ferti/crop-requirements/create" (crop-requirements-formlet))) 231 232 ;; Edit 233 234 (define (edit-measurement-page nm) 235 (form-page-template "Modifier le relevé" 236 "/ferti/measurements/update" 237 (measurements-formlet #:value nm))) 238 239 (define (edit-fertilizer-page fp) 240 (form-page-template "Modifier l'intrant" 241 "/ferti/fertilizers/update" 242 (fertilizer-formlet #:value fp))) 243 244 (define (edit-crop-page crop) 245 (form-page-template "Modifier la culture" "/ferti/crops/update" (crop-formlet #:value crop))) 246 247 (define (edit-crop-requirement-page cr) 248 (form-page-template "Modifier profil" 249 "/ferti/crop-requirements/update" 250 (crop-requirements-formlet #:value cr))) 251 252 ;; Show 253 254 (define (show-measurement-page nm) 255 (define id (nutrient-measurement-id nm)) 256 (define measurement-date (normal-date (nutrient-measurement-date nm))) 257 (define table 258 `(table ((class "table") (style "max-width: 30em")) 259 (thead (tr (th "Nutriment") (th ((class "text-end")) "Concentration (mg/L)"))) 260 (tbody ,@(for/list ([n (get-nutrients)]) 261 (define nutrient-value (hash-ref (nutrient-measurement-values nm) n 0)) 262 `(tr (td ,(nutrient-french-name n)) 263 (td ((class "text-end font-monospace")) ,(round 2 nutrient-value))))))) 264 (define button-group 265 `(div ((class "btn-group mb-3")) 266 (a ((class "btn btn-primary") [href ,(format "/ferti/measurements/~a/edit" id)]) "Modifier") 267 (a ((class "btn btn-danger") [href ,(format "/ferti/measurements/~a/destroy" id)]) 268 "Supprimer"))) 269 (page-template (format "Relevé du ~a" measurement-date) 270 `((h1 ((class "display-1 mb-3")) "Relevé") (h5 ((class "display-5 mb-3")) 271 ,measurement-date) 272 ,button-group 273 ,table))) 274 275 (define (show-rotation-page cr) 276 (define id (crop-rotation-id cr)) 277 (define rotation-date (normal-date (crop-rotation-date cr))) 278 (define table 279 `(table ((class "table") (style "max-width: 30em")) 280 (thead (tr (th "Type de culture") (th ((class "text-end")) "Proportion (%)"))) 281 (tbody ,@(for/list ([requirement (get-crop-requirements)]) 282 (define requirement-proportion 283 (hash-ref (crop-rotation-requirements cr) requirement 0)) 284 `(tr (td ,(crop-requirement-profile requirement)) 285 (td ((class "text-end font-monospace")) 286 ,(round 2 requirement-proportion))))))) 287 (define button-group 288 `(div ((class "btn-group mb-3")) 289 (a ((class "btn btn-primary") [href ,(format "/ferti/rotations/~a/edit" id)]) "Modifier") 290 (a ((class "btn btn-danger") 291 [href ,(format "/ferti/rotations/~a/destroy" (crop-rotation-id cr))]) 292 "Supprimer"))) 293 (page-template (format "Assolement du ~a" rotation-date) 294 `((h1 ((class "display-1 mb-3")) ,"Assolement") (h5 ((class "display-5 mb-3")) 295 ,rotation-date) 296 ,button-group 297 ,table))) 298 299 (define (show-fertilizer-page fp) 300 (define id (fertilizer-product-id fp)) 301 (define product-name (string-titlecase (fertilizer-product-name fp))) 302 (define brand-name (fertilizer-brand-name fp)) 303 (define sorted-nutrient-values (get-sorted-nutrient-values (fertilizer-product-values fp))) 304 (define table 305 `(table ((class "table") (style "max-width: 30em")) 306 (thead (tr (th "Nutriment") (th ((class "text-end")) "Concentration (mg/L)"))) 307 (tbody ,@(for/list ([nv-pair sorted-nutrient-values]) 308 (match-define (cons n v) nv-pair) 309 `(tr (td ,(nutrient-french-name n)) 310 (td ((class "text-end font-monospace")) ,(round 2 v))))))) 311 (define button-group 312 `(div ((class "btn-group mb-3")) 313 (a ((class "btn btn-primary") [href ,(format "/ferti/fertilizers/~a/edit" id)]) "Modifier") 314 (a ((class "btn btn-danger") [href ,(format "/ferti/fertilizers/~a/destroy" id)]) 315 "Supprimer"))) 316 (page-template product-name 317 `((h1 ((class "display-1 mb-3")) ,product-name) 318 (h5 ((class "display-5 mb-3")) 319 ,(if (non-empty-string? brand-name) brand-name "Intrant générique")) 320 ,button-group 321 ,table))) 322 323 (define (show-crop-page crop) 324 (define id (crop-id crop)) 325 (define name (string-titlecase (crop-name crop))) 326 (define crop-requirements-for-crop 327 (filter (λ (cr) (equal? (crop-requirement-crop-id cr) (crop-id crop))) (get-crop-requirements))) 328 (define profile-list 329 `(ul ,@(for/list ([cr crop-requirements-for-crop]) 330 `(li (a ([href ,(format "/ferti/crop-requirements/~a" (crop-requirement-id cr))]) 331 ,(string-titlecase (crop-requirement-profile cr))))))) 332 (define button-group 333 `(div ((class "btn-group mb-3")) 334 (a ((class "btn btn-primary") [href ,(format "/ferti/crops/~a/edit" id)]) "Modifier") 335 (a ((class "btn btn-danger") [href ,(format "/ferti/crops/~a/destroy" id)]) "Supprimer"))) 336 (page-template name `((h1 ((class "display-1 mb-3")) ,name) ,button-group ,profile-list))) 337 338 (define (show-crop-requirement-page cr) 339 (define id (crop-requirement-id cr)) 340 (define cid (crop-requirement-crop-id cr)) 341 (define crop 342 (if cid 343 (string-titlecase (crop-name (get-crop #:id cid))) 344 #f)) 345 (define profile (string-titlecase (crop-requirement-profile cr))) 346 (define title 347 (if crop 348 (format "~a — ~a" crop profile) 349 profile)) 350 (define table 351 `(table ((class "table") (style "max-width: 30em")) 352 (thead (tr (th "Nutriment") (th ((class "text-end")) "Concentration (mg/L)"))) 353 (tbody ,@(for/list ([n (get-nutrients)]) 354 (define nutrient-value (hash-ref (crop-requirement-values cr) n 0)) 355 `(tr (td ,(nutrient-french-name n)) 356 (td ((class "text-end font-monospace")) ,(round 2 nutrient-value))))))) 357 (define button-group 358 `(div ((class "btn-group")) 359 (a ((class "btn btn-primary") [href ,(format "/ferti/crop-requirements/~a/edit" id)]) 360 "Modifier") 361 (a ((class "btn btn-danger") [href ,(format "/ferti/crop-requirements/~a/destroy" id)]) 362 "Supprimer"))) 363 (page-template title 364 `((h1 ((class "display-1 mb-3")) ,profile) (h5 ((class "display-5 mb-3")) 365 ,(or crop "Profil générique")) 366 ,button-group 367 ,table))) 368 369 (define (index-page user) 370 (page-template 371 "Bienvenue à la FAPG" 372 `((div ((class "jumbotron")) 373 (h1 ((class "display-1 mb-3")) 374 ,(string-join (list (if (<= (->hours (current-time)) 17) "Bonjour" "Bonsoir") 375 (if user 376 (user-name user) 377 "et bienvenue")))) 378 (hr ((class "my-3"))) 379 (p ((class "lead")) ,(~t (now) "'Dernière connexion à' HH:mm, 'le' EEEE d MMMM yyyy")) 380 (p ((class "lead")) 381 (a ((class "btn btn-primary mb-3") [href "/ferti/index"]) "Accéder à Ferti")))))) 382 383 (define (fallback-page request-code) 384 (page-template (format "Réponse: ~a" request-code) 385 `((h1 ((class "display-1 text-danger")) ,(number->string request-code)) 386 (p ,(fallback-message request-code)) 387 (a ([href "/"]) "Revenir à la page d'accueil")))) 388 389 (define (fallback-message request-code) 390 (string-join 391 `("Bonjour, je suis votre serveur." 392 ,(format "J'ai répondu '~a'" request-code) 393 "et" 394 ,(case (string-ref (number->string request-code) 0) 395 [(#\4) "c'est de votre faute."] 396 [(#\5) "c'est de ma faute."] 397 [else "je ne sais pas qui est en tort."]) 398 ,(case request-code 399 ;; Client errors 400 [(400) "Votre requête ne fait pas sens."] 401 [(401) "Vous n'avez pas vérifié votre identité."] 402 [(403) "Vous n'avez pas le droit de consulter cette page."] 403 [(404) "Vous avez demandé de consulter une page qui n'existe pas."] 404 ;; Server errors 405 [(500) 406 "Je suis dans une situation que je ne sais pas gérer, et ne peux vous en dire davantage."] 407 [(502) 408 "Un tiers ne m'a pas transmis les informations nécessaires pour répondre à votre requête."] 409 [(503) 410 "Je ne peux pas vous aider, il se peut que je sois momentanément surchargé. Revenez plus tard."] 411 ;; Fallback message 412 [else (format "Je ne sais pas encore interpréter le code ~a." request-code)])))) 413