diff options
Diffstat (limited to 'models/nutrient-target.rkt')
| -rw-r--r-- | models/nutrient-target.rkt | 152 |
1 files changed, 69 insertions, 83 deletions
diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt index c2f9c2e..922dba7 100644 --- a/models/nutrient-target.rkt +++ b/models/nutrient-target.rkt @@ -34,102 +34,89 @@ #:transparent #:property prop:custom-write (λ (v out _) - (fprintf out "Target #~a on ~a\n" - (nutrient-target-id v) - (nutrient-target-effective-on v)) + (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) - (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-nutrient-target! effective-on nutrient-values) (or (get-nutrient-target #:effective-on effective-on) (with-tx - (query-exec (current-conn) - (insert #:into nutrient_targets - #:set [effective_on ,effective-on])) - (define nt-id (query-value (current-conn) - (select id - #:from nutrient_targets - #:where (= effective_on ,effective-on)))) - (query-exec (current-conn) - (insert #:into nutrient_value_sets - #:set [nutrient_target_id ,nt-id])) - (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) - (query-exec (current-conn) - (insert #:into nutrient_values - #:set - [value_set_id ,nvs-id] - [nutrient_id ,(nutrient-id n)] - [value_ppm ,v]))) - (get-nutrient-target #:effective-on effective-on)))) - + (query-exec (current-conn) (insert #:into nutrient_targets #:set [effective_on ,effective-on])) + (define nt-id + (query-value (current-conn) + (select id #:from nutrient_targets #:where (= effective_on ,effective-on)))) + (query-exec (current-conn) + (insert #:into nutrient_value_sets #:set [nutrient_target_id ,nt-id])) + (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) + (query-exec (current-conn) + (insert #:into nutrient_values + #:set [value_set_id ,nvs-id] + [nutrient_id ,(nutrient-id n)] + [value_ppm ,v]))) + (get-nutrient-target #:effective-on effective-on)))) ;; READ (struct acc (effective-on pairs) #:transparent) (define joined - (table-expr-qq - (inner-join - (inner-join - (inner-join - (as nutrient_targets nt) - (as nutrient_value_sets nvs) - #:on (= nvs.nutrient_target_id nt.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 nutrient_targets nt) + (as nutrient_value_sets nvs) + #:on (= nvs.nutrient_target_id nt.id)) + (as nutrient_values nv) + #:on (= nv.value_set_id nvs.id)) + (as nutrients n) + #:on (= n.id nv.nutrient_id)))) (define (get-nutrient-targets) - (define query (select nt.id nt.effective_on - n.id n.canonical_name n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by nt.effective_on #:desc)) + (define query + (select nt.id + nt.effective_on + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by nt.effective_on + #:desc)) (define rows (query-rows (current-conn) query)) (define by-id (for/fold ([h (hash)]) ([row (in-list rows)]) (match-define (vector nt-id effective-on 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 nt-id - (λ (old-acc) - (acc (acc-effective-on old-acc) - (cons nv-pair (acc-pairs old-acc)))) - (λ () - (acc effective-on - (list nv-pair)))))) + (hash-update h + nt-id + (λ (old-acc) (acc (acc-effective-on old-acc) (cons nv-pair (acc-pairs old-acc)))) + (λ () (acc effective-on (list nv-pair)))))) (for/list ([(id a) (in-hash by-id)]) - (nutrient-target id - (acc-effective-on a) - (reverse (acc-pairs a))))) + (nutrient-target id (acc-effective-on a) (reverse (acc-pairs a))))) -(define (get-nutrient-target #:id [nt-id #f] - #:effective-on [effective-on #f]) +(define (get-nutrient-target #:id [nt-id #f] #:effective-on [effective-on #f]) (define where (cond [(and nt-id effective-on) - (scalar-expr-qq (and (= nt.id ,nt-id) - (= nt.effective_on ,effective-on)))] - [nt-id - (scalar-expr-qq (= nt.id ,nt-id))] - [effective-on - (scalar-expr-qq (= nt.effective_on ,effective-on))])) - (define query (select nt.id nt.effective_on - n.id n.canonical_name n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:where (ScalarExpr:AST ,where))) + (scalar-expr-qq (and (= nt.id ,nt-id) (= nt.effective_on ,effective-on)))] + [nt-id (scalar-expr-qq (= nt.id ,nt-id))] + [effective-on (scalar-expr-qq (= nt.effective_on ,effective-on))])) + (define query + (select nt.id + nt.effective_on + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:where (ScalarExpr:AST ,where))) (define rows (query-rows (current-conn) query)) (cond [(null? rows) #f] @@ -139,21 +126,22 @@ (define A #f) (for ([row (in-list rows)]) (match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row) - (unless the-id (set! the-id nt-id)) + (unless the-id + (set! the-id nt-id)) (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm)) - (set! A (if A - (acc (acc-effective-on A) - (cons nv-pair (acc-pairs A))) - (acc effective-on (list nv-pair))))) - (and A - (nutrient-target the-id - (acc-effective-on A) - (reverse (acc-pairs A))))])) + (set! A + (if A + (acc (acc-effective-on A) (cons nv-pair (acc-pairs A))) + (acc effective-on (list nv-pair))))) + (and A (nutrient-target the-id (acc-effective-on A) (reverse (acc-pairs A))))])) (define (get-nutrient-target-values nutrient-target) (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 ,(nutrient-target-id nutrient-target))))]) (cons (nutrient nutrient-id name formula) value_ppm))) @@ -170,17 +158,15 @@ (select value_ppm #:from (TableExpr:AST ,joined) #:where (= nv.nutrient_id ,(nutrient-id nutrient)) - #:order-by nt.effective_on #:desc + #:order-by nt.effective_on + #:desc #:limit 1))) ;; UPDATE - ;; DELETE (define (delete-nutrient-target! nutrient-target) (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 ,id)))) |