#lang racket (provide index-page new-measurement-page new-target-page fallback-page) (require web-server/formlets "formlets.rkt" "models/nutrient.rkt" "models/nutrient-measurement.rkt" "models/nutrient-target.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 dropdown"]) (a ([class "nav-link dropdown-toggle"] [href "#"] [id "navbarDropdown"] [role "button"] [data-bs-toggle "dropdown"] [aria-expanded "false"]) "Dropdown") (ul ([class "dropdown-menu"] [aria-labelledby "navbarDropdown"]) (li (a ([class "dropdown-item"] [href "#"]) "Action")) (li (a ([class "dropdown-item"] [href "#"]) "Another action")) (li (hr ([class "dropdown-divider"]))) (li (a ([class "dropdown-item"] [href "#"]) "Something else here")))) (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"]) "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"))) #; (form ([class "d-flex"]) (input ([class "form-control me-2"] [type "search"] [placeholder "Search"] [aria-label "Search"])) (button ([class "btn btn-outline-success"] [type "submit"]) "Search")))))) ;; Page helpers (define (round n number) (~r number #:precision `(= ,n))) ;; Pages (define (index-page measurements ferti-recipe) (page-template "Ferti" `((h1 ([class "display-1 mb-3"]) "Ferti") ;;;;;;;; ;; Ferti ;;;;;;;; (h2 () "Recette") (table ([class "table"]) (tr (th () "Produit Fertilisant") (th ([class "text-end"]) "Quantité")) ,@(for/list ([fertilizer-amount ferti-recipe] #:when (not (zero? (cdr fertilizer-amount)))) (match-define (cons fertilizer amount) fertilizer-amount) `(tr (td () ,(fertilizer-name fertilizer)) (td ([class "text-end font-monospace"]) ,(round 2 amount))))) ;;;;;;;;; ;; Cibles ;;;;;;;;; (h2 () "Dernière Cible") (a ([class "btn btn-primary mb-3"] [href "/target/new"]) "Créer une cible") (table ([class "table"]) (tr (th "Nutriment") (th ([class "text-end"]) "Dernier Relevé") (th ([class "text-end"]) "Dernière Cible") (th ([class "text-end"]) "Delta (%)")) ,@(for/list ([n (get-nutrients)]) (define latest-target (get-latest-nutrient-target-value n)) (define latest-measurement (get-latest-nutrient-measurement-value n)) (define delta-percentage (cond [(false? latest-target) #f] [(zero? latest-target) -100] [(zero? latest-measurement) 100] [(number? latest-target) (* 100 (/ (- latest-target latest-measurement) latest-measurement))])) `(tr (td ,(nutrient-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) "—")) (td ([class "text-end font-monospace"]) ,(if delta-percentage (round 1 delta-percentage) "—"))))) ;;;;;;;;;; ;; Relevés ;;;;;;;;;; (h2 () "Relevés") (a ([class "btn btn-primary mb-3"] [href "/measurement/new"]) "Ajouter un relevé") (table ([class "table table-striped"]) (tr (th "Date") (th ([class "text-end"]) "N") (th ([class "text-end"]) "P") (th ([class "text-end"]) "K")) ,@(for/list ([m measurements]) (define measured-on (nutrient-measurement-date m)) (define-values (n p k) (apply values (for/list ([nutrient '("Nitrate Nitrogen" "Phosphorus" "Potassium")]) (define n (get-nutrient #:name nutrient)) (define mnv (get-nutrient-measurement-value m n)) (if (real? mnv) (round 2 mnv) "—")))) `(tr (td ,measured-on) (td ([class "text-end font-monospace"]) ,n) (td ([class "text-end font-monospace"]) ,p) (td ([class "text-end font-monospace"]) ,k))))))) (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 "/measurement/create"] [method "POST"]) ,@(formlet-display (measurements-formlet))))))) (define (new-target-page) (page-template "Nouvelle cible" `((h1 ([class "display-1 mb-3"]) "Nouvelle cible") (div ([class "mb-3"] [style "max-width: 30em"]) (form ([action "/target/create"] [method "POST"]) ,@(formlet-display (targets-formlet))))))) (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, malheureusement."] [(#\5) "c'est de ma faute, pardonnez-moi."] [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)]))))