diff options
Diffstat (limited to 'models')
| -rw-r--r-- | models/crop-requirement.rkt | 29 | ||||
| -rw-r--r-- | models/fertilizer-product.rkt | 28 | ||||
| -rw-r--r-- | models/nutrient-measurement.rkt | 31 | ||||
| -rw-r--r-- | models/nutrient-target.rkt | 73 |
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))))) |