Main model structs can now be manipulated by id or entire struct.

This paves the way to passing ids in URLs, and acting upon them in
handlers.

4 files changed, 99 insertions, 62 deletions

diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt
index c0eb753..733126e 100644
--- a/models/crop-requirement.rkt
+++ b/models/crop-requirement.rkt
@@ -13,9 +13,10 @@
                         (->* ()
                              (#:id (or/c #f exact-nonnegative-integer?) #:profile (or/c #f string?))
                              (or/c crop-requirement? #f))]
-                       [get-crop-requirement-values (-> crop-requirement? nutrient-value-hash/c)]
-                       [get-crop-requirement-value (-> crop-requirement? nutrient? number?)]
-                       [delete-crop-requirement! (-> crop-requirement? void?)]
+                       [get-crop-requirement-values
+                        (-> crop-requirement-or-id/c nutrient-value-hash/c)]
+                       [get-crop-requirement-value (-> crop-requirement-or-id/c nutrient? number?)]
+                       [delete-crop-requirement! (-> crop-requirement-or-id/c void?)]
                        [average-crop-requirement-nutrient-values
                         (-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100))))
                             nutrient-value-hash/c)]))
@@ -32,6 +33,15 @@
   #:guard (λ (id profile crop-id nutrient-values _)
             (values id profile (if (sql-null? crop-id) #f crop-id) nutrient-values)))
 
+(define crop-requirement-id? exact-nonnegative-integer?)
+
+(define crop-requirement-or-id/c (or/c crop-requirement? crop-requirement-id?))
+
+(define (->cr-id cr-or-id)
+  (match cr-or-id
+    [(? crop-requirement-id? cr-or-id) cr-or-id]
+    [(crop-requirement id _ _ _) id]))
+
 ;; CREATE
 
 (define (create-crop-requirement! profile nutrient-values [crop #f])
@@ -117,7 +127,7 @@
     [(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)
+(define (get-crop-requirement-values cr-or-id)
   (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
               (in-query (current-conn)
                         (select n.id
@@ -126,23 +136,22 @@
                                 n.formula
                                 nv.value_ppm
                                 #:from (TableExpr:AST ,joined)
-                                #:where (= cr.id ,(crop-requirement-id crop-requirement))))])
+                                #:where (= cr.id ,(->cr-id cr-or-id))))])
     (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
 
-(define (get-crop-requirement-value crop-requirement nutrient)
+(define (get-crop-requirement-value cr-or-id nutrient)
   (query-maybe-value (current-conn)
                      (select value_ppm
                              #:from (TableExpr:AST ,joined)
-                             #:where (and (= cr.id ,(crop-requirement-id crop-requirement))
+                             #:where (and (= cr.id ,(->cr-id cr-or-id))
                                           (= nv.nutrient_id ,(nutrient-id nutrient))))))
 
 ;; UPDATE
 
 ;; DELETE
 
-(define (delete-crop-requirement! crop-requirement)
-  (define id (crop-requirement-id crop-requirement))
-  (query-exec (current-conn) (delete #:from crop_requirements #:where (= id ,id))))
+(define (delete-crop-requirement! cr-or-id)
+  (query-exec (current-conn) (delete #:from crop_requirements #:where (= id ,(->cr-id cr-or-id)))))
 
 ;; Helpers
 
diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt
index b0ac7de..4481010 100644
--- a/models/fertilizer-product.rkt
+++ b/models/fertilizer-product.rkt
@@ -13,9 +13,9 @@
            (->* ()
                 (#:id (or/c #f exact-nonnegative-integer?) #:canonical-name (or/c #f string?))
                 (or/c fertilizer-product? #f))]
-          [get-fertilizer-product-values (-> fertilizer-product? nutrient-value-hash/c)]
-          [get-fertilizer-product-value (-> fertilizer-product? nutrient? (or/c #f number?))]
-          [delete-fertilizer-product! (-> fertilizer-product? void?)]))
+          [get-fertilizer-product-values (-> fertilizer-product-or-id/c nutrient-value-hash/c)]
+          [get-fertilizer-product-value (-> fertilizer-product-or-id/c nutrient? (or/c #f number?))]
+          [delete-fertilizer-product! (-> fertilizer-product-or-id/c void?)]))
 
 (require racket/contract
          db
@@ -42,6 +42,15 @@
                (~a (nutrient-canonical-name n) #:min-width 14)
                (~a v #:max-width 6 #:align 'right)))))
 
+(define fertilizer-product-id? exact-nonnegative-integer?)
+
+(define fertilizer-product-or-id/c (or/c fertilizer-product? fertilizer-product-id?))
+
+(define (->fp-id fp-or-id)
+  (match fp-or-id
+    [(? fertilizer-product-id? id) id]
+    [(fertilizer-product id _ _ _) id]))
+
 ;; CREATE
 
 (define (create-fertilizer-product! canonical-name brand-name nutrient-values)
@@ -129,7 +138,7 @@
     [(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)
+(define (get-fertilizer-product-values fp-or-id)
   (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
               (in-query (current-conn)
                         (select n.id
@@ -138,20 +147,19 @@
                                 n.formula
                                 nv.value_ppm
                                 #:from (TableExpr:AST ,joined)
-                                #:where (= fp.id ,(fertilizer-product-id fertilizer-product))))])
+                                #:where (= fp.id ,(->fp-id fp-or-id))))])
     (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
 
-(define (get-fertilizer-product-value fertilizer-product nutrient)
+(define (get-fertilizer-product-value fp-or-id nutrient)
   (query-maybe-value (current-conn)
                      (select value_ppm
                              #:from (TableExpr:AST ,joined)
-                             #:where (and (= fp.id ,(fertilizer-product-id fertilizer-product))
+                             #:where (and (= fp.id ,(->fp-id fp-or-id))
                                           (= nv.nutrient_id ,(nutrient-id nutrient))))))
 
 ;; UPDATE
 
 ;; DELETE
 
-(define (delete-fertilizer-product! fertilizer-product)
-  (define id (fertilizer-product-id fertilizer-product))
-  (query-exec (current-conn) (delete #:from fertilizer_products #:where (= id ,id))))
+(define (delete-fertilizer-product! fp-or-id)
+  (query-exec (current-conn) (delete #:from fertilizer_products #:where (= id ,(->fp-id fp-or-id)))))
diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt
index 913e402..b4baba6 100644
--- a/models/nutrient-measurement.rkt
+++ b/models/nutrient-measurement.rkt
@@ -12,11 +12,11 @@
            (->* ()
                 (#:id (or/c #f exact-nonnegative-integer?) #:measured-on (or/c #f string?))
                 (or/c nutrient-measurement? #f))]
-          [get-nutrient-measurement-values (-> nutrient-measurement? nutrient-value-hash/c)]
-          [get-nutrient-measurement-value (-> nutrient-measurement? nutrient? (or/c number? #f))]
-          [get-latest-nutrient-measurement-value (-> nutrient? (or/c number? #f))]
+          [get-nutrient-measurement-values (-> nutrient-measurement-or-id/c nutrient-value-hash/c)]
+          [get-nutrient-measurement-value (-> nutrient-measurement-or-id/c nutrient? (or/c real? #f))]
+          [get-latest-nutrient-measurement-value (-> nutrient? (or/c real? #f))]
           [get-latest-nutrient-measurement-hash (-> nutrient-value-hash/c)]
-          [delete-nutrient-measurement! (-> nutrient-measurement? void?)]))
+          [delete-nutrient-measurement! (-> nutrient-measurement-or-id/c void?)]))
 
 (require racket/contract
          db
@@ -38,6 +38,15 @@
                (~a (nutrient-canonical-name n) #:min-width 14)
                (~a v #:max-width 6 #:align 'right)))))
 
+(define nutrient-measurement-id? exact-nonnegative-integer?)
+
+(define nutrient-measurement-or-id/c (or/c nutrient-measurement? nutrient-measurement-id?))
+
+(define (->nm-id nm-or-id)
+  (match nm-or-id
+    [(? nutrient-measurement-id? id) id]
+    [(nutrient-measurement id _ _) id]))
+
 ;; CREATE
 
 (define (create-nutrient-measurement! measured-on nutrient-values)
@@ -120,7 +129,7 @@
     [(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)
+(define (get-nutrient-measurement-values nm-or-id)
   (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
               (in-query (current-conn)
                         (select n.id
@@ -129,14 +138,14 @@
                                 n.formula
                                 nv.value_ppm
                                 #:from (TableExpr:AST ,joined)
-                                #:where (= nm.id ,(nutrient-measurement-id nutrient-measurement))))])
+                                #:where (= nm.id ,(->nm-id nm-or-id))))])
     (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
 
-(define (get-nutrient-measurement-value nutrient-measurement nutrient)
+(define (get-nutrient-measurement-value nm-or-id nutrient)
   (query-maybe-value (current-conn)
                      (select value_ppm
                              #:from (TableExpr:AST ,joined)
-                             #:where (and (= nm.id ,(nutrient-measurement-id nutrient-measurement))
+                             #:where (and (= nm.id ,(->nm-id nm-or-id))
                                           (= nv.nutrient_id ,(nutrient-id nutrient))))))
 
 (define (get-latest-nutrient-measurement-value nutrient)
@@ -171,9 +180,9 @@
 
 ;; DELETE
 
-(define (delete-nutrient-measurement! nutrient-measurement)
-  (define id (nutrient-measurement-id nutrient-measurement))
-  (query-exec (current-conn) (delete #:from nutrient_measurements #:where (= id ,id))))
+(define (delete-nutrient-measurement! nm-or-id)
+  (query-exec (current-conn)
+              (delete #:from nutrient_measurements #:where (= id ,(->nm-id nm-or-id)))))
 
 (module+ test
   (require rackunit
diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt
index cffa657..10c0c42 100644
--- a/models/nutrient-target.rkt
+++ b/models/nutrient-target.rkt
@@ -5,18 +5,18 @@
          nutrient-target-id
          (rename-out [nutrient-target-effective-on nutrient-target-date]
                      [nutrient-target-nutrient-values nutrient-target-values])
-         (contract-out [create-nutrient-target! (-> string? nutrient-value-hash/c nutrient-target?)]
-                       [get-nutrient-targets (-> (listof nutrient-target?))]
-                       [get-nutrient-target
-                        (->* ()
-                             (#:id (or/c #f exact-nonnegative-integer?)
-                                   #:effective-on (or/c #f string?))
-                             (or/c nutrient-target? #f))]
-                       [get-nutrient-target-values (-> nutrient-target? nutrient-value-hash/c)]
-                       [get-nutrient-target-value (-> nutrient-target? nutrient? (or/c number? #f))]
-                       [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
-                       [get-latest-nutrient-target-hash (-> nutrient-value-hash/c)]
-                       [delete-nutrient-target! (-> nutrient-target? void?)]))
+         (contract-out
+          [create-nutrient-target! (-> string? nutrient-value-hash/c nutrient-target?)]
+          [get-nutrient-targets (-> (listof nutrient-target?))]
+          [get-nutrient-target
+           (->* ()
+                (#:id (or/c #f exact-nonnegative-integer?) #:effective-on (or/c #f string?))
+                (or/c nutrient-target? #f))]
+          [get-nutrient-target-values (-> nutrient-target-or-id/c nutrient-value-hash/c)]
+          [get-nutrient-target-value (-> nutrient-target-or-id/c nutrient? (or/c number? #f))]
+          [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
+          [get-latest-nutrient-target-hash (-> nutrient-value-hash/c)]
+          [delete-nutrient-target! (-> nutrient-target-or-id/c void?)]))
 
 (require racket/contract
          db
@@ -35,6 +35,15 @@
                (~a (nutrient-canonical-name n) #:min-width 14)
                (~a v #:max-width 6 #:align 'right)))))
 
+(define nutrient-target-id? exact-nonnegative-integer?)
+
+(define nutrient-target-or-id/c (or/c nutrient-target? nutrient-target-id?))
+
+(define (->nt-id nt-or-id)
+  (match nt-or-id
+    [(? nutrient-target-id? id) id]
+    [(nutrient-target id _ _) id]))
+
 ;; CREATE
 
 (define (create-nutrient-target! effective-on nutrient-values)
@@ -73,19 +82,21 @@
   (nutrient-target nt-id effective-on (residuals->nutrient-value-hash residuals)))
 
 (define (get-nutrient-targets)
-  (for/list ([grouped-row (in-query (current-conn)
-                                    (select nt.id
-                                            nt.effective_on
-                                            n.id
-                                            n.canonical_name
-                                            n.french_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 grouped-rows
+    (query-rows (current-conn)
+                (select nt.id
+                        nt.effective_on
+                        n.id
+                        n.canonical_name
+                        n.french_name
+                        n.formula
+                        nv.value_ppm
+                        #:from (TableExpr:AST ,joined)
+                        #:order-by nt.effective_on
+                        #:desc)
+                #:group '#(0 1)))
+  (for/list ([row grouped-rows])
+    (grouped-row->nutrient-target row)))
 
 (define (get-nutrient-target #:id [nt-id #f] #:effective-on [effective-on #f])
   (define where
@@ -114,7 +125,7 @@
     [(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)
+(define (get-nutrient-target-values nt-or-id)
   (for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
               (in-query (current-conn)
                         (select n.id
@@ -123,14 +134,14 @@
                                 n.formula
                                 nv.value_ppm
                                 #:from (TableExpr:AST ,joined)
-                                #:where (= nt.id ,(nutrient-target-id nutrient-target))))])
+                                #:where (= nt.id ,(->nt-id nt-or-id))))])
     (values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
 
-(define (get-nutrient-target-value nutrient-target nutrient)
+(define (get-nutrient-target-value nt-or-id nutrient)
   (query-maybe-value (current-conn)
                      (select value_ppm
                              #:from (TableExpr:AST ,joined)
-                             #:where (and (= nt.id ,(nutrient-target-id nutrient-target))
+                             #:where (and (= nt.id ,(->nt-id nt-or-id))
                                           (= nv.nutrient_id ,(nutrient-id nutrient))))))
 
 (define (get-latest-nutrient-target-value nutrient)
@@ -165,6 +176,6 @@
 
 ;; DELETE
 
-(define (delete-nutrient-target! nutrient-target)
+(define (delete-nutrient-target! nt-or-id)
   (define id (nutrient-target-id nutrient-target))
-  (query-exec (current-conn) (delete #:from nutrient_targets #:where (= id ,id))))
+  (query-exec (current-conn) (delete #:from nutrient_targets #:where (= id ,(->nt-id nt-or-id)))))