Update model entity persistency (creation) logic.

This greatly reduces the amount of SQL INSERT queries.

3 files changed, 43 insertions, 69 deletions

diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt
index 256305e..96d94cf 100644
--- a/models/crop-requirement.rkt
+++ b/models/crop-requirement.rkt
@@ -40,27 +40,23 @@
 ;; CREATE
 
 (define (create-crop-requirement! profile nutrient-values [crop #f])
-  (or
-   (get-crop-requirement #:profile profile)
-   (with-tx
-    (query-exec
-     (current-conn)
-     (if crop
-         (insert #:into crop_requirements #:set [crop_id ,(crop-id crop)] [profile ,profile])
-         (insert #:into crop_requirements #:set [profile ,profile])))
-    (define cr-id
-      (query-value (current-conn) (select id #:from crop_requirements #:where (= profile ,profile))))
-    (query-exec (current-conn) (insert #:into nutrient_value_sets #:set [crop_requirement_id ,cr-id]))
-    (define nvs-id
-      (query-value (current-conn)
-                   (select id #:from nutrient_value_sets #:where (= crop_requirement_id ,cr-id))))
-    (for ([(n v) (in-hash nutrient-values)])
-      (query-exec (current-conn)
-                  (insert #:into nutrient_values
-                          #:set [value_set_id ,nvs-id]
-                          [nutrient_id ,(nutrient-id n)]
-                          [value_ppm ,v])))
-    (get-crop-requirement #:profile profile))))
+  (with-tx
+   (define cr-id
+     (insert-id
+      (query (current-conn)
+             (if crop
+                 (insert #:into crop_requirements #:set [crop_id ,(crop-id crop)] [profile ,profile])
+                 (insert #:into crop_requirements #:set [profile ,profile])))))
+   (define nvs-id
+     (insert-id (query (current-conn)
+                       (insert #:into nutrient_value_sets #:set [crop_requirement_id ,cr-id]))))
+   (insert-nutrient-values (current-conn) nvs-id nutrient-values)
+   (crop-requirement cr-id
+                     profile
+                     (if crop
+                         (crop-id crop)
+                         #f)
+                     nutrient-values)))
 
 ;; READ
 
diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt
index f7a5e9c..7c0a267 100644
--- a/models/fertilizer-product.rkt
+++ b/models/fertilizer-product.rkt
@@ -24,13 +24,13 @@
          "nutrient-value.rkt"
          "utils.rkt")
 
-(struct fertilizer-product (id canonical-name nutrient-values brand-name)
+(struct fertilizer-product (id canonical-name brand-name nutrient-values)
   #:transparent
-  #:guard (λ (id canonical-name nutrient-values brand-name _)
+  #:guard (λ (id canonical-name brand-name nutrient-values _)
             (values id
                     canonical-name
-                    nutrient-values
-                    (if (or (sql-null? brand-name) (= (string-length brand-name) 0)) #f brand-name)))
+                    (if (or (sql-null? brand-name) (= (string-length brand-name) 0)) #f brand-name)
+                    nutrient-values))
   #:property prop:custom-write
   (λ (v out _mode)
     (fprintf out "Fertilizer #~a\n" (fertilizer-product-id v))
@@ -56,28 +56,17 @@
 ;; CREATE
 
 (define (create-fertilizer-product! canonical-name brand-name nutrient-values)
-  (or
-   (get-fertilizer-product #:canonical-name canonical-name)
-   (with-tx
-    (query-exec (current-conn)
-                (insert #:into fertilizer_products
-                        #:set [canonical_name ,canonical-name]
-                        [brand_name ,brand-name]))
-    (define fp-id
-      (query-value (current-conn)
-                   (select id #:from fertilizer_products #:where (= 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 ([(n v) (in-hash nutrient-values)])
-      (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))))
+  (with-tx (define fp-id
+             (insert-id (query (current-conn)
+                               (insert #:into fertilizer_products
+                                       #:set [canonical_name ,canonical-name]
+                                       [brand_name ,brand-name]))))
+           (define nvs-id
+             (insert-id (query (current-conn)
+                               (insert #:into nutrient_value_sets
+                                       #:set [fertilizer_product_id ,fp-id]))))
+           (insert-nutrient-values (current-conn) nvs-id nutrient-values)
+           (fertilizer-product nvs-id canonical-name brand-name nutrient-values)))
 
 ;; READ
 
@@ -92,7 +81,7 @@
 
 (define (grouped-row->fertilizer-product grouped-row)
   (match-define (vector fp-id canonical-name brand-name residuals) grouped-row)
-  (fertilizer-product fp-id canonical-name (residuals->nutrient-value-hash residuals) brand-name))
+  (fertilizer-product fp-id canonical-name brand-name (residuals->nutrient-value-hash residuals)))
 
 (define (get-fertilizer-products)
   (define grouped-rows
diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt
index 88177da..a9904d7 100644
--- a/models/nutrient-measurement.rkt
+++ b/models/nutrient-measurement.rkt
@@ -50,27 +50,16 @@
 ;; CREATE
 
 (define (create-nutrient-measurement! measurement-date nutrient-values)
-  (or
-   (get-nutrient-measurement #:date measurement-date)
-   (with-tx
-    (query-exec (current-conn)
-                (insert #:into nutrient_measurements #:set [measurement_date ,measurement-date]))
-    (define nm-id
-      (query-value
-       (current-conn)
-       (select id #:from nutrient_measurements #:where (= measurement_date ,measurement-date))))
-    (query-exec (current-conn)
-                (insert #:into nutrient_value_sets #:set [nutrient_measurement_id ,nm-id]))
-    (define nvs-id
-      (query-value (current-conn)
-                   (select id #:from nutrient_value_sets #:where (= nutrient_measurement_id ,nm-id))))
-    (for ([(n v) (in-hash nutrient-values)])
-      (query-exec (current-conn)
-                  (insert #:into nutrient_values
-                          #:set [value_set_id ,nvs-id]
-                          [nutrient_id ,(nutrient-id n)]
-                          [value_ppm ,v])))
-    (get-nutrient-measurement #:date measurement-date))))
+  (with-tx (define nm-id
+             (insert-id (query (current-conn)
+                               (insert #:into nutrient_measurements
+                                       #:set [measurement_date ,measurement-date]))))
+           (define nvs-id
+             (insert-id (query (current-conn)
+                               (insert #:into nutrient_value_sets
+                                       #:set [nutrient_measurement_id ,nm-id]))))
+           (insert-nutrient-values (current-conn) nvs-id nutrient-values)
+           (nutrient-measurement nm-id measurement-date nutrient-values)))
 
 ;; READ