diff options
Diffstat (limited to 'models/crop-requirement.rkt')
| -rw-r--r-- | models/crop-requirement.rkt | 180 |
1 files changed, 180 insertions, 0 deletions
diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt new file mode 100644 index 0000000..f213441 --- /dev/null +++ b/models/crop-requirement.rkt @@ -0,0 +1,180 @@ +#lang racket + +(provide + ;; Struct definitions + crop-requirement + crop-requirement? + crop-requirement-id crop-requirement-profile + ;; SQL CRUD + (contract-out + [create-crop-requirement! (->* (string? + (listof (cons/c + nutrient? + number?))) + ((or/c #f crop?)) + crop-requirement?)] + [get-crop-requirements (->* () + (#:id + (or/c #f exact-nonnegative-integer?) + #:profile + (or/c #f string?)) + (listof crop-requirement?))] + [get-crop-requirement (->* () + (#:id + (or/c #f exact-nonnegative-integer?) + #:profile + (or/c #f string?)) + (or/c crop-requirement? #f))] + [get-crop-requirement-values (-> crop-requirement? + (listof (cons/c + nutrient? + number?)))] + [get-crop-requirement-value (-> crop-requirement? + nutrient? + number?)] + [get-latest-crop-requirement-value (-> nutrient? number?)] + #; [update-crop-requirement! (->* (crop-requirement?) + (#:profile (or/c #f string?) + #:nutrient-values (or/c #f (listof (cons/c + nutrient? + number?)))) + (or/c crop-requirement? #f))] + [delete-crop-requirement! (-> crop-requirement? + void?)])) + +(require racket/contract + db + sql + "../db/conn.rkt" + "nutrient.rkt" + "crop.rkt") + +;; Instances of this struct are persisted in the crop_requirements table. +(struct crop-requirement (id profile) #:transparent) + + +;; CREATE + + +(define (create-crop-requirement! profile nutrient-values [crop #f]) + (define existing-crop-requirement (get-crop-requirement #:profile profile)) + (define (new-crop-requirement) + (with-tx + (query-exec (current-conn) + (if crop + (insert #:into crop_requirements + #:set [crop_id ,(crop-id crop)] [profile ,profile]) + (insert #:into crop_requirements + #:set [profile ,profile]))) + (define cr-id (crop-requirement-id (get-crop-requirement #:profile profile))) + (query-exec (current-conn) + (insert #:into nutrient_value_sets + #:set [crop_requirement_id ,cr-id])) + (define nvs-id (query-value (current-conn) + (select id + #:from nutrient_value_sets + #:where (= crop_requirement_id ,cr-id)))) + (for ([nv nutrient-values]) + (match nv + [(cons n v) + (query-exec (current-conn) + (insert #:into nutrient_values + #:set + [value_set_id ,nvs-id] + [nutrient_id ,(nutrient-id n)] + [value_ppm ,v]))]))) + (get-crop-requirement #:profile profile)) + (or existing-crop-requirement + (new-crop-requirement))) + + +;; READ + +(define (get-crop-requirements #:id [id #f] + #:profile [profile #f]) + (define (where-expr) + (define clauses + (filter values + (list (and id (format "id = ~e" id)) + (and profile (format "profile = ~e" profile))))) + (cond + [(null? clauses) ""] + [else (format "WHERE ~a" (string-join clauses " AND "))])) + (define query (string-join + `("SELECT id, profile" + "FROM crop_requirements" + ,(where-expr) + "ORDER BY id ASC"))) + (for/list ([(id* profile*) + (in-query (current-conn) query)]) + (crop-requirement id* profile*))) + +(define (get-crop-requirement #:id [id #f] + #:profile [profile #f]) + (define (where-expr) + (define clauses + (filter values + (list + (and id (format "id = ~e" id)) + (and profile (format "profile = ~e" profile))))) + (cond + [(null? clauses) ""] + [else (format "WHERE ~a" (string-join clauses " AND "))])) + (define query (string-join + `("SELECT id, profile" + "FROM crop_requirements" + ,(where-expr) + "ORDER BY id ASC" + "LIMIT 1"))) + (match (query-maybe-row (current-conn) query) + [(vector id* profile*) + (crop-requirement id* profile*)] + [#f #f])) + +(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))]) + (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))) + + +;; UPDATE + + +;; DELETE + +(define (delete-crop-requirement! crop-requirement) + (define id (crop-requirement-id crop-requirement)) + (query-exec (current-conn) + (delete #:from crop_requirements + #:where (= id ,id)))) |