From 09ba1e517c12561e25c9c36796029004eaa3f578 Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Thu, 20 Nov 2025 11:31:50 +0100 Subject: Use db library grouping mechanism rather than ad-hoc accumulator. --- models/crop-requirement.rkt | 123 ++++++++++++++++++++++++-------------------- 1 file changed, 66 insertions(+), 57 deletions(-) (limited to 'models/crop-requirement.rkt') 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 -- cgit v1.2.3