diff options
Diffstat (limited to 'models/fertilizer-product.rkt')
| -rw-r--r-- | models/fertilizer-product.rkt | 177 |
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)))) |