diff options
Diffstat (limited to 'models/nutrient.rkt')
| -rw-r--r-- | models/nutrient.rkt | 75 |
1 files changed, 44 insertions, 31 deletions
diff --git a/models/nutrient.rkt b/models/nutrient.rkt index 3e2767b..fd78cc8 100644 --- a/models/nutrient.rkt +++ b/models/nutrient.rkt @@ -3,10 +3,11 @@ (provide nutrient nutrient? nutrient-id - nutrient-name + nutrient-canonical-name + nutrient-french-name nutrient-formula nutrient-value-hash/c - (contract-out [create-nutrient! (-> string? string? nutrient?)] + (contract-out [create-nutrient! (-> string? string? string? nutrient?)] [get-nutrients (-> (listof nutrient?))] [get-nutrient (->* () @@ -27,54 +28,66 @@ sql "../db/conn.rkt") -(struct nutrient (id name formula) +(struct nutrient (id canonical-name french-name formula) #:transparent #:property prop:custom-write - (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-name v)))) + (λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-canonical-name v)))) (define nutrient-value-hash/c (hash/c nutrient? (and/c real? (>=/c 0)) #:immutable #t)) -;; vector/c id, nutrient name, nutrient formula, value (ppm) -(define residual-vector/c (vector/c exact-nonnegative-integer? string? string? real?)) +;; vector/c id, canonical name, french name, nutrient formula, value (ppm) +(define residual-vector/c (vector/c exact-nonnegative-integer? string? string? string? real?)) (define (residuals->nutrient-value-hash residuals) (for/hash ([r (in-list residuals)]) - (match-define (vector n-id n-name n-formula value-ppm) r) - (values (nutrient n-id n-name n-formula) value-ppm))) + (match-define (vector n-id n-canonical-name n-french-name n-formula value-ppm) r) + (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm))) ;; CREATE -(define (create-nutrient! name formula) - (or (get-nutrient #:name name #:formula formula) +(define (create-nutrient! canonical-name french-name formula) + (or (get-nutrient #:name canonical-name #:formula formula) (begin (query-exec (current-conn) - (insert #:into nutrients #:set [canonical_name ,name] [formula ,formula])) - (get-nutrient #:name name)))) + (insert #:into nutrients + #:set [canonical_name ,canonical-name] + [french_name ,french-name] + [formula ,formula])) + (get-nutrient #:name canonical-name)))) ;; READ +(define (row->nutrient row) + (match-define (vector id canonical-name french-name formula) row) + (nutrient id canonical-name french-name formula)) + (define (get-nutrients) - (for/list ([(id name formula) - (in-query (current-conn) - (select id canonical_name formula #:from nutrients #:order-by id #:asc))]) - (nutrient id name formula))) - -(define (get-nutrient #:id [id #f] #:name [name #f] #:formula [formula #f]) - (define (where-expr) - (define clauses - (filter values - (list (and id (format "id = ~e" id)) - (and name (format "canonical_name = ~e" name)) - (and formula (format "formula = ~e" formula))))) + (define rows + (query-rows (current-conn) + (select id canonical_name french_name formula #:from nutrients #:order-by id #:asc))) + (map row->nutrient rows)) + +(define (get-nutrient #:id [id #f] #:name [canonical-name #f] #:formula [formula #f]) + (define where (cond - [(null? clauses) ""] - [else (format "WHERE ~a" (string-join clauses " AND "))])) + [(and id canonical-name formula) + (scalar-expr-qq (and (= id ,id) (= canonical_name ,canonical-name)))] + [id (scalar-expr-qq (= id ,id))] + [(and canonical-name formula) + (scalar-expr-qq (and (= canonical_name ,canonical-name) (= formula ,formula)))] + [canonical-name (scalar-expr-qq (= canonical_name ,canonical-name))] + [formula (scalar-expr-qq (= formula ,formula))])) (match (query-maybe-row (current-conn) - (string-join `("SELECT id, canonical_name, formula" "FROM nutrients" - ,(where-expr) - "ORDER BY id ASC" - "LIMIT 1"))) - [(vector id* name* formula*) (nutrient id* name* formula*)] + (select id + canonical_name + french_name + formula + #:from nutrients + #:where (ScalarExpr:AST ,where) + #:order-by id + #:asc + #:limit 1)) + [(vector id canonical-name french-name formula) (nutrient id canonical-name french-name formula)] [#f #f])) ;; UPDATE |