From 86b5343292e852155dab10fc8db39c2dd2b932eb Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Tue, 21 Oct 2025 21:36:09 +0200 Subject: Added views, formlets, and handlers for nutrient target management. --- handlers.rkt | 65 ++++++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 52 insertions(+), 13 deletions(-) (limited to 'handlers.rkt') diff --git a/handlers.rkt b/handlers.rkt index 42e4a76..aa380aa 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -8,8 +8,22 @@ "views.rkt" "formlets.rkt" "models/nutrient.rkt" - "models/nutrient-measurement.rkt") + "models/nutrient-measurement.rkt" + "models/nutrient-target.rkt" + "models/crop-requirement.rkt") +(define-values (app-dispatch _) + (dispatch-rules + ;; Nutrient measurements + [("measurement" "new") #:method "get" new-measurement] + [("measurement" "create") #:method "post" create-measurement] + [("measurement" "destroy") #:method "post" destroy-measurement] + ;; Nutrient targets + [("target" "new") #:method "get" new-target] + [("target" "create") #:method "post" create-target] + ;; Index + [("") #:method "get" index] + [else fallback])) (define (index _) (define measurements (get-nutrient-measurements)) @@ -17,6 +31,9 @@ #:preamble #"" (index-page measurements))) + +;; Nutrient measurements + (define (new-measurement _) (response/xexpr #:preamble #"" @@ -29,20 +46,42 @@ (redirect-to "/")) (define (destroy-measurement req) - (define-values (measured-on measurements) - (formlet-process (measurements-formlet) req)) - (create-nutrient-measurement! measured-on measurements) + (delete-nutrient-measurement! req) (redirect-to "/")) -(define (fallback req) + +;; Nutrient targets + +(define (new-target _) (response/xexpr #:preamble #"" - (fallback-page 404))) + (new-target-page))) -(define-values (app-dispatch app-url) - (dispatch-rules - [("measurement" "new") #:method "get" new-measurement] - [("measurement" "create") #:method "post" create-measurement] - [("measurement" "destroy") #:method "post" destroy-measurement] - [("") #:method "get" index] - [else fallback])) +(define (create-target req) + (define-values (effective-on crop-requirement-mix) + (formlet-process (targets-formlet) req)) + + (define (average-nutrient-values mix) + (define totals + (for/fold ([acc (hash)]) ([pair (in-list mix)]) + (define crop-requirement (car pair)) + (define percentage (/ (cdr pair) 100)) + (for/fold ([acc acc]) + ([nv (in-list (get-crop-requirement-values crop-requirement))]) + (define n (car nv)) + (define v (cdr nv)) + (hash-update acc n + (λ (old) (+ old (* v percentage))) + (λ () (* v percentage)))))) + (for/list ([(k v) (in-hash totals)]) + (cons k v))) + + (define target-nutrient-values (average-nutrient-values crop-requirement-mix)) + (pretty-display target-nutrient-values) + (create-nutrient-target! effective-on target-nutrient-values) + (redirect-to "/")) + +(define (fallback _) + (response/xexpr + #:preamble #"" + (fallback-page 404))) -- cgit v1.2.3