diff options
| -rw-r--r-- | handlers.rkt | 53 | ||||
| -rw-r--r-- | views.rkt | 185 |
2 files changed, 139 insertions, 99 deletions
diff --git a/handlers.rkt b/handlers.rkt index 17a57dd..051254b 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -1,6 +1,7 @@ #lang racket -(provide secured-dispatch) +(provide secured-dispatch + fapg-url) (require web-server/dispatch web-server/http @@ -9,6 +10,7 @@ "views.rkt" "formlets.rkt" "models/user.rkt" + "models/nutrient.rkt" "models/nutrient-measurement.rkt" "models/nutrient-target.rkt" "models/fertilizer-product.rkt" @@ -20,7 +22,7 @@ (or (getenv "FERTI_PASS") (error 'ferti "FERTI_PASS environment variable is not set"))) (define (secured-dispatch) - (wrap-basic-auth app-dispatch)) + (wrap-basic-auth fapg-dispatch)) (define (wrap-basic-auth handler) (lambda (req) @@ -44,8 +46,12 @@ (list (make-basic-auth-header (format "Basic Auth Test: ~a" (gensym)))) void)) -(define-values (app-dispatch _) - (dispatch-rules [("ferti") #:method "get" ferti] +(define-values (fapg-dispatch fapg-url) + (dispatch-rules [("ferti" "index") #:method "get" ferti-index] + [("ferti" "measurements") #:method "get" ferti-measurements] + [("ferti" "targets") #:method "get" ferti-targets] + [("ferti" "recipe") #:method "get" ferti-recipe] + [("ferti" "fertilizers") #:method "get" ferti-fertilizers] [("measurement" "new") #:method "get" new-measurement] [("measurement" "create") #:method "post" create-measurement] [("measurement" "destroy") #:method "post" destroy-measurement] @@ -59,18 +65,35 @@ (define (render-page xexpr) (response/xexpr #:preamble #"<!DOCTYPE html>" xexpr)) -(define (ferti _) - (define ferti-recipe (find-ferti-recipe)) - (define latest-measurement-hash (get-latest-nutrient-measurement-hash)) - (define latest-target-hash (get-latest-nutrient-target-hash)) - (define latest-measurements (take (get-nutrient-measurements) 10)) - (render-page - (ferti-page ferti-recipe latest-measurement-hash latest-target-hash latest-measurements))) +;; Index (define (index _) (define user (get-current-user)) (render-page (index-page user))) +;; Ferti + +(define (ferti-index _) + (render-page (ferti-index-page))) + +(define (ferti-measurements _) + (define nutrients (get-nutrients)) + (define measurements (get-nutrient-measurements)) + (render-page (ferti-measurements-page nutrients measurements))) + +(define (ferti-targets _) + (define latest-measurement-hash (get-latest-nutrient-measurement-hash)) + (define latest-target-hash (get-latest-nutrient-target-hash)) + (render-page (ferti-targets-page latest-measurement-hash latest-target-hash))) + +(define (ferti-recipe _) + (define ferti-recipe (find-ferti-recipe)) + (render-page (ferti-recipe-page ferti-recipe))) + +(define (ferti-fertilizers _) + (define fertilizers (get-fertilizer-products)) + (render-page (ferti-fertilizers-page fertilizers))) + ;; Nutrient measurements (define (new-measurement _) @@ -79,11 +102,11 @@ (define (create-measurement req) (define-values (measured-on nutrient-values) (formlet-process (measurements-formlet) req)) (create-nutrient-measurement! measured-on nutrient-values) - (redirect-to "/ferti")) + (redirect-to "/ferti/measurements")) (define (destroy-measurement req) (delete-nutrient-measurement! req) - (redirect-to "/ferti")) + (redirect-to "/ferti/index")) ;; Nutrient targets @@ -93,7 +116,7 @@ (define (create-target req) (define-values (effective-on nutrient-values) (formlet-process (targets-formlet) req)) (create-nutrient-target! effective-on nutrient-values) - (redirect-to "/ferti")) + (redirect-to "/ferti/targets")) ;; Fertilizer products @@ -104,7 +127,7 @@ (define-values (canonical-name brand-name nutrient-values) (formlet-process (fertilizer-formlet) req)) (create-fertilizer-product! canonical-name brand-name nutrient-values) - (redirect-to "/ferti")) + (redirect-to "/ferti/fertilizers")) ;; Fallback @@ -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) |