Measurements and fertilizers can now be persisted 2 ways.

3 files changed, 33 insertions, 15 deletions

diff --git a/handlers.rkt b/handlers.rkt
index f1825b9..988789b 100644
--- a/handlers.rkt
+++ b/handlers.rkt
@@ -85,8 +85,10 @@
   (render-page (new-measurement-page)))
 
 (define (create-measurement req)
-  (define-values (measurement-date nutrient-values) (formlet-process (measurements-formlet) req))
-  (create-nutrient-measurement! measurement-date nutrient-values)
+  (define new-measurement (formlet-process (measurements-formlet) req))
+  (if (get-nutrient-measurement #:date (nutrient-measurement-date new-measurement))
+      (update-nutrient-measurement! new-measurement)
+      (create-nutrient-measurement! new-measurement))
   (redirect-to "/ferti/measurements-and-rotations"))
 
 (define (show-measurement _ id)
@@ -124,8 +126,8 @@
   (render-page (new-fertilizer-page)))
 
 (define (create-fertilizer req)
-  (define new-fertilizer-product (formlet-process (fertilizer-formlet) req))
-  (create-fertilizer-product! new-fertilizer-product)
+  (define new-fertilizer (formlet-process (fertilizer-formlet) req))
+  (create-fertilizer-product! new-fertilizer)
   (redirect-to "/ferti/fertilizers"))
 
 (define (show-fertilizer _ id)
diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt
index e79a707..652b3c4 100644
--- a/models/fertilizer-product.rkt
+++ b/models/fertilizer-product.rkt
@@ -7,7 +7,9 @@
          (rename-out [fertilizer-product-canonical-name fertilizer-product-name]
                      [fertilizer-product-nutrient-values fertilizer-product-values]
                      [fertilizer-product-brand-name fertilizer-brand-name])
-         (contract-out [create-fertilizer-product! (-> fertilizer-product? fertilizer-product?)]
+         (contract-out [create-fertilizer-product!
+                        (case-> (-> fertilizer-product? fertilizer-product?)
+                                (-> string? string? nutrient-value-hash/c fertilizer-product?))]
                        [get-fertilizer-products (-> (listof fertilizer-product?))]
                        [get-fertilizer-product
                         (->* () (#:id db-id? #:canonical-name string?) (or/c fertilizer-product? #f))]
@@ -56,7 +58,14 @@
 
 ;; CREATE
 
-(define (create-fertilizer-product! fp)
+(define create-fertilizer-product!
+  (case-lambda
+    [(fp) (create-fertilizer-product!/fp fp)]
+    [(canonical-name brand-name nutrient-values)
+     (create-fertilizer-product!/fp
+      (fertilizer-product #f canonical-name brand-name nutrient-values))]))
+
+(define (create-fertilizer-product!/fp fp)
   (define canonical-name (fertilizer-product-canonical-name fp))
   (define brand-name (fertilizer-product-brand-name fp))
   (define nutrient-values (fertilizer-product-nutrient-values fp))
@@ -196,10 +205,9 @@
        (define nitrogen (get-nutrient #:name "Nitrogen"))
        (define phosphorus (get-nutrient #:name "Phosphorus"))
 
-       (create-fertilizer-product! (fertilizer-product #f
-                                                       canonical-product-name
-                                                       "MasterBlend"
-                                                       (hash nitrogen 40 phosphorus 200)))
+       (create-fertilizer-product! canonical-product-name
+                                   "MasterBlend"
+                                   (hash nitrogen 40 phosphorus 200))
 
        (check-equal? (length (get-fertilizer-products)) 1)
 
@@ -238,9 +246,7 @@
 
      (test-case "Custom write property formatting"
        (define nitrogen (get-nutrient #:name "Nitrogen"))
-       (define fp
-         (create-fertilizer-product!
-          (fertilizer-product #f "Test Fertilizer" "TestBrand" (hash nitrogen 50))))
+       (define fp (create-fertilizer-product! "Test Fertilizer" "TestBrand" (hash nitrogen 50)))
 
        (define output (open-output-string))
        (write fp output)
diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt
index f4bfa8e..fea7b89 100644
--- a/models/nutrient-measurement.rkt
+++ b/models/nutrient-measurement.rkt
@@ -7,7 +7,9 @@
          (rename-out [nutrient-measurement-measurement-date nutrient-measurement-date]
                      [nutrient-measurement-nutrient-values nutrient-measurement-values])
          (contract-out
-          [create-nutrient-measurement! (-> string? nutrient-value-hash/c nutrient-measurement?)]
+          [create-nutrient-measurement!
+           (case-> (-> nutrient-measurement? nutrient-measurement?)
+                   (-> string? nutrient-value-hash/c nutrient-measurement?))]
           [get-nutrient-measurements (-> (listof nutrient-measurement?))]
           [get-nutrient-measurement
            (->* () (#:id db-id? #:date string?) (or/c nutrient-measurement? #f))]
@@ -51,7 +53,15 @@
 
 ;; CREATE
 
-(define (create-nutrient-measurement! measurement-date nutrient-values)
+(define create-nutrient-measurement!
+  (case-lambda
+    [(nm) (create-nutrient-measurement!/nm nm)]
+    [(measurement-date nutrient-values)
+     (create-nutrient-measurement!/nm (nutrient-measurement #f measurement-date nutrient-values))]))
+
+(define (create-nutrient-measurement!/nm nm)
+  (define measurement-date (nutrient-measurement-measurement-date nm))
+  (define nutrient-values (nutrient-measurement-nutrient-values nm))
   (with-tx (define nm-id
              (insert-id (query (current-conn)
                                (insert #:into nutrient_measurements