diff options
Diffstat (limited to 'handlers.rkt')
| -rw-r--r-- | handlers.rkt | 65 | 
1 files changed, 52 insertions, 13 deletions
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 #"<!DOCTYPE html>"     (index-page measurements))) + +;; Nutrient measurements +  (define (new-measurement _)    (response/xexpr     #:preamble #"<!DOCTYPE html>" @@ -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 #"<!DOCTYPE html>" -   (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 #"<!DOCTYPE html>" +   (fallback-page 404)))  |