Absorb existing domain data.

1 files changed, 177 insertions, 0 deletions

diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt
new file mode 100644
index 0000000..254ce35
--- /dev/null
+++ b/models/fertilizer-product.rkt
@@ -0,0 +1,177 @@
+#lang racket
+
+(provide
+ ;; Struct definitions
+ fertilizer-product
+ fertilizer-product?
+ fertilizer-product-id fertilizer-product-brand-name
+ ;; SQL CRUD
+ (contract-out
+  [create-fertilizer-product! (->* (string?
+                                    (listof (cons/c
+                                             nutrient?
+                                             number?)))
+                                   (string?)
+                                   fertilizer-product?)]
+  [get-fertilizer-products (->* ()
+                                (#:id
+                                 (or/c #f exact-nonnegative-integer?)
+                                 #:brand-name
+                                 (or/c #f string?))
+                                (listof fertilizer-product?))]
+  [get-fertilizer-product (->* ()
+                               (#:id
+                                (or/c #f exact-nonnegative-integer?)
+                                #:brand-name
+                                (or/c #f string?))
+                               (or/c fertilizer-product? #f))]
+  [get-fertilizer-product-values (-> fertilizer-product?
+                                     (listof (cons/c
+                                              nutrient?
+                                              number?)))]
+  [get-fertilizer-product-value (-> fertilizer-product?
+                                    nutrient?
+                                    number?)]
+  [get-latest-fertilizer-product-value (-> nutrient? number?)]
+  [delete-fertilizer-product! (-> fertilizer-product?
+                                  void?)]))
+
+(require racket/contract
+         db
+         sql
+         "../db/conn.rkt"
+         "nutrient.rkt")
+
+;; Instances of this struct are persisted in the fertilizer_products table.
+(struct fertilizer-product (id canonical-name brand-name) #:transparent)
+
+
+;; CREATE
+
+
+(define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f])
+  (define existing-fertilizer-product (get-fertilizer-product #:canonical-name canonical-name))
+  (define (new-fertilizer-product)
+    (with-tx
+      (query-exec (current-conn)
+                  (cond
+                    [brand-name
+                     (insert #:into fertilizer_products
+                             #:set [canonical_name ,canonical-name] [brand_name ,brand-name])]
+                    [else
+                     (insert #:into fertilizer_products
+                             #:set [canonical_name ,canonical-name])]))
+      (define nm-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name)))
+      (query-exec (current-conn)
+                  (insert #:into nutrient_value_sets
+                          #:set [fertilizer_product_id ,nm-id]))
+      (define nvs-id (query-value (current-conn)
+                                  (select id
+                                          #:from nutrient_value_sets
+                                          #:where (= fertilizer_product_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-fertilizer-product #:canonical-name canonical-name))
+  (or existing-fertilizer-product
+      (new-fertilizer-product)))
+
+
+;; READ
+
+(define (get-fertilizer-products #:id [id #f]
+                                   #:brand-name [brand-name #f])
+  (define (where-expr)
+    (define clauses
+      (filter values
+              (list (and id (format "id = ~e" id))
+                    (and brand-name (format "brand_name = ~e" brand-name)))))
+    (cond
+      [(null? clauses) ""]
+      [else (format "WHERE ~a" (string-join clauses " AND "))]))
+  (define query (string-join
+                 `("SELECT id, brand_name"
+                   "FROM fertilizer_products"
+                   ,(where-expr)
+                   "ORDER BY id ASC")))
+  (for/list ([(id* brand-name*)
+              (in-query (current-conn) query)])
+    (fertilizer-product id* brand-name*)))
+
+(define (get-fertilizer-product #:id [id #f]
+                                #:canonical-name [canonical-name #f]
+                                #:brand-name [brand-name #f])
+  (define (where-expr)
+    (define clauses
+      (filter values
+              (list
+               (and id (format "id = ~e" id))
+               (and canonical-name (format "canonical_name = ~e" canonical-name))
+               (and brand-name (format "brand_name = ~e" brand-name)))))
+    (cond
+      [(null? clauses) ""]
+      [else (format "WHERE ~a" (string-join clauses " AND "))]))
+  (match (query-maybe-row (current-conn)
+                          (string-join
+                           `("SELECT id, canonical_name, brand_name"
+                             "FROM fertilizer_products"
+                             ,(where-expr)
+                             "ORDER BY id ASC"
+                             "LIMIT 1")))
+    [(vector id* canonical-name* brand-name*)
+     (fertilizer-product id* canonical-name* brand-name*)]
+    [#f #f]))
+
+(define (get-fertilizer-product-values fertilizer-product)
+  (for/list ([(nutrient-id name formula value_ppm)
+              (in-query (current-conn)
+                        (string-join
+                         '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
+                           "FROM nutrient_values nv"
+                           "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
+                           "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
+                           "JOIN nutrients n ON n.id = nv.nutrient_id"
+                           "WHERE nm.id = $1"))
+                        (fertilizer-product-id fertilizer-product))])
+    (cons (nutrient nutrient-id name formula) value_ppm)))
+
+(define (get-fertilizer-product-value fertilizer-product nutrient)
+  (query-maybe-value (current-conn)
+                     (string-join
+                      '("SELECT value_ppm"
+                        "FROM nutrient_values nv"
+                        "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
+                        "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
+                        "WHERE nm.id = $1 AND nv.nutrient_id = $2"))
+                     (fertilizer-product-id fertilizer-product)
+                     (nutrient-id nutrient)))
+
+(define (get-latest-fertilizer-product-value nutrient)
+  (query-maybe-value (current-conn)
+                     (string-join
+                      '("SELECT value_ppm"
+                        "FROM nutrient_values nv"
+                        "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
+                        "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
+                        "WHERE nv.nutrient_id = $1"
+                        "ORDER BY nm.brand_name DESC"
+                        "LIMIT 1"))
+                     (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))))