Add French name to nutrient model.

5 files changed, 97 insertions, 66 deletions

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