Add French name to nutrient model.

9 files changed, 127 insertions, 95 deletions

diff --git a/db/migrations.rkt b/db/migrations.rkt
index 48e788f..d07b130 100644
--- a/db/migrations.rkt
+++ b/db/migrations.rkt
@@ -49,6 +49,7 @@
                   (list (create-table #:if-not-exists nutrients
                                       #:columns [id integer #:not-null]
                                       [canonical_name text #:not-null]
+                                      [french_name text #:not-null]
                                       [formula text #:not-null]
                                       #:constraints (primary-key id)
                                       (unique canonical_name)
diff --git a/db/seed.rkt b/db/seed.rkt
index 9693e89..7530651 100644
--- a/db/seed.rkt
+++ b/db/seed.rkt
@@ -23,28 +23,27 @@
         seed-existing-fertilizer-products!))
 
 (define (seed-nutrients!)
-  (define nutrient-names (map nutrient-name (get-nutrients)))
+  (define nutrient-names (map nutrient-canonical-name (get-nutrients)))
   (define default-nutrients
-    '(("Nitrate Nitrogen" . "NNO3") ("Phosphorus" . "P")
-                                    ("Potassium" . "K")
-                                    ("Calcium" . "Ca")
-                                    ("Magnesium" . "Mg")
-                                    ("Sulfur" . "S")
-                                    ("Sodium" . "Na")
-                                    ("Chloride" . "Cl")
-                                    ("Silicon" . "Si")
-                                    ("Iron" . "Fe")
-                                    ("Zinc" . "Zn")
-                                    ("Boron" . "B")
-                                    ("Manganese" . "Mn")
-                                    ("Copper" . "Cu")
-                                    ("Molybdenum" . "Mo")
-                                    ("Ammonium Nitrogen" . "NNH4")))
-  (with-tx (for ([pair (in-list default-nutrients)])
-             (match-define (cons name formula) pair)
-             ;; Ensure idempotence
-             (unless (member name nutrient-names)
-               (create-nutrient! name formula)))))
+    '(("Nitrate Nitrogen" "Azote nitrique" "NNO3") ("Phosphorus" "Phosphore" "P")
+                                                   ("Potassium" "Potassium" "K")
+                                                   ("Calcium" "Calcium" "Ca")
+                                                   ("Magnesium" "Magnésium" "Mg")
+                                                   ("Sulfur" "Soufre" "S")
+                                                   ("Sodium" "Sodium" "Na")
+                                                   ("Chloride" "Chlore" "Cl")
+                                                   ("Silicon" "Silicium" "Si")
+                                                   ("Iron" "Fer" "Fe")
+                                                   ("Zinc" "Zinc" "Zn")
+                                                   ("Boron" "Bore" "B")
+                                                   ("Manganese" "Manganèse" "Mn")
+                                                   ("Copper" "Cuivre" "Cu")
+                                                   ("Molybdenum" "Molybdène" "Mo")
+                                                   ("Ammonium Nitrogen" "Azote ammoniacal" "NNH4")))
+  (with-tx (for ([nutrient-data (in-list default-nutrients)])
+             (match-define (list canonical-name french-name formula) nutrient-data)
+             (unless (member canonical-name nutrient-names)
+               (create-nutrient! canonical-name french-name formula)))))
 
 (define-runtime-path measurement-csv "data/dolibarr_nutrient_measurements_ppm.csv")
 (define (seed-historical-nutrient-measurements!)
diff --git a/formlets.rkt b/formlets.rkt
index d96f374..ce92129 100644
--- a/formlets.rkt
+++ b/formlets.rkt
@@ -22,11 +22,11 @@
     (input #:type "number"
            #:attributes `((class "form-control") [id ,(number->string id)]
                                                  [step "0.1"]
-                                                 [placeholder ,(nutrient-name nutrient)])))
+                                                 [placeholder ,(nutrient-french-name nutrient)])))
   (define input-label
     `(label ((for ,(number->string id)
                ))
-            ,(nutrient-name nutrient)))
+            ,(nutrient-french-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)))])
diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt
index fb14777..c0eb753 100644
--- a/models/crop-requirement.rkt
+++ b/models/crop-requirement.rkt
@@ -80,6 +80,7 @@
                         cr.crop_id
                         n.id
                         n.canonical_name
+                        n.french_name
                         n.formula
                         nv.value_ppm
                         #:from (TableExpr:AST ,joined)
@@ -98,7 +99,6 @@
       [profile (scalar-expr-qq (= cr.profile ,profile))]
       [crop-id (scalar-expr-qq (= cr.crop_id ,crop-id))]
       [else (error 'get-crop-requirement "one of #:id, #:profile or #:crop-id must be provided")]))
-
   (define grouped-rows
     (query-rows (current-conn)
                 (select cr.id
@@ -106,27 +106,28 @@
                         cr.crop_id
                         n.id
                         n.canonical_name
+                        n.french_name
                         n.formula
                         nv.value_ppm
                         #:from (TableExpr:AST ,joined)
                         #:where (ScalarExpr:AST ,where))
                 #:group '#(0 1 2)))
-
   (match grouped-rows
     ['() #f]
     [(list row) (grouped-row->crop-requirement row)]
     [many (error 'get-crop-requirement "expected 1 crop requirement, got ~a" (length many))]))
 
 (define (get-crop-requirement-values crop-requirement)
-  (for/hash ([(nutrient-id name formula value_ppm)
+  (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
               (in-query (current-conn)
                         (select n.id
                                 n.canonical_name
+                                n.french_name
                                 n.formula
                                 nv.value_ppm
                                 #:from (TableExpr:AST ,joined)
                                 #:where (= cr.id ,(crop-requirement-id crop-requirement))))])
-    (values (nutrient nutrient-id name formula) value_ppm)))
+    (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
 
 (define (get-crop-requirement-value crop-requirement nutrient)
   (query-maybe-value (current-conn)
diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt
index 347d141..b0ac7de 100644
--- a/models/fertilizer-product.rkt
+++ b/models/fertilizer-product.rkt
@@ -39,7 +39,7 @@
     (for ([(n v) (in-hash (fertilizer-product-nutrient-values v))])
       (fprintf out
                "~a ~a\n"
-               (~a (nutrient-name n) #:min-width 14)
+               (~a (nutrient-canonical-name n) #:min-width 14)
                (~a v #:max-width 6 #:align 'right)))))
 
 ;; CREATE
@@ -91,6 +91,7 @@
                         fp.brand_name
                         n.id
                         n.canonical_name
+                        n.french_name
                         n.formula
                         nv.value_ppm
                         #:from (TableExpr:AST ,joined)
@@ -115,6 +116,7 @@
                         fp.brand_name
                         n.id
                         n.canonical_name
+                        n.french_name
                         n.formula
                         nv.value_ppm
                         #:from (TableExpr:AST ,joined)
@@ -128,15 +130,16 @@
     [many (error 'get-fertilizer-product "expected 1 fertilizer product, got ~a" (length many))]))
 
 (define (get-fertilizer-product-values fertilizer-product)
-  (for/hash ([(nutrient-id name formula value_ppm)
+  (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
               (in-query (current-conn)
                         (select n.id
                                 n.canonical_name
+                                n.french_name
                                 n.formula
                                 nv.value_ppm
                                 #:from (TableExpr:AST ,joined)
                                 #:where (= fp.id ,(fertilizer-product-id fertilizer-product))))])
-    (values (nutrient nutrient-id name formula) value_ppm)))
+    (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
 
 (define (get-fertilizer-product-value fertilizer-product nutrient)
   (query-maybe-value (current-conn)
diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt
index 3e8213d..5b5f93d 100644
--- a/models/nutrient-measurement.rkt
+++ b/models/nutrient-measurement.rkt
@@ -35,7 +35,7 @@
     (for ([(n v) (in-hash (nutrient-measurement-nutrient-values v))])
       (fprintf out
                "~a ~a\n"
-               (~a (nutrient-name n) #:min-width 14)
+               (~a (nutrient-canonical-name n) #:min-width 14)
                (~a v #:max-width 6 #:align 'right)))))
 
 ;; CREATE
@@ -83,6 +83,7 @@
                         nm.measured_on
                         n.id
                         n.canonical_name
+                        n.french_name
                         n.formula
                         nv.value_ppm
                         #:from (TableExpr:AST ,joined)
@@ -106,6 +107,7 @@
                         nm.measured_on
                         n.id
                         n.canonical_name
+                        n.french_name
                         n.formula
                         nv.value_ppm
                         #:from (TableExpr:AST ,joined)
@@ -119,15 +121,16 @@
     [many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))]))
 
 (define (get-nutrient-measurement-values nutrient-measurement)
-  (for/hash ([(nutrient-id name formula value_ppm)
+  (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
               (in-query (current-conn)
                         (select n.id
                                 n.canonical_name
+                                n.french_name
                                 n.formula
                                 nv.value_ppm
                                 #:from (TableExpr:AST ,joined)
                                 #:where (= nm.id ,(nutrient-measurement-id nutrient-measurement))))])
-    (values (nutrient nutrient-id name formula) value_ppm)))
+    (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
 
 (define (get-nutrient-measurement-value nutrient-measurement nutrient)
   (query-maybe-value (current-conn)
@@ -146,19 +149,23 @@
                              #:limit 1)))
 
 (define (get-latest-nutrient-measurement-hash)
-  (for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn)
-                                                              (select n.id
-                                                                      n.canonical_name
-                                                                      n.formula
-                                                                      nm.measured_on
-                                                                      nv.value_ppm
-                                                                      #:from (TableExpr:AST ,joined)
-                                                                      #:order-by nm.measured_on
-                                                                      #:desc)
-                                                              #:group '(#(0 1 2)))])
+  (define grouped-rows
+    (query-rows (current-conn)
+                (select n.id
+                        n.canonical_name
+                        n.french_name
+                        n.formula
+                        nm.measured_on
+                        nv.value_ppm
+                        #:from (TableExpr:AST ,joined)
+                        #:order-by nm.measured_on
+                        #:desc)
+                #:group '(#(0 1 2 3))))
+  (for/hash ([row grouped-rows])
+    (match-define (vector n-id n-canonical-name n-french-name n-formula residual-rows) row)
     ;; residual-rows is a non-empty list of vectors: #(measured_on value_ppm)
     (match-define (vector _measured-on value-ppm) (first residual-rows))
-    (values (nutrient n-id n-name n-formula) value-ppm)))
+    (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm)))
 
 ;; UPDATE
 
diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt
index ce4d561..cffa657 100644
--- a/models/nutrient-target.rkt
+++ b/models/nutrient-target.rkt
@@ -32,7 +32,7 @@
     (for ([(n v) (in-hash (nutrient-target-nutrient-values v))])
       (fprintf out
                "~a ~a\n"
-               (~a (nutrient-name n) #:min-width 14)
+               (~a (nutrient-canonical-name n) #:min-width 14)
                (~a v #:max-width 6 #:align 'right)))))
 
 ;; CREATE
@@ -78,6 +78,7 @@
                                             nt.effective_on
                                             n.id
                                             n.canonical_name
+                                            n.french_name
                                             n.formula
                                             nv.value_ppm
                                             #:from (TableExpr:AST ,joined)
@@ -100,6 +101,7 @@
                         nt.effective_on
                         n.id
                         n.canonical_name
+                        n.french_name
                         n.formula
                         nv.value_ppm
                         #:from (TableExpr:AST ,joined)
@@ -113,15 +115,16 @@
     [many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))]))
 
 (define (get-nutrient-target-values nutrient-target)
-  (for/hash ([(nutrient-id name formula value_ppm)
+  (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
               (in-query (current-conn)
                         (select n.id
                                 n.canonical_name
+                                n.french_name
                                 n.formula
                                 nv.value_ppm
                                 #:from (TableExpr:AST ,joined)
                                 #:where (= nt.id ,(nutrient-target-id nutrient-target))))])
-    (values (nutrient nutrient-id name formula) value_ppm)))
+    (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
 
 (define (get-nutrient-target-value nutrient-target nutrient)
   (query-maybe-value (current-conn)
@@ -140,19 +143,23 @@
                              #:limit 1)))
 
 (define (get-latest-nutrient-target-hash)
-  (for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn)
-                                                              (select n.id
-                                                                      n.canonical_name
-                                                                      n.formula
-                                                                      nt.effective_on
-                                                                      nv.value_ppm
-                                                                      #:from (TableExpr:AST ,joined)
-                                                                      #:order-by nt.effective_on
-                                                                      #:desc)
-                                                              #:group '(#(0 1 2)))])
+  (define grouped-rows
+    (query-rows (current-conn)
+                (select n.id
+                        n.canonical_name
+                        n.french_name
+                        n.formula
+                        nt.effective_on
+                        nv.value_ppm
+                        #:from (TableExpr:AST ,joined)
+                        #:order-by nt.effective_on
+                        #:desc)
+                #:group '(#(0 1 2 3))))
+  (for/hash ([row grouped-rows])
+    (match-define (vector n-id n-canonical-name n-french-name n-formula residual-rows) row)
     ;; residual-rows is a non-empty list of vectors: #(effective_on value_ppm)
     (match-define (vector _effective-on value-ppm) (first residual-rows))
-    (values (nutrient n-id n-name n-formula) value-ppm)))
+    (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm)))
 
 ;; UPDATE
 
diff --git a/models/nutrient.rkt b/models/nutrient.rkt
index 3e2767b..fd78cc8 100644
--- a/models/nutrient.rkt
+++ b/models/nutrient.rkt
@@ -3,10 +3,11 @@
 (provide nutrient
          nutrient?
          nutrient-id
-         nutrient-name
+         nutrient-canonical-name
+         nutrient-french-name
          nutrient-formula
          nutrient-value-hash/c
-         (contract-out [create-nutrient! (-> string? string? nutrient?)]
+         (contract-out [create-nutrient! (-> string? string? string? nutrient?)]
                        [get-nutrients (-> (listof nutrient?))]
                        [get-nutrient
                         (->* ()
@@ -27,54 +28,66 @@
          sql
          "../db/conn.rkt")
 
-(struct nutrient (id name formula)
+(struct nutrient (id canonical-name french-name formula)
   #:transparent
   #:property prop:custom-write
-  (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-name v))))
+  (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-canonical-name v))))
 
 (define nutrient-value-hash/c (hash/c nutrient? (and/c real? (>=/c 0)) #:immutable #t))
 
-;; vector/c id, nutrient name, nutrient formula, value (ppm)
-(define residual-vector/c (vector/c exact-nonnegative-integer? string? string? real?))
+;; vector/c id, canonical name, french name, nutrient formula, value (ppm)
+(define residual-vector/c (vector/c exact-nonnegative-integer? string? string? string? real?))
 
 (define (residuals->nutrient-value-hash residuals)
   (for/hash ([r (in-list residuals)])
-    (match-define (vector n-id n-name n-formula value-ppm) r)
-    (values (nutrient n-id n-name n-formula) value-ppm)))
+    (match-define (vector n-id n-canonical-name n-french-name n-formula value-ppm) r)
+    (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm)))
 
 ;; CREATE
 
-(define (create-nutrient! name formula)
-  (or (get-nutrient #:name name #:formula formula)
+(define (create-nutrient! canonical-name french-name formula)
+  (or (get-nutrient #:name canonical-name #:formula formula)
       (begin
         (query-exec (current-conn)
-                    (insert #:into nutrients #:set [canonical_name ,name] [formula ,formula]))
-        (get-nutrient #:name name))))
+                    (insert #:into nutrients
+                            #:set [canonical_name ,canonical-name]
+                            [french_name ,french-name]
+                            [formula ,formula]))
+        (get-nutrient #:name canonical-name))))
 
 ;; READ
 
+(define (row->nutrient row)
+  (match-define (vector id canonical-name french-name formula) row)
+  (nutrient id canonical-name french-name formula))
+
 (define (get-nutrients)
-  (for/list ([(id name formula)
-              (in-query (current-conn)
-                        (select id canonical_name formula #:from nutrients #:order-by id #:asc))])
-    (nutrient id name formula)))
-
-(define (get-nutrient #:id [id #f] #:name [name #f] #:formula [formula #f])
-  (define (where-expr)
-    (define clauses
-      (filter values
-              (list (and id (format "id = ~e" id))
-                    (and name (format "canonical_name = ~e" name))
-                    (and formula (format "formula = ~e" formula)))))
+  (define rows
+    (query-rows (current-conn)
+                (select id canonical_name french_name formula #:from nutrients #:order-by id #:asc)))
+  (map row->nutrient rows))
+
+(define (get-nutrient #:id [id #f] #:name [canonical-name #f] #:formula [formula #f])
+  (define where
     (cond
-      [(null? clauses) ""]
-      [else (format "WHERE ~a" (string-join clauses " AND "))]))
+      [(and id canonical-name formula)
+       (scalar-expr-qq (and (= id ,id) (= canonical_name ,canonical-name)))]
+      [id (scalar-expr-qq (= id ,id))]
+      [(and canonical-name formula)
+       (scalar-expr-qq (and (= canonical_name ,canonical-name) (= formula ,formula)))]
+      [canonical-name (scalar-expr-qq (= canonical_name ,canonical-name))]
+      [formula (scalar-expr-qq (= formula ,formula))]))
   (match (query-maybe-row (current-conn)
-                          (string-join `("SELECT id, canonical_name, formula" "FROM nutrients"
-                                                                              ,(where-expr)
-                                                                              "ORDER BY id ASC"
-                                                                              "LIMIT 1")))
-    [(vector id* name* formula*) (nutrient id* name* formula*)]
+                          (select id
+                                  canonical_name
+                                  french_name
+                                  formula
+                                  #:from nutrients
+                                  #:where (ScalarExpr:AST ,where)
+                                  #:order-by id
+                                  #:asc
+                                  #:limit 1))
+    [(vector id canonical-name french-name formula) (nutrient id canonical-name french-name formula)]
     [#f #f]))
 
 ;; UPDATE
diff --git a/tests/models/nutrient.rkt b/tests/models/nutrient.rkt
index 1e4fa8f..525ef66 100644
--- a/tests/models/nutrient.rkt
+++ b/tests/models/nutrient.rkt
@@ -14,9 +14,10 @@
                #:after (λ () (disconnect!))
 
                (test-case "Create nutrients"
-                 (create-nutrient! "Examplium" "Ex")
+                 (check-equal? (length (get-nutrients)) 0)
+                 (create-nutrient! "Examplium" "" "Ex")
                  (check-equal? (length (get-nutrients)) 1)
-                 (create-nutrient! "Ignorium" "Ig")
+                 (create-nutrient! "Ignorium" "" "Ig")
                  (check-equal? (length (get-nutrients)) 2))
 
                (test-case "Read nutrient"
@@ -27,7 +28,7 @@
                (test-case "Read nutrient by name"
                  (define examplium (get-nutrient #:name "Examplium"))
                  (check-true (nutrient? examplium))
-                 (check-equal? (nutrient-name examplium) "Examplium"))
+                 (check-equal? (nutrient-canonical-name examplium) "Examplium"))
 
                (test-case "Read nutrient by formula"
                  (define examplium (get-nutrient #:formula "Ex"))
@@ -41,14 +42,14 @@
                  (define examplium (get-nutrient #:name "Examplium"))
                  (define examplium-nitrate (update-nutrient! examplium #:name "Examplium Nitrate"))
                  (check-equal? (length (get-nutrients)) 2)
-                 (check-equal? (nutrient-name examplium-nitrate) "Examplium Nitrate")
+                 (check-equal? (nutrient-canonical-name examplium-nitrate) "Examplium Nitrate")
                  (check-equal? (nutrient-formula examplium-nitrate) "Ex"))
 
                (test-case "Update nutrient formula"
                  (define examplium-nitrate (get-nutrient #:name "Examplium Nitrate"))
                  (define examplium-sulfate (update-nutrient! examplium-nitrate #:formula "ExSO4"))
                  (check-equal? (length (get-nutrients)) 2)
-                 (check-equal? (nutrient-name examplium-sulfate) "Examplium Nitrate")
+                 (check-equal? (nutrient-canonical-name examplium-sulfate) "Examplium Nitrate")
                  (check-equal? (nutrient-formula examplium-sulfate) "ExSO4"))
 
                (test-case "Update nutrient name and formula"
@@ -56,7 +57,7 @@
                  (define examplium-sulfate
                    (update-nutrient! examplium-nitrate #:name "Examplium Sulfate" #:formula "ExNO3"))
                  (check-equal? (length (get-nutrients)) 2)
-                 (check-equal? (nutrient-name examplium-sulfate) "Examplium Sulfate")
+                 (check-equal? (nutrient-canonical-name examplium-sulfate) "Examplium Sulfate")
                  (check-equal? (nutrient-formula examplium-sulfate) "ExNO3"))
 
                (test-case "Delete nutrient"