Absorb existing domain data.

1 files changed, 53 insertions, 0 deletions

diff --git a/formlets.rkt b/formlets.rkt
new file mode 100644
index 0000000..406a54a
--- /dev/null
+++ b/formlets.rkt
@@ -0,0 +1,53 @@
+#lang racket
+
+(provide measurements-formlet)
+
+(require gregor
+         web-server/http
+         web-server/formlets
+         "models/nutrient.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))))