diff options
Diffstat (limited to 'models')
| -rw-r--r-- | models/crop-requirement.rkt | 123 | ||||
| -rw-r--r-- | models/fertilizer-product.rkt | 95 | ||||
| -rw-r--r-- | models/nutrient-measurement.rkt | 92 | ||||
| -rw-r--r-- | models/nutrient-target.rkt | 86 |
4 files changed, 179 insertions, 217 deletions
diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt index f6193bf..6ddf1aa 100644 --- a/models/crop-requirement.rkt +++ b/models/crop-requirement.rkt @@ -60,73 +60,82 @@ ;; READ +(define joined + (table-expr-qq (inner-join (inner-join (inner-join (as crop_requirements cr) + (as nutrient_value_sets nvs) + #:on (= nvs.crop_requirement_id cr.id)) + (as nutrient_values nv) + #:on (= nv.value_set_id nvs.id)) + (as nutrients n) + #:on (= n.id nv.nutrient_id)))) + +(define (grouped-row->crop-requirement row) + (match-define (vector cr-id profile crop-id residuals) row) + (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals)) + (crop-requirement cr-id profile crop-id nutrient-value-pairs)) + (define (get-crop-requirements) - (for/list ([(id* profile* crop-id*) - (in-query (current-conn) - (select id profile crop_id - #:from crop_requirements - #:order-by id #:asc))]) - (crop-requirement id* profile* (if (sql-null? crop-id*) #f crop-id*)))) - -(define (get-crop-requirement #:id [id #f] - #:profile [profile #f] - #:crop [crop #f]) - (define (where-expr) - (define clauses - (filter values - (list - (and id (format "id = ~e" id)) - (and profile (format "profile = ~e" profile)) - (and crop (format "crop_id = ~e" (crop-id crop)))))) + (define grouped-rows + (query-rows (current-conn) + (select cr.id + cr.profile + cr.crop_id + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by cr.id + #:asc) + #:group '#(0 1 2))) + (for/list ([row grouped-rows]) + (grouped-row->crop-requirement row))) + +(define (get-crop-requirement #:id [cr-id #f] #:profile [profile #f] #:crop-id [crop-id #f]) + (define where (cond - [(null? clauses) ""] - [else (format "WHERE ~a" (string-join clauses " AND "))])) - (define query (string-join - `("SELECT id, profile, crop_id" - "FROM crop_requirements" - ,(where-expr) - "ORDER BY id ASC" - "LIMIT 1"))) - (match (query-maybe-row (current-conn) query) - [(vector id* profile* crop-id*) - (crop-requirement id* profile* crop-id*)] - [#f #f])) + [(and cr-id profile crop-id) + (scalar-expr-qq (and (= cr.id ,cr-id) (= cr.profile ,profile) (= cr.crop_id ,crop-id)))] + [cr-id (scalar-expr-qq (= cr.id ,cr-id))] + [profile (scalar-expr-qq (= cr.profile ,profile))] + [crop-id (scalar-expr-qq (= cr.crop_id ,crop-id))] + [else (error 'get-crop-requirement "one of #:id, #:profile or #:crop-id must be provided")])) + + (define grouped-rows + (query-rows (current-conn) + (select cr.id + cr.profile + cr.crop_id + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:where (ScalarExpr:AST ,where)) + #:group '#(0 1 2))) + + (match grouped-rows + ['() #f] + [(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) (for/list ([(nutrient-id name formula value_ppm) (in-query (current-conn) - (string-join '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm" - "FROM nutrient_values nv" - "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id" - "JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id" - "JOIN nutrients n ON n.id = nv.nutrient_id" - "WHERE cr.id = $1")) - (crop-requirement-id crop-requirement))]) + (select n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:where (= cr.id ,(crop-requirement-id crop-requirement))))]) (cons (nutrient nutrient-id name formula) value_ppm))) (define (get-crop-requirement-value crop-requirement nutrient) (query-maybe-value (current-conn) - (string-join - '("SELECT value_ppm" - "FROM nutrient_values nv" - "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id" - "JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id" - "WHERE cr.id = $1 AND nv.nutrient_id = $2")) - (crop-requirement-id crop-requirement) - (nutrient-id nutrient))) - -(define (get-latest-crop-requirement-value nutrient) - (query-maybe-value (current-conn) - (string-join - '("SELECT value_ppm" - "FROM nutrient_values nv" - "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id" - "JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id" - "WHERE nv.nutrient_id = $1" - "ORDER BY cr.profile DESC" - "LIMIT 1")) - (nutrient-id nutrient))) - + (select value_ppm + #:from (TableExpr:AST ,joined) + #:where (and (= cr.id ,(crop-requirement-id crop-requirement)) + (= nv.nutrient_id ,(nutrient-id nutrient)))))) ;; UPDATE diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt index d4006ac..1d6adbb 100644 --- a/models/fertilizer-product.rkt +++ b/models/fertilizer-product.rkt @@ -76,8 +76,6 @@ ;; 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) @@ -87,32 +85,26 @@ (as nutrients n) #:on (= n.id nv.nutrient_id)))) +(define (grouped-row->fertilizer-product row) + (match-define (vector fp-id canonical-name brand-name residuals) row) + (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals)) + (fertilizer-product fp-id canonical-name nutrient-value-pairs brand-name)) + (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 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 - (λ (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)))))) - (for/list ([(id a) (in-hash by-id)]) - (fertilizer-product id (acc-canonical-name a) (reverse (acc-pairs a)) (acc-brand-name a)))) + (define grouped-rows (query-rows (current-conn) + (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) + #:group '#(0 1 2))) + (for/list ([row grouped-rows]) + (grouped-row->fertilizer-product row))) (define (get-fertilizer-product #:id [fp-id #f] #:canonical-name [canonical-name #f]) (define where @@ -120,35 +112,26 @@ [(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)) - (define rows (query-rows (current-conn) query)) - (cond - [(null? rows) #f] - [else - ;; Fold all nutrient value rows belonging to the single fertilizer product into one struct - (define the-id #f) - (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)) - (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))])) + [canonical-name (scalar-expr-qq (= fp.canonical_name ,canonical-name))] + [else (error 'get-fertilizer-product "either #:id or #:canonical-name must be provided")])) + (define grouped-rows + (query-rows (current-conn) + (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) + #:order-by fp.canonical_name + #:asc) + #:group '#(0 1 2))) + (match grouped-rows + ['() #f] + [(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) (for/list ([(nutrient-id name formula value_ppm) diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt index 1cabf63..dbcb53c 100644 --- a/models/nutrient-measurement.rkt +++ b/models/nutrient-measurement.rkt @@ -66,7 +66,6 @@ ;; READ -(struct acc (measured-on pairs) #:transparent) (define joined (table-expr-qq (inner-join (inner-join (inner-join (as nutrient_measurements nm) (as nutrient_value_sets nvs) @@ -76,66 +75,51 @@ (as nutrients n) #:on (= n.id nv.nutrient_id)))) +(define (grouped-row->nutrient-measurement row) + (match-define (vector nm-id measured-on residuals) row) + (define nutrient-value-pairs (residuals->nutrient-value-pairs residuals)) + (nutrient-measurement nm-id measured-on nutrient-value-pairs)) (define (get-nutrient-measurements) - (define query (select nm.id nm.measured_on - n.id n.canonical_name n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by nm.measured_on #:desc)) - (define rows (query-rows (current-conn) query)) - (define by-id - (for/fold ([h (hash)]) ([row (in-list rows)]) - (match-define (vector nm-id measured-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 nm-id - (λ (old-acc) - (acc (acc-measured-on old-acc) - (cons nv-pair (acc-pairs old-acc)))) - (λ () - (acc measured-on - (list nv-pair)))))) - (for/list ([(id a) (in-hash by-id)]) - (nutrient-measurement id - (acc-measured-on a) - (reverse (acc-pairs a))))) - -(define (get-nutrient-measurement #:id [nm-id #f] - #:measured-on [measured-on #f]) + (define grouped-rows (query-rows (current-conn) + (select nm.id + nm.measured_on + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:order-by nm.measured_on + #:desc) + #:group '#(0 1))) + (for/list ([row grouped-rows]) + (grouped-row->nutrient-measurement row))) + +(define (get-nutrient-measurement #:id [nm-id #f] #:measured-on [measured-on #f]) (define where (cond [(and nm-id measured-on) - (scalar-expr-qq (and (= nm.id ,nm-id) - (= nm.measured_on ,measured-on)))] - [nm-id - (scalar-expr-qq (= nm.id ,nm-id))] - [measured-on - (scalar-expr-qq (= nm.measured_on ,measured-on))])) - (define query (select nm.id nm.measured_on - n.id n.canonical_name n.formula + (scalar-expr-qq (and (= nm.id ,nm-id) (= nm.measured_on ,measured-on)))] + [nm-id (scalar-expr-qq (= nm.id ,nm-id))] + [measured-on (scalar-expr-qq (= nm.measured_on ,measured-on))] + [else (error 'get-nutrient-measurement "either #:id or #:measured-on must be provided")])) + (define grouped-rows + (query-rows (current-conn) + (select nm.id + nm.measured_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] - [else - ;; Fold all nutrient value rows belonging to the single nutrient measurement into one struct - (define the-id #f) - (define A #f) - (for ([row (in-list rows)]) - (match-define (vector nm-id measured-on n-id n-name n-formula value-ppm) row) - (unless the-id (set! the-id nm-id)) - (define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm)) - (set! A (if A - (acc (acc-measured-on A) - (cons nv-pair (acc-pairs A))) - (acc measured-on - (list nv-pair))))) - (and A - (nutrient-measurement the-id - (acc-measured-on A) - (reverse (acc-pairs A))))])) + #:where (ScalarExpr:AST ,where) + #:order-by nm.measured_on + #:desc) + #:group '#(0 1))) + (match grouped-rows + ['() #f] + [(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) (for/list ([(nutrient-id name formula value_ppm) diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt index 77d0b4c..b9ca2d1 100644 --- a/models/nutrient-target.rkt +++ b/models/nutrient-target.rkt @@ -61,8 +61,6 @@ ;; 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) @@ -72,28 +70,24 @@ (as nutrients n) #:on (= n.id nv.nutrient_id)))) +(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)) + (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 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)))))) - (for/list ([(id a) (in-hash by-id)]) - (nutrient-target id (acc-effective-on a) (reverse (acc-pairs a))))) + (for/list ([grouped-row (in-query (current-conn) + (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) + #:group '#(0 1))]) + (grouped-row->nutrient-target grouped-row))) (define (get-nutrient-target #:id [nt-id #f] #:effective-on [effective-on #f]) (define where @@ -101,33 +95,25 @@ [(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))) - (define rows (query-rows (current-conn) query)) - (cond - [(null? rows) #f] - [else - ;; Fold all nutrient rows belonging to the single target into one struct - (define the-id #f) - (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)) - (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))))])) + [effective-on (scalar-expr-qq (= nt.effective_on ,effective-on))] + [else (error 'get-nutrient-target "either #:id or #:effective-on must be provided")])) + (define grouped-rows + (query-rows (current-conn) + (select nt.id + nt.effective_on + n.id + n.canonical_name + n.formula + nv.value_ppm + #:from (TableExpr:AST ,joined) + #:where (ScalarExpr:AST ,where) + #:order-by nt.effective_on + #:desc) + #:group '#(0 1))) + (match grouped-rows + ['() #f] + [(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) (for/list ([(nutrient-id name formula value_ppm) |