diff options
Diffstat (limited to 'models/nutrient-target.rkt')
| -rw-r--r-- | models/nutrient-target.rkt | 58 |
1 files changed, 27 insertions, 31 deletions
diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt index 261fce0..a19ca6a 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? (listof nutrient-value-pair/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? (listof nutrient-value-pair/c))] - [get-nutrient-target-value (-> nutrient-target? nutrient? number?)] - [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))] - [get-latest-nutrient-target-hash (-> (hash/c nutrient? number?))] - [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? nutrient-value-hash/c)] + [get-nutrient-target-value (-> nutrient-target? nutrient? number?)] + [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))] + [get-latest-nutrient-target-hash (-> (hash/c nutrient? number?))] + [delete-nutrient-target! (-> nutrient-target? void?)])) (require racket/contract db @@ -29,8 +29,7 @@ #:property prop:custom-write (λ (v out _) (fprintf out "Target #~a on ~a\n" (nutrient-target-id v) (nutrient-target-effective-on v)) - (for ([nv (nutrient-target-nutrient-values v)]) - (match-define (cons n v) nv) + (for ([(n v) (in-hash (nutrient-target-nutrient-values v))]) (fprintf out "~a ~a\n" (~a (nutrient-name n) #:min-width 14) @@ -50,8 +49,7 @@ (define nvs-id (query-value (current-conn) (select id #:from nutrient_value_sets #:where (= nutrient_target_id ,nt-id)))) - (for ([nv nutrient-values]) - (match-define (cons n v) nv) + (for ([(n v) (in-hash nutrient-values)]) (query-exec (current-conn) (insert #:into nutrient_values #:set [value_set_id ,nvs-id] @@ -72,8 +70,7 @@ (define (grouped-row->nutrient-target row) (match-define (vector nt-id effective-on residuals) row) - (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals)) - (nutrient-target nt-id effective-on nutrient-value-pairs)) + (nutrient-target nt-id effective-on (residuals->nutrient-value-hash residuals))) (define (get-nutrient-targets) (for/list ([grouped-row (in-query (current-conn) @@ -116,7 +113,7 @@ [many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))])) (define (get-nutrient-target-values nutrient-target) - (for/list ([(nutrient-id name formula value_ppm) + (for/hash ([(nutrient-id name formula value_ppm) (in-query (current-conn) (select n.id n.canonical_name @@ -124,7 +121,7 @@ nv.value_ppm #:from (TableExpr:AST ,joined) #:where (= nt.id ,(nutrient-target-id nutrient-target))))]) - (cons (nutrient nutrient-id name formula) value_ppm))) + (values (nutrient nutrient-id name formula) value_ppm))) (define (get-nutrient-target-value nutrient-target nutrient) (query-maybe-value (current-conn) @@ -143,17 +140,16 @@ #:limit 1))) (define (get-latest-nutrient-target-hash) - (for/hash ([(n-id n-name n-formula residual-rows) - (in-query (current-conn) - (select n.id - n.canonical_name - n.formula - nt.effective_on - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by nt.effective_on - #:desc) - #:group '(#(0 1 2)))]) + (for/hash ([(n-id n-name n-formula residual-rows) (in-query (current-conn) + (select n.id + n.canonical_name + n.formula + nt.effective_on + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by nt.effective_on + #:desc) + #:group '(#(0 1 2)))]) ;; residual-rows is a non-empty list of vectors: #(effective_on value_ppm) (match-define (vector _effective-on value-ppm) (first residual-rows)) (values (nutrient n-id n-name n-formula) value-ppm))) |