diff options
| -rw-r--r-- | formlets.rkt | 26 | ||||
| -rw-r--r-- | handlers.rkt | 16 | ||||
| -rw-r--r-- | views.rkt | 31 |
3 files changed, 66 insertions, 7 deletions
diff --git a/formlets.rkt b/formlets.rkt index f24c84f..6ae4551 100644 --- a/formlets.rkt +++ b/formlets.rkt @@ -1,7 +1,8 @@ #lang racket (provide measurements-formlet - targets-formlet) + targets-formlet + fertilizer-formlet) (require gregor web-server/http @@ -19,7 +20,7 @@ date-b} date-b)) -(define (measurement-formlet nutrient) +(define (nutrient-value-formlet nutrient) (define id (nutrient-id nutrient)) (define number-input (input #:type "number" @@ -40,7 +41,7 @@ `(div ((class "mb-3")) (h5 "Valeurs du relevé") ,@(for/list ([nutrient (get-nutrients)]) - {=>* (measurement-formlet nutrient) measurements*})) + {=>* (nutrient-value-formlet nutrient) measurements*})) {=>* (submit "Enregistrer le relevé" #:attributes '((class "btn btn-primary"))) _}) (let ([measured-on (first measured-on*)] [nutrient-values (for/hash ([nv (in-list (filter pair? measurements*))]) @@ -85,3 +86,22 @@ [nutrient-values (average-crop-requirement-nutrient-values (filter pair? requirements*))]) (values effective-on nutrient-values)))) + +(define (name-formlet) + (define string-input (input #:type "string" #:attributes `((class "form-control")))) + (formlet (#%# (div ((class "mb-3")) ,{=> string-input string-value-b})) + (bytes->string/utf-8 (binding:form-value string-value-b)))) + +(define (fertilizer-formlet) + (formlet* (#%# `(div ((class "mb-3")) (h5 "Nom de référence") ,{=>* (name-formlet) canonical-name*}) + `(div ((class "mb-3")) (h5 "Nom de marque") ,{=>* (name-formlet) brand-name*}) + `(div ((class "mb-3")) + (h5 "Valeurs de l'intrant") + ,@(for/list ([nutrient (get-nutrients)]) + {=>* (nutrient-value-formlet nutrient) nutrient-values*})) + {=>* (submit "Enregistrer l'intrant" #:attributes '((class "btn btn-primary"))) _}) + (let ([canonical-name (first canonical-name*)] + [nutrient-values (for/hash ([nv (filter pair? nutrient-values*)]) + (values (car nv) (cdr nv)))] + [brand-name (first brand-name*)]) + (values canonical-name nutrient-values brand-name)))) diff --git a/handlers.rkt b/handlers.rkt index c022c3c..fb3f864 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -11,6 +11,7 @@ "models/user.rkt" "models/nutrient-measurement.rkt" "models/nutrient-target.rkt" + "models/fertilizer-product.rkt" "services/nnls.rkt") (define (wrap-basic-auth handler) @@ -34,6 +35,8 @@ [("measurement" "destroy") #:method "post" destroy-measurement] [("target" "new") #:method "get" new-target] [("target" "create") #:method "post" create-target] + [("fertilizer" "new") #:method "get" new-fertilizer] + [("fertilizer" "create") #:method "post" create-fertilizer] [("") #:method "get" index] [else fallback])) @@ -74,6 +77,19 @@ (create-nutrient-target! effective-on nutrient-values) (redirect-to "/ferti")) +;; Fertilizer products + +(define (new-fertilizer _) + (response/xexpr #:preamble #"<!DOCTYPE html>" (new-fertilizer-page))) + +(define (create-fertilizer req) + (define-values (canonical-name nutrient-values brand-name) + (formlet-process (fertilizer-formlet) req)) + (create-fertilizer-product! canonical-name nutrient-values brand-name) + (redirect-to "/ferti")) + +;; Fallback + (define (fallback _) (response/xexpr #:preamble #"<!DOCTYPE html>" (fallback-page 404))) @@ -4,6 +4,7 @@ ferti-page new-measurement-page new-target-page + new-fertilizer-page fallback-page) (require gregor @@ -12,7 +13,6 @@ "models/user.rkt" "models/nutrient.rkt" "models/nutrient-measurement.rkt" - "models/nutrient-target.rkt" "models/fertilizer-product.rkt") (define (page-template title body-xexpr) @@ -71,9 +71,18 @@ (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-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") @@ -89,7 +98,6 @@ (define (ferti-targets latest-measurement-hash latest-target-hash) `((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é") @@ -121,7 +129,6 @@ (define (ferti-measurements measurements) `((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") @@ -142,6 +149,15 @@ (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 (new-measurement-page) (page-template "Nouveau relevé" `((h1 ((class "display-1 mb-3")) "Nouveau relevé") @@ -156,6 +172,13 @@ (form ([action "/target/create"] [method "POST"]) ,@(formlet-display (targets-formlet))))))) +(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 "/fertilizer/create"] [method "POST"]) + ,@(formlet-display (fertilizer-formlet))))))) + (define (index-page user) (page-template "Bienvenue à la FAPG" |