blob: 0fe131f848273d74d6272cee0ccefdcc8db06b23 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
|
#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 #"<!DOCTYPE html>"
(index-page measurements)))
;; Nutrient measurements
(define (new-measurement _)
(response/xexpr
#:preamble #"<!DOCTYPE html>"
(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 #"<!DOCTYPE html>"
(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 #"<!DOCTYPE html>"
(fallback-page 404)))
|