#lang racket (provide app-dispatch) (require web-server/dispatch web-server/http web-server/formlets "views.rkt" "formlets.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)) (response/xexpr #:preamble #"" (index-page measurements))) ;; Nutrient measurements (define (new-measurement _) (response/xexpr #:preamble #"" (new-measurement-page))) (define (create-measurement req) (define-values (measured-on measurements) (formlet-process (measurements-formlet) req)) (create-nutrient-measurement! measured-on measurements) (redirect-to "/")) (define (destroy-measurement req) (delete-nutrient-measurement! req) (redirect-to "/")) ;; Nutrient targets (define (new-target _) (response/xexpr #:preamble #"" (new-target-page))) (define (create-target req) (define-values (effective-on crop-requirement-mix) (formlet-process (targets-formlet) req)) (define (average-nutrient-values mix) (define average-values (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 average-values)]) (cons k v))) (define target-nutrient-values (average-nutrient-values crop-requirement-mix)) (create-nutrient-target! effective-on target-nutrient-values) (redirect-to "/")) (define (fallback _) (response/xexpr #:preamble #"" (fallback-page 404)))