Add fertilizer product creation logic.

1 files changed, 23 insertions, 3 deletions

diff --git a/formlets.rkt b/formlets.rkt
index f24c84f..6ae4551 100644
--- a/formlets.rkt
+++ b/formlets.rkt
@@ -1,7 +1,8 @@
 #lang racket
 
 (provide measurements-formlet
-         targets-formlet)
+         targets-formlet
+         fertilizer-formlet)
 
 (require gregor
          web-server/http
@@ -19,7 +20,7 @@
              date-b}
            date-b))
 
-(define (measurement-formlet nutrient)
+(define (nutrient-value-formlet nutrient)
   (define id (nutrient-id nutrient))
   (define number-input
     (input #:type "number"
@@ -40,7 +41,7 @@
                  `(div ((class "mb-3"))
                        (h5 "Valeurs du relevé")
                        ,@(for/list ([nutrient (get-nutrients)])
-                           {=>* (measurement-formlet nutrient) measurements*}))
+                           {=>* (nutrient-value-formlet nutrient) measurements*}))
                  {=>* (submit "Enregistrer le relevé" #:attributes '((class "btn btn-primary"))) _})
             (let ([measured-on (first measured-on*)]
                   [nutrient-values (for/hash ([nv (in-list (filter pair? measurements*))])
@@ -85,3 +86,22 @@
                   [nutrient-values (average-crop-requirement-nutrient-values (filter pair?
                                                                                      requirements*))])
               (values effective-on nutrient-values))))
+
+(define (name-formlet)
+  (define string-input (input #:type "string" #:attributes `((class "form-control"))))
+  (formlet (#%# (div ((class "mb-3")) ,{=> string-input string-value-b}))
+           (bytes->string/utf-8 (binding:form-value string-value-b))))
+
+(define (fertilizer-formlet)
+  (formlet* (#%# `(div ((class "mb-3")) (h5 "Nom de référence") ,{=>* (name-formlet) canonical-name*})
+                 `(div ((class "mb-3")) (h5 "Nom de marque") ,{=>* (name-formlet) brand-name*})
+                 `(div ((class "mb-3"))
+                       (h5 "Valeurs de l'intrant")
+                       ,@(for/list ([nutrient (get-nutrients)])
+                           {=>* (nutrient-value-formlet nutrient) nutrient-values*}))
+                 {=>* (submit "Enregistrer l'intrant" #:attributes '((class "btn btn-primary"))) _})
+            (let ([canonical-name (first canonical-name*)]
+                  [nutrient-values (for/hash ([nv (filter pair? nutrient-values*)])
+                                     (values (car nv) (cdr nv)))]
+                  [brand-name (first brand-name*)])
+              (values canonical-name nutrient-values brand-name))))