Realign fertilizer-product model with nutrient-measurement.

1 files changed, 117 insertions, 91 deletions

diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt
index f9cf5fd..9859537 100644
--- a/models/fertilizer-product.rkt
+++ b/models/fertilizer-product.rkt
@@ -14,11 +14,11 @@
   [get-fertilizer-products (-> (listof fertilizer-product?))]
   [get-fertilizer-product (->* ()
                                (#:id (or/c #f exact-nonnegative-integer?)
-                                #:brand-name (or/c #f string?))
+                                #:canonical-name (or/c #f string?))
                                (or/c fertilizer-product? #f))]
-  [get-fertilizer-product-values (-> fertilizer-product? (listof (cons/c nutrient? number?)))]
+  [get-fertilizer-product-values (-> fertilizer-product?
+                                     (listof (cons/c nutrient? number?)))]
   [get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
-  [get-latest-fertilizer-product-value (-> nutrient? number?)]
   [delete-fertilizer-product! (-> fertilizer-product? void?)]))
 
 (require racket/contract
@@ -34,108 +34,134 @@
 ;; CREATE
 
 (define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f])
-  (define existing-fertilizer-product (get-fertilizer-product #:canonical-name canonical-name))
-  (define (new-fertilizer-product)
-    (with-tx
-      (query-exec (current-conn)
-                  (cond
-                    [brand-name
-                     (insert #:into fertilizer_products
-                             #:set [canonical_name ,canonical-name] [brand_name ,brand-name])]
-                    [else
-                     (insert #:into fertilizer_products
-                             #:set [canonical_name ,canonical-name])]))
-      (define nm-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name)))
-      (query-exec (current-conn)
-                  (insert #:into nutrient_value_sets
-                          #:set [fertilizer_product_id ,nm-id]))
-      (define nvs-id (query-value (current-conn)
-                                  (select id
-                                          #:from nutrient_value_sets
-                                          #:where (= fertilizer_product_id ,nm-id))))
-      (for ([nv nutrient-values])
-        (match nv
-          [(cons n v)
-           (query-exec (current-conn)
-                       (insert #:into nutrient_values
-                               #:set
-                               [value_set_id ,nvs-id]
-                               [nutrient_id  ,(nutrient-id n)]
-                               [value_ppm    ,v]))])))
-    (get-fertilizer-product #:canonical-name canonical-name))
-  (or existing-fertilizer-product
-      (new-fertilizer-product)))
+  (or (get-fertilizer-product #:canonical-name canonical-name)
+      (with-tx
+        (query-exec (current-conn)
+                    (cond
+                      [brand-name
+                       (insert #:into fertilizer_products
+                               #:set [canonical_name ,canonical-name] [brand_name ,brand-name])]
+                      [else
+                       (insert #:into fertilizer_products
+                               #:set [canonical_name ,canonical-name])]))
+        (define fp-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name)))
+        (query-exec (current-conn)
+                    (insert #:into nutrient_value_sets
+                            #:set [fertilizer_product_id ,fp-id]))
+        (define nvs-id (query-value (current-conn)
+                                    (select id
+                                            #:from nutrient_value_sets
+                                            #:where (= fertilizer_product_id ,fp-id))))
+        (for ([nv nutrient-values])
+          (match nv
+            [(cons n v)
+             (query-exec (current-conn)
+                         (insert #:into nutrient_values
+                                 #:set
+                                 [value_set_id ,nvs-id]
+                                 [nutrient_id  ,(nutrient-id n)]
+                                 [value_ppm    ,v]))])))
+      (get-fertilizer-product #:canonical-name canonical-name)))
 
 
 ;; READ
 
+(struct acc (canonical-name brand-name pairs) #:transparent)
+
+(define joined
+  (table-expr-qq
+   (inner-join
+    (inner-join
+     (inner-join
+      (as fertilizer_products fp)
+      (as nutrient_value_sets nvs)
+      #:on (= nvs.fertilizer_product_id fp.id))
+     (as nutrient_values nv)
+     #:on (= nv.value_set_id nvs.id))
+    (as nutrients n)
+    #:on (= n.id nv.nutrient_id))))
+
 (define (get-fertilizer-products)
-  (for/list ([(id* brand-name*)
-              (in-query (current-conn)
-                        (select id brand_name
-                                #:from fertilizer_products
-                                #:order-by canonical_name #:asc))])
-    (fertilizer-product id* brand-name*)))
-
-(define (get-fertilizer-product #:id [id #f]
-                                #:canonical-name [canonical-name #f]
-                                #:brand-name [brand-name #f])
-  (define (where-expr)
-    (define clauses
-      (filter values
-              (list
-               (and id (format "id = ~e" id))
-               (and canonical-name (format "canonical_name = ~e" canonical-name))
-               (and brand-name (format "brand_name = ~e" brand-name)))))
+  (define query (select fp.id fp.canonical_name fp.brand_name
+                        n.id n.canonical_name n.formula
+                        nv.value_ppm
+                        #:from (TableExpr:AST ,joined)
+                        #:order-by canonical_name #:asc))
+  (define rows (query-rows (current-conn) query))
+  (define by-id
+    (for/fold ([h (hash)]) ([row (in-list rows)])
+      (match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
+      (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
+      (hash-update h fp-id
+                   (λ (old-acc)
+                     (acc (acc-canonical-name old-acc)
+                          (acc-brand-name old-acc)
+                          (cons nv-pair (acc-pairs old-acc))))
+                   (λ ()
+                     (acc canonical-name
+                          brand-name
+                          (list nv-pair))))))
+  (for/list ([(id a) (in-hash by-id)])
+    (fertilizer-product id
+                        (acc-canonical-name a)
+                        (reverse (acc-pairs a))
+                        (acc-brand-name a))))
+
+(define (get-fertilizer-product #:id [fp-id #f]
+                                #:canonical-name [canonical-name #f])
+  (define where
     (cond
-      [(null? clauses) ""]
-      [else (format "WHERE ~a" (string-join clauses " AND "))]))
-  (match (query-maybe-row (current-conn)
-                          (string-join
-                           `("SELECT id, canonical_name, brand_name"
-                             "FROM fertilizer_products"
-                             ,(where-expr)
-                             "ORDER BY id ASC"
-                             "LIMIT 1")))
-    [(vector id* canonical-name* brand-name*)
-     (fertilizer-product id* canonical-name* brand-name*)]
-    [#f #f]))
+      [(and fp-id canonical-name)
+       (scalar-expr-qq (and (= fp.id ,fp-id)
+                            (= fp.canonical_name ,canonical-name)))]
+      [fp-id
+       (scalar-expr-qq (= fp.id ,fp-id))]
+      [canonical-name
+       (scalar-expr-qq (= fp.canonical_name ,canonical-name))]))
+  (define query (select fp.id fp.canonical_name fp.brand_name
+                        n.id n.canonical_name n.formula
+                        nv.value_ppm
+                        #:from (TableExpr:AST ,joined)
+                        #:where (ScalarExpr:AST ,where)
+                        #:limit 1))
+  (define rows (query-rows (current-conn) query))
+  (cond
+    [(null? rows) #f]
+    [else
+     ;; Fold all nutrient value rows belonging to the single fertilizer product into one struct
+     (define the-id #f)
+     (define A #f)
+     (for ([row (in-list rows)])
+       (match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
+       (unless the-id (set! the-id fp-id))
+       (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
+       (set! A (if A
+                   (acc (acc-canonical-name A)
+                        (acc-brand-name A)
+                        (cons nv-pair (acc-pairs A)))
+                   (acc canonical-name
+                        brand-name
+                        (list nv-pair)))))
+     (and A
+          (fertilizer-product the-id
+                              (acc-canonical-name A)
+                              (reverse (acc-pairs A))
+                              (acc-brand-name A)))]))
 
 (define (get-fertilizer-product-values fertilizer-product)
   (for/list ([(nutrient-id name formula value_ppm)
               (in-query (current-conn)
-                        (string-join
-                         '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
-                           "FROM nutrient_values nv"
-                           "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
-                           "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
-                           "JOIN nutrients n ON n.id = nv.nutrient_id"
-                           "WHERE nm.id = $1"))
-                        (fertilizer-product-id fertilizer-product))])
+                        (select n.id n.canonical_name n.formula nv.value_ppm
+                                #:from (TableExpr:AST ,joined)
+                                #:where (= nm.id ,(fertilizer-product-id fertilizer-product))))])
     (cons (nutrient nutrient-id name formula) value_ppm)))
 
 (define (get-fertilizer-product-value fertilizer-product nutrient)
   (query-maybe-value (current-conn)
-                     (string-join
-                      '("SELECT value_ppm"
-                        "FROM nutrient_values nv"
-                        "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
-                        "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
-                        "WHERE nm.id = $1 AND nv.nutrient_id = $2"))
-                     (fertilizer-product-id fertilizer-product)
-                     (nutrient-id nutrient)))
-
-(define (get-latest-fertilizer-product-value nutrient)
-  (query-maybe-value (current-conn)
-                     (string-join
-                      '("SELECT value_ppm"
-                        "FROM nutrient_values nv"
-                        "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
-                        "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
-                        "WHERE nv.nutrient_id = $1"
-                        "ORDER BY nm.brand_name DESC"
-                        "LIMIT 1"))
-                     (nutrient-id nutrient)))
+                     (select value_ppm
+                             #:from (TableExpr:AST ,joined)
+                             #:where (and (= nm.id ,(fertilizer-product-id fertilizer-product))
+                                          (= nv.nutrient_id ,(nutrient-id nutrient))))))
 
 
 ;; UPDATE