summaryrefslogtreecommitdiff
path: root/handlers.rkt
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)))
Copyright 2019--2025 Marius PETER