diff options
Diffstat (limited to 'views.rkt')
| -rw-r--r-- | views.rkt | 185 |
1 files changed, 101 insertions, 84 deletions
@@ -1,7 +1,11 @@ #lang racket (provide index-page - ferti-page + ferti-index-page + ferti-measurements-page + ferti-targets-page + ferti-recipe-page + ferti-fertilizers-page new-measurement-page new-target-page new-fertilizer-page @@ -54,7 +58,7 @@ (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")) + (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")) @@ -67,87 +71,100 @@ ;; Pages -(define (ferti-page fertilizer-recipe latest-measurement-hash latest-target-hash measurements) - (page-template "Ferti" - `((h1 ((class "display-1 mb-3")) "Ferti") ,ferti-actions - ,@(ferti-recipe fertilizer-recipe) - ,@(ferti-targets latest-measurement-hash - latest-target-hash) - ,@(ferti-measurements measurements) - ,@(ferti-fertilizers)))) - -(define ferti-actions - `(div ((class "btn-group mb-3")) - (a ((class "btn btn-outline-primary") [href "/target/new"]) "Créer une cible") - (a ((class "btn btn-outline-primary") [href "/measurement/new"]) "Ajouter un relevé") - (a ((class "btn btn-outline-primary") [href "/fertilizer/new"]) "Ajouter un intrant"))) - -(define (ferti-recipe ferti-recipe) - `((h2 () "Recette") - ,(if (ormap (λ (pair) (not (zero? (cdr pair)))) ferti-recipe) - `(table ((class "table")) - (tr (th "Intrant") (th ((class "text-end")) "Quantité (g/L)")) - ,@(for/list ([fertilizer-amount ferti-recipe] - #:when (not (zero? (cdr fertilizer-amount)))) - (match-define (cons fertilizer amount) fertilizer-amount) - `(tr (td () - ,(let ([canonical-name (fertilizer-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 amount))))) - `(p "La recette Ferti requiert au moins un relevé et une cible.")))) - -(define (ferti-targets latest-measurement-hash latest-target-hash) - `((h2 () "Dernière Cible") (table ((class "table")) - (tr (th "Nutriment") - (th ((class "text-end")) "Dernier Relevé") - (th ((class "text-end")) "Dernière Cible")) - ,@(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) - "—"))))))) - -(define (ferti-measurements measurements) - `((h2 () "Relevés") (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)) - ;; TODO: use new nutrient-value hash, available - ;; immediately in this context. - (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 (ferti-fertilizers) - `((h2 () "Intrants") (table ((class "table table-striped")) - (tr (th () "Nom de référence") (th () "Nom de marque")) - ,@(for/list ([fertilizer (get-fertilizer-products)]) - `(tr (td ,(fertilizer-name fertilizer)) - (td ,(or (fertilizer-brand-name fertilizer) "—"))))))) +(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")) "Relevés")) + (li ((class "nav-item")) + (a ((class "nav-link") (aria-current "page") (href "/ferti/targets")) "Cibles")) + (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 "/measurement/new"]) "Ajouter un relevé") + (a ((class "btn btn-outline-primary") [href "/target/new"]) "Créer une cible") + (a ((class "btn btn-outline-primary") [href "/fertilizer/new"]) "Ajouter un intrant"))))) + +(define (ferti-measurements-page nutrients measurements) + (define table + `(table ((class "table table-striped")) + (thead (tr (th "Date") + ,@(for/list ([n nutrients]) + `(th ((class "text-end")) ,(nutrient-formula n))))) + (tbody ,@ + (for/list ([m measurements]) + `(tr (td ,(nutrient-measurement-date m)) + ,@(for/list ([n nutrients]) + (define nutrient-value (hash-ref (nutrient-measurement-values m) n #f)) + `(td ((class "text-end")) + ,(if nutrient-value + (round 2 nutrient-value) + "—")))))))) + (ferti-template `((h2 () "Relevés") (a ((class "btn btn-primary mb-3") [href "/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 "/target/new"]) + "Créer une cible") + ,table))) + +(define (ferti-recipe-page fertilizer-recipe) + (define table + `(table ((class "table")) + (thead (tr (th "Intrant") (th ((class "text-end")) "Quantité (g/L)"))) + (tbody ,@(for/list ([fertilizer-amount fertilizer-recipe] + #:when (not (zero? (cdr fertilizer-amount)))) + (match-define (cons fertilizer amount) fertilizer-amount) + `(tr (td () + ,(let ([canonical-name (fertilizer-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 amount))))))) + (ferti-template `((h2 () "Recette") + ,(if (ormap (λ (pair) (not (zero? (cdr pair)))) fertilizer-recipe) + table + `(p "La recette Ferti requiert au moins un relevé et une cible."))))) + +(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 ,(fertilizer-name fertilizer)) + (td ,(or (fertilizer-brand-name fertilizer) "—")))))) + (ferti-template `((h2 () "Intrants") (a ((class "btn btn-primary mb-3") [href "/fertilizer/new"]) + "Ajouter un intrant") + ,table))) (define (new-measurement-page) (page-template "Nouveau relevé" @@ -179,7 +196,7 @@ (if user (user-name user) "et bienvenue"))) - (a ((class "btn btn-primary mb-3") [href "/ferti"]) "Accéder à Ferti")))) + (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) |