summaryrefslogtreecommitdiff
path: root/formlets.rkt
blob: 20a84d842f33a9efff2b24d8783e90c3dd7593a1 (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
#lang racket

(provide measurements-formlet
         targets-formlet)

(require gregor
         web-server/http
         web-server/formlets
         "models/nutrient.rkt"
         "models/crop.rkt"
         "models/crop-requirement.rkt")

(define date-formlet
  (formlet ,{=>
             (to-string (required (input #:type "date"
                                         #:value (date->iso8601 (today))
                                         #:attributes
                                         '((class "form-control") [required "required"]))))
             date-b}
           date-b))

(define (measurement-formlet nutrient)
  (define id (nutrient-id nutrient))
  (define number-input
    (input #:type "number"
           #:attributes `((class "form-control") [id ,(number->string id)]
                                                 [step "0.1"]
                                                 [placeholder ,(nutrient-name nutrient)])))
  (define input-label
    `(label ((for ,(number->string id)
               ))
            ,(nutrient-name nutrient)))
  (formlet (#%# (div ((class "form-floating mb-3")) ,{=> number-input nutrient-value-b} ,input-label))
           (let ([nutrient-value (string->number (bytes->string/utf-8
                                                  (binding:form-value nutrient-value-b)))])
             (and nutrient-value (cons id nutrient-value)))))

(define (measurements-formlet)
  (formlet* (#%# `(div ((class "mb-3")) (h5 "Date du relevé") ,{=>* date-formlet measured-on*})
                 `(div ((class "mb-3"))
                       (h5 "Valeurs du relevé")
                       ,@(for/list ([nutrient (get-nutrients)])
                           {=>* (measurement-formlet nutrient) measurements*}))
                 {=>* (submit "Enregistrer le relevé" #:attributes '((class "btn btn-primary"))) _})
            (let ([measured-on (first measured-on*)]
                  [measurements (filter pair? measurements*)]) ; drop #f’s from empty values
              (values measured-on measurements))))

(define (crop-requirement-formlet requirement)
  (define id (crop-requirement-id requirement))
  (define profile (crop-requirement-profile requirement))
  (define maybe-crop (crop-requirement-crop-id requirement))
  (define crop
    (if maybe-crop
        (crop-name (get-crop #:id maybe-crop))
        #f))
  (define number-input
    (input #:type "number"
           #:attributes
           `((class "form-control") [id ,(number->string id)] [step "1"] [placeholder ,profile])))
  (define input-label
    `(label ((for ,(number->string id)
               ))
            ,(if crop
                 (format "~a (~a)" crop profile)
                 (format "~a" profile))))
  (formlet
   (#%# (div ((class "form-floating mb-3")) ,{=> number-input requirement-proportion-b} ,input-label))
   (let ([requirement-proportion
          (string->number (bytes->string/utf-8 (binding:form-value requirement-proportion-b)))])
     (and requirement-proportion (cons requirement requirement-proportion)))))

(define (targets-formlet)
  (formlet* (#%# `(div ((class "mb-3")) (h5 "Date ciblée") ,{=>* date-formlet effective-on*})
                 `(div ((class "mb-3"))
                       (h5 "Valeurs cibles")
                       ,@(for/list ([requirement (get-crop-requirements)])
                           {=>* (crop-requirement-formlet requirement) requirements*}))
                 {=>* (submit "Enregistrer la cible" #:attributes '((class "btn btn-primary"))) _})
            (let ([effective-on (first effective-on*)]
                  [requirements (filter pair? requirements*)]) ; drop #f’s from empty values
              (values effective-on requirements))))
Copyright 2019--2026 Marius PETER