From 3008eb25f79ef1ed54fcc2b3f5b6635b34394680 Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sun, 19 Oct 2025 21:15:18 +0200 Subject: Absorb existing domain data. --- views.rkt | 152 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 152 insertions(+) create mode 100644 views.rkt (limited to 'views.rkt') diff --git a/views.rkt b/views.rkt new file mode 100644 index 0000000..d78c370 --- /dev/null +++ b/views.rkt @@ -0,0 +1,152 @@ +#lang racket + +(provide index-page + new-measurement-page + fallback-page) + +(require web-server/formlets + "formlets.rkt" + "models/nutrient.rkt" + "models/nutrient-measurement.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"]) + (div ([class "container-fluid"]) + (a ([class "navbar-brand"] [href "/"]) "FAPG") + (button ([class "navbar-toggler"] + [type "button"] + [data-bs-toggle "collapse"] + [data-bs-target "#navbarNav"] + [aria-controls "navbarNav"] + [aria-expanded "false"] + [aria-label "Toggle navigation"]) + (span ([class "navbar-toggler-icon"]))) + (div ([class "collapse navbar-collapse"] [id "navbarNav"]) + (ul ([class "navbar-nav"]) + (li ([class "nav-item"]) + (a ([class "nav-link active"] + [aria-current "page"] + [href "/"]) + "Home")) + (li ([class "nav-item"]) + (a ([class "nav-link"] + [href "/about"]) + "About")) + (li ([class "nav-item"]) + (a ([class "nav-link"] + [href "/contact"]) + "Contact"))))))) + + +;; Page helpers + +(define (round n number) + (~r number #:precision n)) + + +;; Pages + +(define (index-page measurements) + (page-template + "Ferti" + `((h1 ([class "display-1 mb-3"]) "Ferti") + (a ([class "btn btn-primary mb-3"] [href "/target/new"]) "Créer une cible") + (table ([class "table"]) + (tr (th "Nutriment") + (th ([class "text-end"]) "Dernière Cible") + (th ([class "text-end"]) "Dernier Relevé") + (th ([class "text-end"]) "Delta (%)")) + ,@(for/list ([n (get-nutrients)]) + (define latest-target (+ (get-latest-nutrient-measurement-value n) 1)) + (define latest-value (get-latest-nutrient-measurement-value n)) + (define delta (* 100 + (/ (- latest-target latest-value) + latest-target))) + `(tr (td ,(nutrient-name n)) + (td ([class "text-end"]) ,(round 2 latest-target)) + (td ([class "text-end"]) ,(round 2 latest-value)) + (td ([class "text-end"]) ,(round 1 delta))))) + + (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-measured-on 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 (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)])))) -- cgit v1.2.3