diff options
| -rw-r--r-- | handlers.rkt | 51 | ||||
| -rw-r--r-- | views.rkt | 82 |
2 files changed, 90 insertions, 43 deletions
diff --git a/handlers.rkt b/handlers.rkt index 051254b..fb95091 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -47,18 +47,29 @@ void)) (define-values (fapg-dispatch fapg-url) - (dispatch-rules [("ferti" "index") #:method "get" ferti-index] + (dispatch-rules [("index") #:method "get" index] + ;; Ferti + [("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] - [("target" "new") #:method "get" new-target] - [("target" "create") #:method "post" create-target] - [("fertilizer" "new") #:method "get" new-fertilizer] - [("fertilizer" "create") #:method "post" create-fertilizer] + ;; Nutrient measurements + [("ferti" "measurement" "new") #:method "get" new-measurement] + [("ferti" "measurement" "create") #:method "post" create-measurement] + [("ferti" "measurement" (integer-arg)) #:method "get" show-measurement] + [("ferti" "measurement" (integer-arg)) #:method "delete" destroy-measurement] + ;; Nutrient targets + [("ferti" "target" "new") #:method "get" new-target] + [("ferti" "target" "create") #:method "post" create-target] + [("ferti" "target" (integer-arg)) #:method "get" show-target] + [("ferti" "target" (integer-arg)) #:method "delete" destroy-target] + ;; Fertilizer products + [("ferti" "fertilizer" "new") #:method "get" new-fertilizer] + [("ferti" "fertilizer" "create") #:method "post" create-fertilizer] + [("ferti" "fertilizer" (integer-arg)) #:method "get" show-fertilizer] + [("ferti" "fertilizer" (integer-arg)) #:method "delete" destroy-fertilizer] + ;; Default [("") #:method "get" index] [else fallback])) @@ -104,8 +115,12 @@ (create-nutrient-measurement! measured-on nutrient-values) (redirect-to "/ferti/measurements")) -(define (destroy-measurement req) - (delete-nutrient-measurement! req) +(define (show-measurement _ id) + (define nm (get-nutrient-measurement #:id id)) + (render-page (show-measurement-page nm))) + +(define (destroy-measurement _ id) + (delete-nutrient-measurement! id) (redirect-to "/ferti/index")) ;; Nutrient targets @@ -118,6 +133,14 @@ (create-nutrient-target! effective-on nutrient-values) (redirect-to "/ferti/targets")) +(define (show-target _ id) + (define nt (get-nutrient-target #:id id)) + (render-page (show-target-page nt))) + +(define (destroy-target _ id) + (delete-nutrient-target! id) + (redirect-to "/ferti/targets")) + ;; Fertilizer products (define (new-fertilizer _) @@ -129,6 +152,14 @@ (create-fertilizer-product! canonical-name brand-name nutrient-values) (redirect-to "/ferti/fertilizers")) +(define (show-fertilizer _ id) + (define fp (get-fertilizer-product #:id id)) + (render-page (show-fertilizer-page fp))) + +(define (destroy-fertilizer _ id) + (delete-fertilizer-product! id) + (redirect-to "/ferti/fertilizers")) + ;; Fallback (define (fallback _) @@ -9,6 +9,9 @@ new-measurement-page new-target-page new-fertilizer-page + show-measurement-page + show-target-page + show-fertilizer-page fallback-page) (require gregor @@ -17,6 +20,7 @@ "models/user.rkt" "models/nutrient.rkt" "models/nutrient-measurement.rkt" + "models/nutrient-target.rkt" "models/fertilizer-product.rkt") (define (page-template title body-xexpr) @@ -89,28 +93,23 @@ (define (ferti-index-page) (ferti-template - '((p "La recette Ferti© est calculée en fonction d'un relevé de nutriments et d'une cible.") + `((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"))))) + (a ((class "btn btn-outline-primary") [href "/ferti/measurement/new"]) "Ajouter un relevé") + (a ((class "btn btn-outline-primary") [href "/ferti/target/new"]) "Créer une cible") + (a ((class "btn btn-outline-primary") [href "/ferti/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"]) + `(table ((class "table")) + (thead (tr (th "Date"))) + (tbody ,@(for/list ([m measurements]) + `(tr (td (a ((href ,(format "/ferti/measurement/~a" + (nutrient-measurement-id m)))) + ,(nutrient-measurement-date m)))))))) + (ferti-template `((h2 () "Relevés") (a ((class "btn btn-primary mb-3") [href + "/ferti/measurement/new"]) "Ajouter un relevé") ,table))) @@ -132,9 +131,9 @@ ,(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))) + (ferti-template `((h2 () "Dernière Cible") + (a ((class "btn btn-primary mb-3") [href "/ferti/target/new"]) "Créer une cible") + ,table))) (define (ferti-recipe-page fertilizer-recipe) (define table @@ -162,7 +161,8 @@ ,@(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"]) + (ferti-template `((h2 () "Intrants") (a ((class "btn btn-primary mb-3") [href + "/ferti/fertilizer/new"]) "Ajouter un intrant") ,table))) @@ -170,32 +170,48 @@ (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"]) + (form ([action "/ferti/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"]) + (form ([action "/ferti/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"]) + (form ([action "/ferti/fertilizer/create"] [method "POST"]) ,@(formlet-display (fertilizer-formlet))))))) +(define (show-measurement-page nm) + (page-template (format "Relevé du ~a" (nutrient-measurement-date nm)) + '((h1 ((class "display-1 mb-3")) "Relevé")))) + +(define (show-target-page nt) + (page-template (format "Cible ~a" (nutrient-target-id nt)) + '((h1 ((class "display-1 mb-3")) "Cible")))) + +(define (show-fertilizer-page fp) + (page-template (format "Intrant ~a" (fertilizer-product-id fp)) + '((h1 ((class "display-1 mb-3")) "Intrant")))) + (define (index-page user) - (page-template "Bienvenue à la FAPG" - `((h1 ((class "display-1 mb-3")) - ,(string-join (list (if (<= (->hours (current-time)) 17) "Bonjour" "Bonsoir") - (if user - (user-name user) - "et bienvenue")))) - (p ,(~t (now) "'Dernière connexion à' HH:mm, 'le' EEEE d MMMM yyyy")) - (a ((class "btn btn-primary mb-3") [href "/ferti/index"]) "Accéder à Ferti")))) + (page-template + "Bienvenue à la FAPG" + `((div ((class "jumbotron")) + (h1 ((class "display-1 mb-3")) + ,(string-join (list (if (<= (->hours (current-time)) 17) "Bonjour" "Bonsoir") + (if user + (user-name user) + "et bienvenue")))) + (hr ((class "my-3"))) + (p ((class "lead")) ,(~t (now) "'Dernière connexion à' HH:mm, 'le' EEEE d MMMM yyyy")) + (p ((class "lead")) + (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) |