diff options
| -rw-r--r-- | formlets.rkt | 19 | ||||
| -rw-r--r-- | handlers.rkt | 37 | ||||
| -rw-r--r-- | models/crop.rkt | 5 | ||||
| -rw-r--r-- | views.rkt | 63 |
4 files changed, 111 insertions, 13 deletions
diff --git a/formlets.rkt b/formlets.rkt index c2923ad..17b9448 100644 --- a/formlets.rkt +++ b/formlets.rkt @@ -3,6 +3,7 @@ (provide measurements-formlet rotation-formlet fertilizer-formlet + crop-formlet crop-requirements-formlet) (require gregor @@ -86,6 +87,24 @@ [nutrient-values (make-immutable-hash nutrient-values*)]) (fertilizer-product id canonical-name brand-name nutrient-values)))) +(define (crop-formlet #:value [c #f]) + (formlet* (#%# (=>* (to-string (required (hidden (if c + (number->string (crop-id c)) + "")))) + id*) + `(div ((class "mb-3")) + (h5 "Culture") + ,(=>* (required-string-input #:value (if c + (crop-name c) + "")) + crop-name*)) + (=>* (submit (string-join (list (if c "Modifier" "Enregistrer") "la culture")) + #:attributes '((class "btn btn-primary"))) + _)) + (let ([id (string->number (first id*))] + [crop-name (first crop-name*)]) + (crop id crop-name)))) + (define (crop-requirements-formlet #:value [cr #f]) (formlet* (#%# (=>* (to-string (required (hidden (if cr (number->string (crop-requirement-id cr)) diff --git a/handlers.rkt b/handlers.rkt index e38ece8..d61e942 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -11,6 +11,7 @@ "formlets.rkt" "models/user.rkt" "models/nutrient-measurement.rkt" + "models/crop.rkt" "models/crop-requirement.rkt" "models/crop-rotation.rkt" "models/fertilizer-product.rkt" @@ -35,6 +36,13 @@ [("ferti" "measurements" (integer-arg) "edit") #:method "get" edit-measurement] [("ferti" "measurements" "update") #:method "post" update-measurement] [("ferti" "measurements" (integer-arg) "destroy") #:method "get" destroy-measurement] + ;; Crops + [("ferti" "crops" "new") #:method "get" new-crop] + [("ferti" "crops" "create") #:method "post" create-crop] + [("ferti" "crops" (integer-arg)) #:method "get" show-crop] + [("ferti" "crops" (integer-arg) "edit") #:method "get" edit-crop] + [("ferti" "crops" "update") #:method "post" update-crop] + [("ferti" "crops" (integer-arg) "destroy") #:method "get" destroy-crop] ;; Crop rotations [("ferti" "rotations" "new") #:method "get" new-rotation] [("ferti" "rotations" "new" (string-arg)) #:method "get" new-rotation-for-date] @@ -117,6 +125,35 @@ (delete-nutrient-measurement! id) (redirect-to "/ferti/measurements-and-rotations")) +;; Crops + +(define (new-crop _) + (render-page (new-crop-page))) + +(define (create-crop req) + (define new-crop (formlet-process (crop-formlet) req)) + (if (get-crop #:name (crop-name new-crop)) + (update-crop! new-crop) + (create-crop! new-crop)) + (redirect-to "/ferti/crop-requirements")) + +(define (show-crop _ id) + (define crop (get-crop #:id id)) + (render-page (show-crop-page crop))) + +(define (edit-crop _ id) + (define crop (get-crop #:id id)) + (render-page (edit-crop-page crop))) + +(define (update-crop req) + (define edited-crop (formlet-process (crop-formlet) req)) + (update-crop! edited-crop) + (redirect-to "/ferti/crop-requirements")) + +(define (destroy-crop _ id) + (delete-crop! id) + (redirect-to "/ferti/crop-requirements")) + ;; Crop rotations (define (new-rotation _) diff --git a/models/crop.rkt b/models/crop.rkt index b37ec47..135de7d 100644 --- a/models/crop.rkt +++ b/models/crop.rkt @@ -4,7 +4,7 @@ crop? crop-id crop-name - (contract-out [create-crop! (-> string? crop?)] + (contract-out [create-crop! (-> crop? crop?)] [get-crops (-> (listof crop?))] [get-crop (->* () (#:id db-id? #:name string?) (or/c crop? #f))] [update-crop! (->* (db-id?) (#:name string?) (or/c crop? #f))] @@ -19,7 +19,8 @@ ;; CREATE -(define (create-crop! name) +(define (create-crop! c) + (define name (crop-name c)) (or (get-crop #:name name) (with-tx (query-exec (current-conn) (insert #:into crops #:set [canonical_name ,name])) (get-crop #:name name)))) @@ -9,14 +9,17 @@ new-measurement-page new-rotation-page new-fertilizer-page + new-crop-page + new-crop-requirement-page edit-measurement-page edit-fertilizer-page + edit-crop-page + edit-crop-requirement-page show-measurement-page show-rotation-page show-fertilizer-page + show-crop-page show-crop-requirement-page - new-crop-requirement-page - edit-crop-requirement-page fallback-page) (require gregor @@ -167,17 +170,19 @@ `(table ((class "table table-striped")) (tr (th "Profil") (th "Culture")) ,@(for/list ([cr crop-requirements]) - (define crop-id (crop-requirement-crop-id cr)) + (define cid (crop-requirement-crop-id cr)) `(tr (td (a ((href ,(format "/ferti/crop-requirements/~a" (crop-requirement-id cr)))) ,(string-titlecase (crop-requirement-profile cr)))) - (td ,(if crop-id - (string-titlecase (crop-name (get-crop #:id crop-id))) + (td ,(if cid + (let ([crop (get-crop #:id cid)]) + `(a ((href ,(format "/ferti/crops/~a" cid))) + ,(string-titlecase (crop-name crop)))) "—")))))) (define button-group '(div ((class "btn-group mb-3")) (a ((class "btn btn-primary") [href "/ferti/crop-requirements/new"]) "Ajouter un profil") - (a ((class "btn btn-secondary") [href "/ferti/crop/new"]) "Ajouter une culture"))) - (ferti-template "Cultures" `(,button-group ,table))) + (a ((class "btn btn-secondary") [href "/ferti/crops/new"]) "Ajouter une culture"))) + (ferti-template "Cultures" (list button-group accordion))) ;; TODO: add bar chart for comparing to target concentrations (define (ferti-recipe-page recipe-date fertilizer-recipe) @@ -218,6 +223,9 @@ (define (new-fertilizer-page) (form-page-template "Nouvel intrant" "/ferti/fertilizers/create" (fertilizer-formlet))) +(define (new-crop-page) + (form-page-template "Nouvelle culture" "/ferti/crops/create" (crop-formlet))) + (define (new-crop-requirement-page) (form-page-template "Nouveau profil" "/ferti/crop-requirements/create" (crop-requirements-formlet))) @@ -229,7 +237,12 @@ (measurements-formlet #:value nm))) (define (edit-fertilizer-page fp) - (form-page-template "Modifier intrant" "/ferti/fertilizers/update" (fertilizer-formlet #:value fp))) + (form-page-template "Modifier l'intrant" + "/ferti/fertilizers/update" + (fertilizer-formlet #:value fp))) + +(define (edit-crop-page crop) + (form-page-template "Modifier la culture" "/ferti/crops/update" (crop-formlet #:value crop))) (define (edit-crop-requirement-page cr) (form-page-template "Modifier profil" @@ -285,7 +298,7 @@ (define (show-fertilizer-page fp) (define id (fertilizer-product-id fp)) - (define product-name (fertilizer-product-name fp)) + (define product-name (string-titlecase (fertilizer-product-name fp))) (define brand-name (fertilizer-brand-name fp)) (define sorted-nutrient-values (get-sorted-nutrient-values (fertilizer-product-values fp))) (define table @@ -307,9 +320,33 @@ ,button-group ,table))) +(define (show-crop-page crop) + (define id (crop-id crop)) + (define name (string-titlecase (crop-name crop))) + (define crop-requirements-for-crop + (filter (λ (cr) (equal? (crop-requirement-crop-id cr) (crop-id crop))) (get-crop-requirements))) + (define profile-list + `(ul ,@(for/list ([cr crop-requirements-for-crop]) + `(li (a ([href ,(format "/ferti/crop-requirements/~a" (crop-requirement-id cr))]) + ,(string-titlecase crop-requirement-profile cr)))))) + (define button-group + `(div ((class "btn-group mb-3")) + (a ((class "btn btn-primary") [href ,(format "/ferti/crops/~a/edit" id)]) "Modifier") + (a ((class "btn btn-danger") [href ,(format "/ferti/crops/~a/destroy" id)]) "Supprimer"))) + (page-template name `((h1 ((class "display-1 mb-3")) ,name) ,button-group ,profile-list))) + (define (show-crop-requirement-page cr) (define id (crop-requirement-id cr)) - (define title (string-titlecase (crop-requirement-profile cr))) + (define cid (crop-requirement-crop-id cr)) + (define crop + (if cid + (string-titlecase (crop-name (get-crop #:id cid))) + #f)) + (define profile (string-titlecase (crop-requirement-profile cr))) + (define title + (if crop + (format "~a — ~a" crop profile) + profile)) (define table `(table ((class "table") (style "max-width: 30em")) (thead (tr (th "Nutriment") (th ((class "text-end")) "Concentration (mg/L)"))) @@ -323,7 +360,11 @@ "Modifier") (a ((class "btn btn-danger") [href ,(format "/ferti/crop-requirements/~a/destroy" id)]) "Supprimer"))) - (page-template title `((h1 ((class "display-1 mb-3")) ,title) ,button-group ,table))) + (page-template title + `((h1 ((class "display-1 mb-3")) ,profile) (h5 ((class "display-5 mb-3")) + ,(or crop "Profil générique")) + ,button-group + ,table))) (define (index-page user) (page-template |