Update nutrient target with out beautiful new logic.

1 files changed, 104 insertions, 56 deletions

diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt
index 691d078..4e43ef1 100644
--- a/models/nutrient-target.rkt
+++ b/models/nutrient-target.rkt
@@ -4,7 +4,10 @@
  ;; Struct definitions
  nutrient-target
  nutrient-target?
- nutrient-target-id nutrient-target-effective-on
+ nutrient-target-id
+ (rename-out
+  [nutrient-target-effective-on nutrient-target-date]
+  [nutrient-target-nutrient-values nutrient-target-values])
  ;; SQL CRUD
  (contract-out
   [create-nutrient-target! (-> string?
@@ -17,7 +20,8 @@
                             (or/c nutrient-target? #f))]
   [get-nutrient-target-values (-> nutrient-target? (listof (cons/c nutrient? number?)))]
   [get-nutrient-target-value (-> nutrient-target? nutrient? number?)]
-  [get-latest-nutrient-target-value (-> nutrient? number?)]
+  ;; Before the first target is createed, the "latest" value is basically false.
+  [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
   [delete-nutrient-target! (-> nutrient-target? void?)]))
 
 (require racket/contract
@@ -27,71 +31,115 @@
          "nutrient.rkt")
 
 ;; Instances of this struct are persisted in the nutrient_targets table.
-(struct nutrient-target (id effective-on) #:transparent)
+(struct nutrient-target (id effective-on nutrient-values) #:transparent)
 
 
 ;; CREATE
 
 (define (create-nutrient-target! effective-on nutrient-values)
-  (define existing-nutrient-target (get-nutrient-target #:effective-on effective-on))
-  (define (new-nutrient-target)
-    (with-tx
-      (query-exec (current-conn)
-                  (insert #:into nutrient_targets
-                          #:set [effective_on ,effective-on]))
-      (define nm-id (nutrient-target-id (get-nutrient-target #:effective-on effective-on)))
-      (query-exec (current-conn)
-                  (insert #:into nutrient_value_sets
-                          #:set [nutrient_target_id ,nm-id]))
-      (define nvs-id (query-value (current-conn)
-                                  (select id
-                                          #:from nutrient_value_sets
-                                          #:where (= nutrient_target_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-nutrient-target #:effective-on effective-on))
-  (or existing-nutrient-target
-      (new-nutrient-target)))
+  (or (get-nutrient-target #:effective-on effective-on)
+      (with-tx
+        (query-exec (current-conn)
+                    (insert #:into nutrient_targets
+                            #:set [effective_on ,effective-on]))
+        (define nt-id (query-value (current-conn)
+                                   (select id
+                                           #:from nutrient_targets
+                                           #:where (= effective_on ,effective-on))))
+        (query-exec (current-conn)
+                    (insert #:into nutrient_value_sets
+                            #:set [nutrient_target_id ,nt-id]))
+        (define nvs-id (query-value (current-conn)
+                                    (select id
+                                            #:from nutrient_value_sets
+                                            #:where (= nutrient_target_id ,nt-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-nutrient-target #:effective-on effective-on))))
 
 
 ;; 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)
+      #:on (= nvs.nutrient_measurement_id nt.id))
+     (as nutrient_values nv)
+     #:on (= nv.value_set_id nvs.id))
+    (as nutrients n)
+    #:on (= n.id nv.nutrient_id))))
+
 (define (get-nutrient-targets)
-  (for/list ([(id* effective-on*)
-              (in-query (current-conn)
-                        (select id effective_on
-                                #:from nutrient_targets
-                                #:order-by id ASC))])
-    (nutrient-target id* effective-on*)))
-
-(define (get-nutrient-target #:id [id #f]
-                                  #:effective-on [effective-on #f])
-  (define (where-expr)
-    (define clauses
-      (filter values
-              (list
-               (and id (format "id = ~e" id))
-               (and effective-on (format "effective_on = ~e" effective-on)))))
+  (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)))))
+
+(define (get-nutrient-target #:id [nt-id #f]
+                             #:effective-on [effective-on #f])
+  (define where
     (cond
-      [(null? clauses) ""]
-      [else (format "WHERE ~a" (string-join clauses " AND "))]))
-  (define query (string-join
-                 `("SELECT id, effective_on"
-                   "FROM nutrient_targets"
-                   ,(where-expr)
-                   "ORDER BY id ASC"
-                   "LIMIT 1")))
-  (match (query-maybe-row (current-conn) query)
-    [(vector id* effective-on*)
-     (nutrient-target id* effective-on*)]
-    [#f #f]))
+      [(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))))]))
 
 (define (get-nutrient-target-values nutrient-target)
   (for/list ([(nutrient-id name formula value_ppm)