summaryrefslogtreecommitdiff
path: root/models/crop-requirement.rkt
diff options
context:
space:
mode:
Diffstat (limited to 'models/crop-requirement.rkt')
-rw-r--r--models/crop-requirement.rkt123
1 files changed, 66 insertions, 57 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
Copyright 2019--2026 Marius PETER