diff options
Diffstat (limited to 'models')
| -rw-r--r-- | models/fertilizer-product.rkt | 65 | ||||
| -rw-r--r-- | models/nutrient-value.rkt | 8 |
2 files changed, 50 insertions, 23 deletions
diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt index 152b72a..c579354 100644 --- a/models/fertilizer-product.rkt +++ b/models/fertilizer-product.rkt @@ -3,18 +3,20 @@ (provide fertilizer-product fertilizer-product? fertilizer-product-id + fertilizer-product-value (rename-out [fertilizer-product-canonical-name fertilizer-product-name] [fertilizer-product-nutrient-values fertilizer-product-values] [fertilizer-product-brand-name fertilizer-brand-name]) - (contract-out - [create-fertilizer-product! (-> string? string? nutrient-value-hash/c fertilizer-product?)] - [get-fertilizer-products (-> (listof fertilizer-product?))] - [get-fertilizer-product - (->* () (#:id db-id? #:canonical-name string?) (or/c fertilizer-product? #f))] - [get-fertilizer-product-values (-> fertilizer-product-or-id/c nutrient-value-hash/c)] - [get-fertilizer-product-value - (-> fertilizer-product-or-id/c nutrient? maybe-nutrient-value?)] - [delete-fertilizer-product! (-> fertilizer-product-or-id/c void?)])) + (contract-out [create-fertilizer-product! (-> fertilizer-product? fertilizer-product?)] + [get-fertilizer-products (-> (listof fertilizer-product?))] + [get-fertilizer-product + (->* () (#:id db-id? #:canonical-name string?) (or/c fertilizer-product? #f))] + [get-fertilizer-product-values + (-> fertilizer-product-or-id/c nutrient-value-hash/c)] + [get-fertilizer-product-value + (-> fertilizer-product-or-id/c nutrient? maybe-nutrient-value?)] + [update-fertilizer-product! (-> fertilizer-product? void?)] + [delete-fertilizer-product! (-> fertilizer-product-or-id/c void?)])) (require racket/contract db @@ -46,6 +48,9 @@ (~a (nutrient-canonical-name n) #:min-width 14) (~a v #:max-width 6 #:align 'right))))) +(define (fertilizer-product-value fp nutrient) + (hash-ref (fertilizer-product-nutrient-values fp) nutrient #f)) + (define fertilizer-product-or-id/c (or/c fertilizer-product? db-id?)) (define (->fp-id fp-or-id) @@ -55,7 +60,10 @@ ;; CREATE -(define (create-fertilizer-product! canonical-name brand-name nutrient-values) +(define (create-fertilizer-product! fp) + (define canonical-name (fertilizer-product-canonical-name fp)) + (define brand-name (fertilizer-product-brand-name fp)) + (define nutrient-values (fertilizer-product-nutrient-values fp)) (with-tx (define fp-id (insert-id (query (current-conn) (insert #:into fertilizer_products @@ -66,7 +74,7 @@ (insert #:into nutrient_value_sets #:set [fertilizer_product_id ,fp-id])))) (insert-nutrient-values (current-conn) nvs-id nutrient-values) - (fertilizer-product nvs-id canonical-name brand-name nutrient-values))) + (fertilizer-product fp-id canonical-name brand-name nutrient-values))) ;; READ @@ -149,6 +157,21 @@ ;; UPDATE +(define (update-fertilizer-product! fp) + (define id + (or (fertilizer-product-id fp) + (raise-argument-error 'update-fertilizer-product! "db-id?" (fertilizer-product-id fp)))) + (with-tx + (query-exec (current-conn) + (update fertilizer_products + #:set [canonical_name ,(fertilizer-product-canonical-name fp)] + [brand_name ,(fertilizer-product-brand-name fp)] + #:where [= id ,id])) + (define nvs-id + (query-value (current-conn) + (select id #:from nutrient_value_sets #:where [= fertilizer_product_id ,id]))) + (update-nutrient-values! (current-conn) nvs-id (fertilizer-product-nutrient-values fp)))) + ;; DELETE (define (delete-fertilizer-product! fp-or-id) @@ -177,9 +200,10 @@ (define nitrogen (get-nutrient #:name "Nitrogen")) (define phosphorus (get-nutrient #:name "Phosphorus")) - (create-fertilizer-product! canonical-product-name - "MasterBlend" - (hash nitrogen 40 phosphorus 200)) + (create-fertilizer-product! (fertilizer-product #f + canonical-product-name + "MasterBlend" + (hash nitrogen 40 phosphorus 200))) (check-equal? (length (get-fertilizer-products)) 1) @@ -188,13 +212,6 @@ (check-equal? (fertilizer-product-canonical-name fp) canonical-product-name) (check-equal? (fertilizer-product-brand-name fp) "MasterBlend")) - (test-case "Create product without brand name" - (define nitrogen (get-nutrient #:name "Nitrogen")) - - (define fp (create-fertilizer-product! "Generic N" "" (hash nitrogen 100))) - - (check-false (fertilizer-product-brand-name fp))) - (test-case "Check all product values" (define nitrogen (get-nutrient #:name "Nitrogen")) (define phosphorus (get-nutrient #:name "Phosphorus")) @@ -225,7 +242,9 @@ (test-case "Custom write property formatting" (define nitrogen (get-nutrient #:name "Nitrogen")) - (define fp (create-fertilizer-product! "Test Fertilizer" "TestBrand" (hash nitrogen 50))) + (define fp + (create-fertilizer-product! + (fertilizer-product #f "Test Fertilizer" "TestBrand" (hash nitrogen 50)))) (define output (open-output-string)) (write fp output) @@ -240,6 +259,6 @@ (delete-fertilizer-product! fp) (check-false (get-fertilizer-product #:id (fertilizer-product-id fp))) (check-equal? (length (get-fertilizer-products)) - 2 + 1 "wrong number of fertilizer products were deleted") (check-true (hash-empty? (get-fertilizer-product-values fp))))))) diff --git a/models/nutrient-value.rkt b/models/nutrient-value.rkt index b5798db..08bcfad 100644 --- a/models/nutrient-value.rkt +++ b/models/nutrient-value.rkt @@ -5,6 +5,7 @@ nutrient-value-hash/c (contract-out [insert-nutrient-values (-> connection? db-id? nutrient-value-hash/c (listof (cons/c symbol? any/c)))] + [update-nutrient-values! (-> connection? db-id? nutrient-value-hash/c void?)] [residuals->nutrient-value-hash (-> (listof residual-vector/c) nutrient-value-hash/c)])) @@ -33,6 +34,13 @@ #:from (TableExpr:AST ,(make-values*-table-expr-ast nv-rows))))) (simple-result-info result)) +(define (update-nutrient-values! conn nvs-id nutrient-values) + (for ([(n v) (in-hash nutrient-values)]) + (query-exec conn + (update nutrient_values + #:set [value_ppm ,v] + #:where (and (= value_set_id ,nvs-id) (= nutrient_id ,(nutrient-id n))))))) + (define (residuals->nutrient-value-hash residuals) (for/hash ([r (in-list residuals)]) (match-define (vector n-id n-canonical-name n-french-name n-formula value-ppm) r) |