#lang racket (provide index-page ferti-index-page ferti-measurements-and-rotations-page ferti-recipe-page ferti-fertilizers-page new-measurement-page new-rotation-page new-fertilizer-page show-measurement-page show-rotation-page show-fertilizer-page fallback-page) (require gregor web-server/formlets "formlets.rkt" "models/user.rkt" "models/nutrient.rkt" "models/nutrient-measurement.rkt" "models/crop-rotation.rkt" "models/crop-requirement.rkt" "models/fertilizer-product.rkt") (define (page-template title body-xexpr) `(html (head (meta ([charset "utf-8"])) (meta ([name "viewport"] [content "width=device-width, initial-scale=1"])) (title ,title) ;; Bootstrap CSS (link ([href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/css/bootstrap.min.css"] [rel "stylesheet"] [integrity "sha384-QWTKZyjpPEjISv5WaRU9OFeRpok6YctnYmDr5pNlyT2bRjXh0JMhjY6hW+ALEwIH"] [crossorigin "anonymous"]))) (body ,navbar (div ((class "container")) ,@body-xexpr) ;; Bootstrap JS bundle (script ([src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/js/bootstrap.bundle.min.js"] [integrity "sha384-YvpcrYf0tY3lHB60NNkmXc5s9fDVZLESaAA55NDzOxhy9GkcIdslK1eN7N6jIeHz"] [crossorigin "anonymous"]))))) ;; Page components (define navbar '(nav ((class "navbar navbar-expand-lg navbar-light bg-light")) (div ((class "container-fluid")) (a ((class "navbar-brand") [href "/"]) "FAPG") (button ((class "navbar-toggler") [type "button"] [data-bs-toggle "collapse"] [data-bs-target "#navbarSupportedContent"] [aria-controls "navbarSupportedContent"] [aria-expanded "false"] [aria-label "Toggle navigation"]) (span ((class "navbar-toggler-icon")))) (div ((class "collapse navbar-collapse") [id "navbarSupportedContent"]) (ul ((class "navbar-nav me-auto mb-2 mb-lg-0")) (li ((class "nav-item")) (a ((class "nav-link disabled") [href "#"] [tabindex "-1"] [aria-disabled "true"]) "Clients")) (li ((class "nav-item")) (a ((class "nav-link active") [aria-current "page"] [href "/ferti/index"]) "Ferti")) (li ((class "nav-item")) (a ((class "nav-link disabled") [href "#"] [tabindex "-1"] [aria-disabled "true"]) "Cultures")) (li ((class "nav-item")) (a ((class "nav-link") [href "/contact"]) "Contact"))))))) ;; Page helpers (define (round n number) (~r number #:precision `(= ,n))) (define (normal-date date-string) (~t (iso8601->date date-string) "dd/MM/yyyy")) ;; Pages (define (ferti-template body-xexpr) (page-template "Ferti" `((h1 ((class "display-1 mb-3")) "Ferti") ,ferti-tabs ,@body-xexpr))) (define ferti-tabs '(ul ((class "nav nav-tabs mb-3")) (li ((class "nav-item")) (a ((class "nav-link") (aria-current "page") (href "/ferti/index")) "Accueil")) (li ((class "nav-item")) (a ((class "nav-link") (aria-current "page") (href "/ferti/measurements-and-rotations")) "Relevés & Assolements")) (li ((class "nav-item")) (a ((class "nav-link") (aria-current "page") (href "/ferti/fertilizers")) "Intrants")) #;(li ((class "nav-item")) (a ((class "nav-link") (aria-current "page") (href "/ferti/recipe")) "Recette Ferti©")))) (define (ferti-index-page) (ferti-template `((p "La recette Ferti© est calculée en fonction d'un relevé de nutriments et d'une cible.") (div ((class "btn-group-vertical")) (a ((class "btn btn-outline-primary") [href "/ferti/measurement/new"]) "Ajouter un relevé") (a ((class "btn btn-outline-primary") [href "/ferti/rotation/new"]) "Ajouter un assolement") (a ((class "btn btn-outline-primary") [href "/ferti/fertilizer/new"]) "Ajouter un intrant"))))) (define (ferti-measurements-and-rotations-page measurements rotations) (define (maybe-rotation-for-measurement m) (findf (λ (r) (equal? (crop-rotation-date r) (nutrient-measurement-date m))) rotations)) (define table `(table ((class "table")) (thead (tr (th "Date du relevé") (th "Relevé") (th "Cultures") (th "Recette"))) (tbody ,@(for/list ([m measurements]) (define maybe-rotation (maybe-rotation-for-measurement m)) `(tr (td ((class "font-monospace")) ,(normal-date (nutrient-measurement-date m))) (td (a ((class "btn btn-outline-secondary btn-sm") (href ,(format "/ferti/measurement/~a" (nutrient-measurement-id m)))) "Modifier")) (td ,(if maybe-rotation `(a ((class "btn btn-outline-secondary btn-sm") (href ,(format "/ferti/rotation/~a" (crop-rotation-id maybe-rotation)))) "Modifier") `(a ((class "btn btn-outline-primary btn-sm") (href ,(format "/ferti/rotation/new/~a" (nutrient-measurement-date m)))) "Ajouter"))) (td ,(if maybe-rotation `(a ((class "btn btn-outline-secondary btn-sm") (href ,(format "/ferti/recipe/~a" (crop-rotation-date maybe-rotation)))) "Consulter") "—"))))))) (ferti-template `((h2 () "Relevés & Assolements") (div ((class "btn-group mb-3")) (a ((class "btn btn-primary") [href "/ferti/measurement/new"]) "Ajouter un relevé")) ,table))) #; (define (ferti-targets-page latest-measurement-hash latest-target-hash) (define table `(table ((class "table")) (thead (tr (th "Nutriment") (th ((class "text-end")) "Dernier Relevé") (th ((class "text-end")) "Dernière Cible"))) (tbody ,@(for/list ([n (get-nutrients)]) (define latest-measurement (hash-ref latest-measurement-hash n #f)) (define latest-target (hash-ref latest-target-hash n #f)) `(tr (td ,(nutrient-french-name n)) (td ((class "text-end font-monospace")) ,(if latest-measurement (round 2 latest-measurement) "—")) (td ((class "text-end font-monospace")) ,(if latest-target (round 2 latest-target) "—"))))))) (ferti-template `((h2 () "Dernière Cible") (a ((class "btn btn-primary mb-3") [href "/ferti/target/new"]) "Créer une cible") ,table))) (define (ferti-recipe-page recipe-date fertilizer-recipe) (define table `(table ((class "table")) (thead (tr (th "Intrant") (th ((class "text-end")) "Quantité (g)"))) (tbody ,@(for/list ([(fertilizer quantity) (in-hash fertilizer-recipe)] #:when (not (zero? quantity))) `(tr (td () ,(let ([canonical-name (fertilizer-product-name fertilizer)] [brand-name (fertilizer-brand-name fertilizer)]) (if brand-name (format "~a (~a)" brand-name canonical-name) canonical-name))) (td ((class "text-end font-monospace")) ,(round 2 (* 100 quantity)))))))) (ferti-template `((h2 () ,(format "Recette du ~a" (normal-date recipe-date))) (p "Quantités calculées pour 100'000 L.") ,table))) (define (ferti-fertilizers-page fertilizers) (define table `(table ((class "table table-striped")) (tr (th () "Nom de référence") (th () "Nom de marque")) ,@ (for/list ([fertilizer fertilizers]) `(tr (td (a ([href ,(format "/ferti/fertilizer/~a" (fertilizer-product-id fertilizer))]) ,(fertilizer-product-name fertilizer))) (td ,(or (fertilizer-brand-name fertilizer) "—")))))) (ferti-template `((h2 () "Intrants") (a ((class "btn btn-primary mb-3") [href "/ferti/fertilizer/new"]) "Ajouter un intrant") ,table))) (define (new-measurement-page) (page-template "Nouveau relevé" `((h1 ((class "display-1 mb-3")) "Nouveau relevé") (div ((class "mb-3") [style "max-width: 30em"]) (form ([action "/ferti/measurement/create"] [method "POST"]) ,@(formlet-display (measurements-formlet))))))) (define (new-rotation-page #:date [date-string #f]) (page-template "Nouvel assolement" `((h1 ((class "display-1 mb-3")) "Nouvel assolement") (div ((class "mb-3") [style "max-width: 30em"]) (form ([action "/ferti/rotation/create"] [method "POST"]) ,@(formlet-display (rotation-formlet #:date date-string))))))) (define (new-fertilizer-page) (page-template "Nouvel intrant" `((h1 ((class "display-1 mb-3")) "Nouvel intrant") (div ((class "mb-3") [style "max-width: 30em"]) (form ([action "/ferti/fertilizer/create"] [method "POST"]) ,@(formlet-display (fertilizer-formlet))))))) (define (show-measurement-page nm) (define title (format "Relevé du ~a" (normal-date (nutrient-measurement-date nm)))) (define table `(table ((class "table")) (thead (tr (th "Nutriment") (th ((class "text-end")) "Valeur de ce relevé (mg/L)"))) (tbody ,@(for/list ([n (get-nutrients)]) (define nutrient-value (hash-ref (nutrient-measurement-values nm) n 0)) `(tr (td ,(nutrient-french-name n)) (td ((class "text-end font-monospace")) ,(round 2 nutrient-value))))))) (page-template title `((h1 ((class "display-1 mb-3")) ,title) (a ((class "btn btn-danger") [href ,(format "/ferti/measurement/destroy/~a" (nutrient-measurement-id nm))]) "Supprimer relevé") ,table))) (define (show-rotation-page cr) (define title (format "Assolement du ~a" (normal-date (crop-rotation-date cr)))) (define table `(table ((class "table")) (thead (tr (th "Type de culture") (th ((class "text-end")) "Proportion (%)"))) (tbody ,@(for/list ([requirement (get-crop-requirements)]) (define requirement-proportion (hash-ref (crop-rotation-requirements cr) requirement 0)) `(tr (td ,(crop-requirement-profile requirement)) (td ((class "text-end font-monospace")) ,(round 2 requirement-proportion))))))) (page-template title `((h1 ((class "display-1 mb-3")) ,title) (a ((class "btn btn-danger") [href ,(format "/ferti/rotation/destroy/~a" (crop-rotation-id cr))]) "Supprimer assolement") ,table))) (define (show-fertilizer-page fp) (define title (fertilizer-product-name fp)) (define nutrient-values (fertilizer-product-values fp)) (define table `(table ((class "table")) (thead (tr (th "Nutriment") (th ((class "text-end")) "Apport (mg/L)"))) (tbody ,@(for/list ([(nutrient quantity) (in-hash nutrient-values)] #:when (not (zero? quantity))) `(tr (td ,(nutrient-french-name nutrient)) (td ((class "text-end font-monospace")) ,(round 2 quantity))))))) (page-template title `((h1 ((class "display-1 mb-3")) ,title) (a ((class "btn btn-danger") [href ,(format "/ferti/fertilizer/destroy/~a" (fertilizer-product-id fp))]) "Supprimer") ,table))) (define (index-page user) (page-template "Bienvenue à la FAPG" `((div ((class "jumbotron")) (h1 ((class "display-1 mb-3")) ,(string-join (list (if (<= (->hours (current-time)) 17) "Bonjour" "Bonsoir") (if user (user-name user) "et bienvenue")))) (hr ((class "my-3"))) (p ((class "lead")) ,(~t (now) "'Dernière connexion à' HH:mm, 'le' EEEE d MMMM yyyy")) (p ((class "lead")) (a ((class "btn btn-primary mb-3") [href "/ferti/index"]) "Accéder à Ferti")))))) (define (fallback-page request-code) (page-template (format "Réponse: ~a" request-code) `((h1 ((class "display-1 text-danger")) ,(number->string request-code)) (p ,(fallback-message request-code)) (a ([href "/"]) "Revenir à la page d'accueil")))) (define (fallback-message request-code) (string-join `("Bonjour, je suis votre serveur." ,(format "J'ai répondu '~a'" request-code) "et" ,(case (string-ref (number->string request-code) 0) [(#\4) "c'est de votre faute."] [(#\5) "c'est de ma faute."] [else "je ne sais pas qui est en tort."]) ,(case request-code ;; Client errors [(400) "Votre requête ne fait pas sens."] [(401) "Vous n'avez pas vérifié votre identité."] [(403) "Vous n'avez pas le droit de consulter cette page."] [(404) "Vous avez demandé de consulter une page qui n'existe pas."] ;; Server errors [(500) "Je suis dans une situation que je ne sais pas gérer, et ne peux vous en dire davantage."] [(502) "Un tiers ne m'a pas transmis les informations nécessaires pour répondre à votre requête."] [(503) "Je ne peux pas vous aider, il se peut que je sois momentanément surchargé. Revenez plus tard."] ;; Fallback message [else (format "Je ne sais pas encore interpréter le code ~a." request-code)]))))