Use db library grouping mechanism rather than ad-hoc accumulator.

1 files changed, 39 insertions, 56 deletions

diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt
index d4006ac..1d6adbb 100644
--- a/models/fertilizer-product.rkt
+++ b/models/fertilizer-product.rkt
@@ -76,8 +76,6 @@
 
 ;; 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)
@@ -87,32 +85,26 @@
                              (as nutrients n)
                              #:on (= n.id nv.nutrient_id))))
 
+(define (grouped-row->fertilizer-product row)
+  (match-define (vector fp-id canonical-name brand-name residuals) row)
+  (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
+  (fertilizer-product fp-id canonical-name nutrient-value-pairs brand-name))
+
 (define (get-fertilizer-products)
-  (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 fp.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 grouped-rows (query-rows (current-conn)
+                                   (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 fp.canonical_name
+                                           #:asc)
+                                   #:group '#(0 1 2)))
+  (for/list ([row grouped-rows])
+    (grouped-row->fertilizer-product row)))
 
 (define (get-fertilizer-product #:id [fp-id #f] #:canonical-name [canonical-name #f])
   (define where
@@ -120,35 +112,26 @@
       [(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)))))
-     (fertilizer-product the-id (acc-canonical-name A) (reverse (acc-pairs A)) (acc-brand-name A))]))
+      [canonical-name (scalar-expr-qq (= fp.canonical_name ,canonical-name))]
+      [else (error 'get-fertilizer-product "either #:id or #:canonical-name must be provided")]))
+  (define grouped-rows
+    (query-rows (current-conn)
+                (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)
+                        #:order-by fp.canonical_name
+                        #:asc)
+                #:group '#(0 1 2)))
+  (match grouped-rows
+    ['() #f]
+    [(list row) (grouped-row->fertilizer-product row)]
+    [many (error 'get-fertilizer-product "expected 1 fertilizer product, got ~a" (length many))]))
 
 (define (get-fertilizer-product-values fertilizer-product)
   (for/list ([(nutrient-id name formula value_ppm)