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

4 files changed, 179 insertions, 217 deletions

diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt
index f6193bf..6ddf1aa 100644
--- a/models/crop-requirement.rkt
+++ b/models/crop-requirement.rkt
@@ -60,73 +60,82 @@
 
 ;; READ
 
+(define joined
+  (table-expr-qq (inner-join (inner-join (inner-join (as crop_requirements cr)
+                                                     (as nutrient_value_sets nvs)
+                                                     #:on (= nvs.crop_requirement_id cr.id))
+                                         (as nutrient_values nv)
+                                         #:on (= nv.value_set_id nvs.id))
+                             (as nutrients n)
+                             #:on (= n.id nv.nutrient_id))))
+
+(define (grouped-row->crop-requirement row)
+  (match-define (vector cr-id profile crop-id residuals) row)
+  (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
+  (crop-requirement cr-id profile crop-id nutrient-value-pairs))
+
 (define (get-crop-requirements)
-  (for/list ([(id* profile* crop-id*)
-              (in-query (current-conn)
-                        (select id profile crop_id
-                                #:from crop_requirements
-                                #:order-by id #:asc))])
-    (crop-requirement id* profile* (if (sql-null? crop-id*) #f crop-id*))))
-
-(define (get-crop-requirement #:id [id #f]
-                              #:profile [profile #f]
-                              #:crop [crop #f])
-  (define (where-expr)
-    (define clauses
-      (filter values
-              (list
-               (and id (format "id = ~e" id))
-               (and profile (format "profile = ~e" profile))
-               (and crop (format "crop_id = ~e" (crop-id crop))))))
+  (define grouped-rows
+    (query-rows (current-conn)
+                (select cr.id
+                        cr.profile
+                        cr.crop_id
+                        n.id
+                        n.canonical_name
+                        n.formula
+                        nv.value_ppm
+                        #:from (TableExpr:AST ,joined)
+                        #:order-by cr.id
+                        #:asc)
+                #:group '#(0 1 2)))
+  (for/list ([row grouped-rows])
+    (grouped-row->crop-requirement row)))
+
+(define (get-crop-requirement #:id [cr-id #f] #:profile [profile #f] #:crop-id [crop-id #f])
+  (define where
     (cond
-      [(null? clauses) ""]
-      [else (format "WHERE ~a" (string-join clauses " AND "))]))
-  (define query (string-join
-                 `("SELECT id, profile, crop_id"
-                   "FROM crop_requirements"
-                   ,(where-expr)
-                   "ORDER BY id ASC"
-                   "LIMIT 1")))
-  (match (query-maybe-row (current-conn) query)
-    [(vector id* profile* crop-id*)
-     (crop-requirement id* profile* crop-id*)]
-    [#f #f]))
+      [(and cr-id profile crop-id)
+       (scalar-expr-qq (and (= cr.id ,cr-id) (= cr.profile ,profile) (= cr.crop_id ,crop-id)))]
+      [cr-id (scalar-expr-qq (= cr.id ,cr-id))]
+      [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
+                        cr.profile
+                        cr.crop_id
+                        n.id
+                        n.canonical_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/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 crop_requirements cr ON cr.id = nvs.crop_requirement_id"
-                                       "JOIN nutrients n ON n.id = nv.nutrient_id"
-                                       "WHERE cr.id = $1"))
-                        (crop-requirement-id crop-requirement))])
+                        (select n.id
+                                n.canonical_name
+                                n.formula
+                                nv.value_ppm
+                                #:from (TableExpr:AST ,joined)
+                                #:where (= cr.id ,(crop-requirement-id crop-requirement))))])
     (cons (nutrient nutrient-id name formula) value_ppm)))
 
 (define (get-crop-requirement-value crop-requirement 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 crop_requirements cr ON cr.id = nvs.crop_requirement_id"
-                        "WHERE cr.id = $1 AND nv.nutrient_id = $2"))
-                     (crop-requirement-id crop-requirement)
-                     (nutrient-id nutrient)))
-
-(define (get-latest-crop-requirement-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 crop_requirements cr ON cr.id = nvs.crop_requirement_id"
-                        "WHERE nv.nutrient_id = $1"
-                        "ORDER BY cr.profile DESC"
-                        "LIMIT 1"))
-                     (nutrient-id nutrient)))
-
+                     (select value_ppm
+                             #:from (TableExpr:AST ,joined)
+                             #:where (and (= cr.id ,(crop-requirement-id crop-requirement))
+                                          (= nv.nutrient_id ,(nutrient-id nutrient))))))
 
 ;; UPDATE
 
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)
diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt
index 1cabf63..dbcb53c 100644
--- a/models/nutrient-measurement.rkt
+++ b/models/nutrient-measurement.rkt
@@ -66,7 +66,6 @@
 
 ;; READ
 
-(struct acc (measured-on pairs) #:transparent)
 (define joined
   (table-expr-qq (inner-join (inner-join (inner-join (as nutrient_measurements nm)
                                                      (as nutrient_value_sets nvs)
@@ -76,66 +75,51 @@
                              (as nutrients n)
                              #:on (= n.id nv.nutrient_id))))
 
+(define (grouped-row->nutrient-measurement row)
+  (match-define (vector nm-id measured-on residuals) row)
+  (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
+  (nutrient-measurement nm-id measured-on nutrient-value-pairs))
 
 (define (get-nutrient-measurements)
-  (define query (select nm.id nm.measured_on
-                        n.id n.canonical_name n.formula
-                        nv.value_ppm
-                        #:from (TableExpr:AST ,joined)
-                        #:order-by nm.measured_on #:desc))
-  (define rows (query-rows (current-conn) query))
-  (define by-id
-    (for/fold ([h (hash)]) ([row (in-list rows)])
-      (match-define (vector nm-id measured-on 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 nm-id
-                   (λ (old-acc)
-                     (acc (acc-measured-on old-acc)
-                          (cons nv-pair (acc-pairs old-acc))))
-                   (λ ()
-                     (acc measured-on
-                          (list nv-pair))))))
-  (for/list ([(id a) (in-hash by-id)])
-    (nutrient-measurement id
-                          (acc-measured-on a)
-                          (reverse (acc-pairs a)))))
-
-(define (get-nutrient-measurement #:id [nm-id #f]
-                                  #:measured-on [measured-on #f])
+  (define grouped-rows (query-rows (current-conn)
+                                   (select nm.id
+                                           nm.measured_on
+                                           n.id
+                                           n.canonical_name
+                                           n.formula
+                                           nv.value_ppm
+                                           #:from (TableExpr:AST ,joined)
+                                           #:order-by nm.measured_on
+                                           #:desc)
+                                   #:group '#(0 1)))
+  (for/list ([row grouped-rows])
+    (grouped-row->nutrient-measurement row)))
+
+(define (get-nutrient-measurement #:id [nm-id #f] #:measured-on [measured-on #f])
   (define where
     (cond
       [(and nm-id measured-on)
-       (scalar-expr-qq (and (= nm.id ,nm-id)
-                            (= nm.measured_on ,measured-on)))]
-      [nm-id
-       (scalar-expr-qq (= nm.id ,nm-id))]
-      [measured-on
-       (scalar-expr-qq (= nm.measured_on ,measured-on))]))
-  (define query (select nm.id nm.measured_on
-                        n.id n.canonical_name n.formula
+       (scalar-expr-qq (and (= nm.id ,nm-id) (= nm.measured_on ,measured-on)))]
+      [nm-id (scalar-expr-qq (= nm.id ,nm-id))]
+      [measured-on (scalar-expr-qq (= nm.measured_on ,measured-on))]
+      [else (error 'get-nutrient-measurement "either #:id or #:measured-on must be provided")]))
+  (define grouped-rows
+    (query-rows (current-conn)
+                (select nm.id
+                        nm.measured_on
+                        n.id
+                        n.canonical_name
+                        n.formula
                         nv.value_ppm
                         #:from (TableExpr:AST ,joined)
-                        #:where (ScalarExpr:AST ,where)))
-  (define rows (query-rows (current-conn) query))
-  (cond
-    [(null? rows) #f]
-    [else
-     ;; Fold all nutrient value rows belonging to the single nutrient measurement into one struct
-     (define the-id #f)
-     (define A #f)
-     (for ([row (in-list rows)])
-       (match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row)
-       (unless the-id (set! the-id nm-id))
-       (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
-       (set! A (if A
-                   (acc (acc-measured-on A)
-                        (cons nv-pair (acc-pairs A)))
-                   (acc measured-on
-                        (list nv-pair)))))
-     (and A
-          (nutrient-measurement the-id
-                                (acc-measured-on A)
-                                (reverse (acc-pairs A))))]))
+                        #:where (ScalarExpr:AST ,where)
+                        #:order-by nm.measured_on
+                        #:desc)
+                #:group '#(0 1)))
+  (match grouped-rows
+    ['() #f]
+    [(list row) (grouped-row->nutrient-measurement row)]
+    [many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))]))
 
 (define (get-nutrient-measurement-values nutrient-measurement)
   (for/list ([(nutrient-id name formula value_ppm)
diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt
index 77d0b4c..b9ca2d1 100644
--- a/models/nutrient-target.rkt
+++ b/models/nutrient-target.rkt
@@ -61,8 +61,6 @@
 
 ;; READ
 
-(struct acc (effective-on pairs) #:transparent)
-
 (define joined
   (table-expr-qq (inner-join (inner-join (inner-join (as nutrient_targets nt)
                                                      (as nutrient_value_sets nvs)
@@ -72,28 +70,24 @@
                              (as nutrients n)
                              #:on (= n.id nv.nutrient_id))))
 
+(define (grouped-row->nutrient-target row)
+  (match-define (vector nt-id effective-on residuals) row)
+  (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals))
+  (nutrient-target nt-id effective-on nutrient-value-pairs))
+
 (define (get-nutrient-targets)
-  (define query
-    (select nt.id
-            nt.effective_on
-            n.id
-            n.canonical_name
-            n.formula
-            nv.value_ppm
-            #:from (TableExpr:AST ,joined)
-            #:order-by nt.effective_on
-            #:desc))
-  (define rows (query-rows (current-conn) query))
-  (define by-id
-    (for/fold ([h (hash)]) ([row (in-list rows)])
-      (match-define (vector nt-id effective-on 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
-                   nt-id
-                   (λ (old-acc) (acc (acc-effective-on old-acc) (cons nv-pair (acc-pairs old-acc))))
-                   (λ () (acc effective-on (list nv-pair))))))
-  (for/list ([(id a) (in-hash by-id)])
-    (nutrient-target id (acc-effective-on a) (reverse (acc-pairs a)))))
+  (for/list ([grouped-row (in-query (current-conn)
+                                    (select nt.id
+                                            nt.effective_on
+                                            n.id
+                                            n.canonical_name
+                                            n.formula
+                                            nv.value_ppm
+                                            #:from (TableExpr:AST ,joined)
+                                            #:order-by nt.effective_on
+                                            #:desc)
+                                    #:group '#(0 1))])
+    (grouped-row->nutrient-target grouped-row)))
 
 (define (get-nutrient-target #:id [nt-id #f] #:effective-on [effective-on #f])
   (define where
@@ -101,33 +95,25 @@
       [(and nt-id effective-on)
        (scalar-expr-qq (and (= nt.id ,nt-id) (= nt.effective_on ,effective-on)))]
       [nt-id (scalar-expr-qq (= nt.id ,nt-id))]
-      [effective-on (scalar-expr-qq (= nt.effective_on ,effective-on))]))
-  (define query
-    (select nt.id
-            nt.effective_on
-            n.id
-            n.canonical_name
-            n.formula
-            nv.value_ppm
-            #:from (TableExpr:AST ,joined)
-            #:where (ScalarExpr:AST ,where)))
-  (define rows (query-rows (current-conn) query))
-  (cond
-    [(null? rows) #f]
-    [else
-     ;; Fold all nutrient rows belonging to the single target into one struct
-     (define the-id #f)
-     (define A #f)
-     (for ([row (in-list rows)])
-       (match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row)
-       (unless the-id
-         (set! the-id nt-id))
-       (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
-       (set! A
-             (if A
-                 (acc (acc-effective-on A) (cons nv-pair (acc-pairs A)))
-                 (acc effective-on (list nv-pair)))))
-     (and A (nutrient-target the-id (acc-effective-on A) (reverse (acc-pairs A))))]))
+      [effective-on (scalar-expr-qq (= nt.effective_on ,effective-on))]
+      [else (error 'get-nutrient-target "either #:id or #:effective-on must be provided")]))
+  (define grouped-rows
+    (query-rows (current-conn)
+                (select nt.id
+                        nt.effective_on
+                        n.id
+                        n.canonical_name
+                        n.formula
+                        nv.value_ppm
+                        #:from (TableExpr:AST ,joined)
+                        #:where (ScalarExpr:AST ,where)
+                        #:order-by nt.effective_on
+                        #:desc)
+                #:group '#(0 1)))
+  (match grouped-rows
+    ['() #f]
+    [(list row) (grouped-row->nutrient-target row)]
+    [many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))]))
 
 (define (get-nutrient-target-values nutrient-target)
   (for/list ([(nutrient-id name formula value_ppm)