diff options
Diffstat (limited to 'models/nutrient-measurement.rkt')
| -rw-r--r-- | models/nutrient-measurement.rkt | 212 |
1 files changed, 212 insertions, 0 deletions
diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt new file mode 100644 index 0000000..8364aa7 --- /dev/null +++ b/models/nutrient-measurement.rkt @@ -0,0 +1,212 @@ +#lang racket + +(provide + ;; Struct definitions + nutrient-measurement + nutrient-measurement? + nutrient-measurement-id nutrient-measurement-measured-on + ;; SQL CRUD + (contract-out + [create-nutrient-measurement! (-> string? + (listof (cons/c + nutrient? + number?)) + nutrient-measurement?)] + [get-nutrient-measurements (->* () + (#:id (or/c #f exact-nonnegative-integer?) + #:measured-on (or/c #f string?)) + (listof nutrient-measurement?))] + [get-nutrient-measurement (->* () + (#:id (or/c #f exact-nonnegative-integer?) + #:measured-on (or/c #f string?)) + (or/c nutrient-measurement? #f))] + [get-nutrient-measurement-values (-> nutrient-measurement? + (listof (cons/c + nutrient? + number?)))] + [get-nutrient-measurement-value (-> nutrient-measurement? + nutrient? + number?)] + [get-latest-nutrient-measurement-value (-> nutrient? number?)] + #; [update-nutrient-measurement! (->* (nutrient-measurement?) + (#:measured-on (or/c #f string?) + #:nutrient-values (or/c #f (listof (cons/c + nutrient? + number?)))) + (or/c nutrient-measurement? #f))] + [delete-nutrient-measurement! (-> nutrient-measurement? + void?)])) + +(require racket/contract + db + sql + "../db/conn.rkt" + "nutrient.rkt") + +;; Instances of this struct are persisted in the nutrient_measurements table. +(struct nutrient-measurement (id measured-on) #:transparent) + + +;; CREATE + +(define (create-nutrient-measurement! measured-on nutrient-values) + (define existing-nutrient-measurement (get-nutrient-measurement #:measured-on measured-on)) + (define (new-nutrient-measurement) + (with-tx + (query-exec (current-conn) + (insert #:into nutrient_measurements + #:set [measured_on ,measured-on])) + (define nm-id (nutrient-measurement-id (get-nutrient-measurement #:measured-on measured-on))) + (query-exec (current-conn) + (insert #:into nutrient_value_sets + #:set [nutrient_measurement_id ,nm-id])) + (define nvs-id (query-value (current-conn) + (select id + #:from nutrient_value_sets + #:where (= nutrient_measurement_id ,nm-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-nutrient-measurement #:measured-on measured-on)) + (or existing-nutrient-measurement + (new-nutrient-measurement))) + + +;; READ + +(define (get-nutrient-measurements #:id [id #f] + #:measured-on [measured-on #f]) + (define (where-expr) + (define clauses + (filter values + (list (and id (format "id = ~e" id)) + (and measured-on (format "measured_on = ~e" measured-on))))) + (cond + [(null? clauses) ""] + [else (format "WHERE ~a" (string-join clauses " AND "))])) + (define query (string-join + `("SELECT id, measured_on" + "FROM nutrient_measurements" + ,(where-expr) + "ORDER BY id ASC"))) + (for/list ([(id* measured-on*) + (in-query (current-conn) query)]) + (nutrient-measurement id* measured-on*))) + +(define (get-nutrient-measurement #:id [id #f] + #:measured-on [measured-on #f]) + (define (where-expr) + (define clauses + (filter values + (list + (and id (format "id = ~e" id)) + (and measured-on (format "measured_on = ~e" measured-on))))) + (cond + [(null? clauses) ""] + [else (format "WHERE ~a" (string-join clauses " AND "))])) + (define query (string-join + `("SELECT id, measured_on" + "FROM nutrient_measurements" + ,(where-expr) + "ORDER BY id ASC" + "LIMIT 1"))) + (match (query-maybe-row (current-conn) query) + [(vector id* measured-on*) + (nutrient-measurement id* measured-on*)] + [#f #f])) + +(define (get-nutrient-measurement-values nutrient-measurement) + (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 nutrient_measurements nm ON nm.id = nvs.nutrient_measurement_id" + "JOIN nutrients n ON n.id = nv.nutrient_id" + "WHERE nm.id = $1")) + (nutrient-measurement-id nutrient-measurement))]) + (cons (nutrient nutrient-id name formula) value_ppm))) + +(define (get-nutrient-measurement-value nutrient-measurement 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 nutrient_measurements nm ON nm.id = nvs.nutrient_measurement_id" + "WHERE nm.id = $1 AND nv.nutrient_id = $2")) + (nutrient-measurement-id nutrient-measurement) + (nutrient-id nutrient))) + +(define (get-latest-nutrient-measurement-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 nutrient_measurements nm ON nm.id = nvs.nutrient_measurement_id" + "WHERE nv.nutrient_id = $1" + "ORDER BY nm.measured_on DESC" + "LIMIT 1")) + (nutrient-id nutrient))) + + +;; UPDATE + +#; (define (update-nutrient-measurement! nutrient-measurement + #:measured-on [measured-on #f] + #:nutrient-values [nutrient-values '()]) + (define nm-id (nutrient-measurement-id nutrient-measurement)) + (define (nvs-id nm-id) + (query-maybe-row (current-conn) + (select id + #:from nutrient_value_sets + #:where (= nutrient_measurement_id ,nm-id)))) + (with-tx + (when measured-on + (query-exec (current-conn) + (update nutrient_measurements + #:set [measured_on ,measured-on] + #:where (= id ,id)))) + (unless (null? nutrient-values) + (upsert-nutrient-values nm-id)) + (get-nutrient-measurement #:id id))) + +#; (define (upsert-nutrient-values nutrient-measurement-id) + (define maybe-nvs-id (nvs-id nm-id)) + (case maybe-nvs-id + [(#f) + (query-exec (current-conn) + (insert #:into nutrient_values_sets + #:set + [nutrient_measurement_id ,id])) + (define new-nvs-id (nvs-id nm-id)) + (query-exec (current-conn) + (string-join + '("INSERT INTO nutrient_values" + "VALUES $1 $2 $3" + "")) + new-nvs-id + )] + [else + (query-exec (current-conn) + (update nutrient_measurement_values + #:set [value ,value] + #:where (and (= measurement_id ,measurement-id) + (= nutrient_id ,nutrient-id))))])) + + +;; DELETE + +(define (delete-nutrient-measurement! nutrient-measurement) + (define id (nutrient-measurement-id nutrient-measurement)) + (query-exec (current-conn) + (delete #:from nutrient_measurements + #:where (= id ,id)))) |