diff options
Diffstat (limited to 'models/fertilizer-product.rkt')
| -rw-r--r-- | models/fertilizer-product.rkt | 224 |
1 files changed, 101 insertions, 123 deletions
diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt index 0809f73..225af10 100644 --- a/models/fertilizer-product.rkt +++ b/models/fertilizer-product.rkt @@ -1,29 +1,24 @@ #lang racket -(provide - ;; Model struct - fertilizer-product - fertilizer-product? - fertilizer-product-id - (rename-out - [fertilizer-product-canonical-name fertilizer-name] - [fertilizer-product-nutrient-values fertilizer-product-values] - [fertilizer-product-brand-name fertilizer-brand-name]) - (contract-out - ;; SQL CRUD - [create-fertilizer-product! (->* (string? - (listof nutrient-value-pair/c)) - (string?) - fertilizer-product?)] - [get-fertilizer-products (-> (listof fertilizer-product?))] - [get-fertilizer-product (->* () - (#:id (or/c #f exact-nonnegative-integer?) - #:canonical-name (or/c #f string?)) - (or/c fertilizer-product? #f))] - [get-fertilizer-product-values (-> fertilizer-product? - (listof nutrient-value-pair/c))] - [get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)] - [delete-fertilizer-product! (-> fertilizer-product? void?)])) +;; Model struct +(provide fertilizer-product + fertilizer-product? + fertilizer-product-id + (rename-out [fertilizer-product-canonical-name fertilizer-name] + [fertilizer-product-nutrient-values fertilizer-product-values] + [fertilizer-product-brand-name fertilizer-brand-name]) + (contract-out + ;; SQL CRUD + [create-fertilizer-product! + (->* (string? (listof nutrient-value-pair/c)) (string?) fertilizer-product?)] + [get-fertilizer-products (-> (listof fertilizer-product?))] + [get-fertilizer-product + (->* () + (#:id (or/c #f exact-nonnegative-integer?) #:canonical-name (or/c #f string?)) + (or/c fertilizer-product? #f))] + [get-fertilizer-product-values (-> fertilizer-product? (listof nutrient-value-pair/c))] + [get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)] + [delete-fertilizer-product! (-> fertilizer-product? void?)])) (require racket/contract db @@ -34,123 +29,112 @@ ;; Instances of this struct are persisted in the fertilizer_products table. (struct fertilizer-product (id canonical-name nutrient-values brand-name) #:transparent - #:guard - (λ (id canonical-name nutrient-values brand-name _) - (values id - canonical-name - nutrient-values - (if (sql-null? brand-name) #f brand-name))) + #:guard (λ (id canonical-name nutrient-values brand-name _) + (values id canonical-name nutrient-values (if (sql-null? brand-name) #f brand-name))) #:property prop:custom-write (λ (v out _mode) (fprintf out "Fertilizer #~a\n" (fertilizer-product-id v)) (if (fertilizer-product-brand-name v) - (fprintf out "~a (~a)\n" + (fprintf out + "~a (~a)\n" (fertilizer-product-canonical-name v) (fertilizer-product-brand-name v)) - (fprintf out "~a\n" - (fertilizer-product-canonical-name v))) + (fprintf out "~a\n" (fertilizer-product-canonical-name v))) (for ([nv (in-list (fertilizer-product-nutrient-values v))]) (match-define (cons n v) nv) - (fprintf out "~a ~a\n" + (fprintf out + "~a ~a\n" (~a (nutrient-name n) #:min-width 14) (~a v #:max-width 6 #:align 'right))))) - ;; CREATE (define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f]) - (or (get-fertilizer-product #:canonical-name canonical-name) - (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 fp-id (query-value (current-conn) - (select id - #:from fertilizer_products - #:where (= canonical_name ,canonical-name)))) - (query-exec (current-conn) - (insert #:into nutrient_value_sets - #:set [fertilizer_product_id ,fp-id])) - (define nvs-id (query-value (current-conn) - (select id - #:from nutrient_value_sets - #:where (= fertilizer_product_id ,fp-id)))) - (for ([nv nutrient-values]) - (match-define (cons n v) nv) - (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 + (get-fertilizer-product #:canonical-name canonical-name) + (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 fp-id + (query-value (current-conn) + (select id #:from fertilizer_products #:where (= canonical_name ,canonical-name)))) + (query-exec (current-conn) + (insert #:into nutrient_value_sets #:set [fertilizer_product_id ,fp-id])) + (define nvs-id + (query-value (current-conn) + (select id #:from nutrient_value_sets #:where (= fertilizer_product_id ,fp-id)))) + (for ([nv nutrient-values]) + (match-define (cons n v) nv) + (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)))) ;; READ (struct acc (canonical-name brand-name pairs) #:transparent) (define joined - (table-expr-qq - (inner-join - (inner-join - (inner-join - (as fertilizer_products fp) - (as nutrient_value_sets nvs) - #:on (= nvs.fertilizer_product_id fp.id)) - (as nutrient_values nv) - #:on (= nv.value_set_id nvs.id)) - (as nutrients n) - #:on (= n.id nv.nutrient_id)))) + (table-expr-qq (inner-join (inner-join (inner-join (as fertilizer_products fp) + (as nutrient_value_sets nvs) + #:on (= nvs.fertilizer_product_id fp.id)) + (as nutrient_values nv) + #:on (= nv.value_set_id nvs.id)) + (as nutrients n) + #:on (= n.id nv.nutrient_id)))) (define (get-fertilizer-products) - (define query (select fp.id fp.canonical_name fp.brand_name - n.id n.canonical_name n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by fp.canonical_name #:asc)) + (define query + (select fp.id + fp.canonical_name + fp.brand_name + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by fp.canonical_name + #:asc)) (define rows (query-rows (current-conn) query)) (define by-id (for/fold ([h (hash)]) ([row (in-list rows)]) (match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row) (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm)) - (hash-update h fp-id + (hash-update h + fp-id (λ (old-acc) (acc (acc-canonical-name old-acc) (acc-brand-name old-acc) (cons nv-pair (acc-pairs old-acc)))) - (λ () - (acc canonical-name - brand-name - (list nv-pair)))))) + (λ () (acc canonical-name brand-name (list nv-pair)))))) (for/list ([(id a) (in-hash by-id)]) - (fertilizer-product id - (acc-canonical-name a) - (reverse (acc-pairs a)) - (acc-brand-name a)))) + (fertilizer-product id (acc-canonical-name a) (reverse (acc-pairs a)) (acc-brand-name a)))) -(define (get-fertilizer-product #:id [fp-id #f] - #:canonical-name [canonical-name #f]) +(define (get-fertilizer-product #:id [fp-id #f] #:canonical-name [canonical-name #f]) (define where (cond [(and fp-id canonical-name) - (scalar-expr-qq (and (= fp.id ,fp-id) - (= fp.canonical_name ,canonical-name)))] - [fp-id - (scalar-expr-qq (= fp.id ,fp-id))] - [canonical-name - (scalar-expr-qq (= fp.canonical_name ,canonical-name))])) - (define query (select fp.id fp.canonical_name fp.brand_name - n.id n.canonical_name n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:where (ScalarExpr:AST ,where) - #:limit 1)) + (scalar-expr-qq (and (= fp.id ,fp-id) (= fp.canonical_name ,canonical-name)))] + [fp-id (scalar-expr-qq (= fp.id ,fp-id))] + [canonical-name (scalar-expr-qq (= fp.canonical_name ,canonical-name))])) + (define query + (select fp.id + fp.canonical_name + fp.brand_name + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:where (ScalarExpr:AST ,where) + #:limit 1)) (define rows (query-rows (current-conn) query)) (cond [(null? rows) #f] @@ -160,24 +144,22 @@ (define A #f) (for ([row (in-list rows)]) (match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row) - (unless the-id (set! the-id fp-id)) + (unless the-id + (set! the-id fp-id)) (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm)) - (set! A (if A - (acc (acc-canonical-name A) - (acc-brand-name A) - (cons nv-pair (acc-pairs A))) - (acc canonical-name - brand-name - (list nv-pair))))) - (fertilizer-product the-id - (acc-canonical-name A) - (reverse (acc-pairs A)) - (acc-brand-name A))])) + (set! A + (if A + (acc (acc-canonical-name A) (acc-brand-name A) (cons nv-pair (acc-pairs A))) + (acc canonical-name brand-name (list nv-pair))))) + (fertilizer-product the-id (acc-canonical-name A) (reverse (acc-pairs A)) (acc-brand-name A))])) (define (get-fertilizer-product-values fertilizer-product) (for/list ([(nutrient-id name formula value_ppm) (in-query (current-conn) - (select n.id n.canonical_name n.formula nv.value_ppm + (select n.id + n.canonical_name + n.formula + nv.value_ppm #:from (TableExpr:AST ,joined) #:where (= nm.id ,(fertilizer-product-id fertilizer-product))))]) (cons (nutrient nutrient-id name formula) value_ppm))) @@ -189,14 +171,10 @@ #:where (and (= nm.id ,(fertilizer-product-id fertilizer-product)) (= 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)))) + (query-exec (current-conn) (delete #:from fertilizer_products #:where (= id ,id)))) |