Add crop requirement new/show/edit logic.

1 files changed, 50 insertions, 19 deletions

diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt
index 803578c..2dd8071 100644
--- a/models/crop-requirement.rkt
+++ b/models/crop-requirement.rkt
@@ -5,13 +5,18 @@
          crop-requirement-id
          crop-requirement-profile
          crop-requirement-crop-id
+         crop-requirement-value
          (rename-out [crop-requirement-nutrient-values crop-requirement-values])
          (contract-out
-          [create-crop-requirement! (->* (string? nutrient-value-hash/c) (crop?) crop-requirement?)]
+          [create-crop-requirement!
+           (case-> (-> crop-requirement? crop-requirement?)
+                   (-> string? nutrient-value-hash/c crop-requirement?)
+                   (-> string? nutrient-value-hash/c crop? crop-requirement?))]
           [get-crop-requirements (-> (listof crop-requirement?))]
           [get-crop-requirement (->* () (#:id db-id? #:profile string?) (or/c crop-requirement? #f))]
           [get-crop-requirement-values (-> crop-requirement-or-id/c nutrient-value-hash/c)]
           [get-crop-requirement-value (-> crop-requirement-or-id/c nutrient? maybe-nutrient-value?)]
+          [update-crop-requirement! (-> crop-requirement? void?)]
           [delete-crop-requirement! (-> crop-requirement-or-id/c void?)]
           [average-crop-requirement-nutrient-values
            (-> (hash/c crop-requirement? (between/c 0 100)) nutrient-value-hash/c)]))
@@ -29,6 +34,9 @@
   #:guard (λ (id profile crop-id nutrient-values _)
             (values id profile (if (sql-null? crop-id) #f crop-id) nutrient-values)))
 
+(define (crop-requirement-value cr nutrient)
+  (hash-ref (crop-requirement-nutrient-values cr) nutrient #f))
+
 (define crop-requirement-or-id/c (or/c crop-requirement? db-id?))
 
 (define (->cr-id cr-or-id)
@@ -38,24 +46,30 @@
 
 ;; CREATE
 
-(define (create-crop-requirement! profile nutrient-values [crop #f])
-  (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)))
+(define create-crop-requirement!
+  (case-lambda
+    [(cr) (create-crop-requirement!/cr cr)]
+    [(profile nutrient-values)
+     (create-crop-requirement!/cr (crop-requirement #f profile #f nutrient-values))]
+    [(profile nutrient-values crop)
+     (create-crop-requirement!/cr (crop-requirement #f profile (crop-id crop) nutrient-values))]))
+
+(define (create-crop-requirement!/cr cr)
+  (define profile (crop-requirement-profile cr))
+  (define nutrient-values (crop-requirement-nutrient-values cr))
+  (define crop-id (crop-requirement-crop-id cr))
+  (with-tx (define cr-id
+             (insert-id
+              (query (current-conn)
+                     (if crop-id
+                         (insert #:into crop_requirements #:set [crop_id ,crop-id] [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 crop-id nutrient-values)))
 
 ;; READ
 
@@ -135,6 +149,23 @@
 
 ;; UPDATE
 
+(define (update-crop-requirement! cr)
+  (define id
+    (or (crop-requirement-id cr)
+        (raise-argument-error 'update-crop-requirement! "db-id?" (crop-requirement-id cr))))
+  (define profile (crop-requirement-profile cr))
+  (define crop-id (crop-requirement-crop-id cr))
+  (with-tx
+   (query-exec
+    (current-conn)
+    (if crop-id
+        (update crop_requirements #:set [profile ,profile] [crop_id ,crop-id] #:where [= id ,id])
+        (update crop_requirements #:set [profile ,profile] #:where [= id ,id])))
+   (define nvs-id
+     (query-value (current-conn)
+                  (select id #:from nutrient_value_sets #:where [= crop_requirement_id ,id])))
+   (update-nutrient-values! (current-conn) nvs-id (crop-requirement-nutrient-values cr))))
+
 ;; DELETE
 
 (define (delete-crop-requirement! cr-or-id)