From 3008eb25f79ef1ed54fcc2b3f5b6635b34394680 Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sun, 19 Oct 2025 21:15:18 +0200 Subject: Absorb existing domain data. --- models/nutrient.rkt | 123 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 123 insertions(+) create mode 100644 models/nutrient.rkt (limited to 'models/nutrient.rkt') diff --git a/models/nutrient.rkt b/models/nutrient.rkt new file mode 100644 index 0000000..5a32e70 --- /dev/null +++ b/models/nutrient.rkt @@ -0,0 +1,123 @@ +#lang racket + +(provide + ;; Struct definitions + nutrient + nutrient? + nutrient-id nutrient-name nutrient-formula + ;; SQL CRUD + (contract-out + [create-nutrient! (-> string? string? void?)] + [get-nutrients (->* () + (#:id (or/c #f exact-nonnegative-integer?) + #:name (or/c #f string?) + #:formula (or/c #f string?)) + (listof nutrient?))] + [get-nutrient (->* () + (#:id (or/c #f exact-nonnegative-integer?) + #:name (or/c #f string?) + #:formula (or/c #f string?)) + (or/c nutrient? #f))] + [update-nutrient! (->* (nutrient?) + (#:name (or/c #f string?) + #:formula (or/c #f string?)) + (or/c nutrient? #f))] + [delete-nutrient! (-> nutrient? void?)])) + +(require racket/contract + db + sql + "../db/conn.rkt") + +(struct nutrient (id name formula) #:transparent) + + +;; CREATE + +(define (create-nutrient! name formula) + (query-exec (current-conn) + (insert #:into nutrients + #:set [canonical_name ,name] [formula ,formula]))) + + +;; READ + +(define (get-nutrients #: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))))) + (cond + [(null? clauses) ""] + [else (format "WHERE ~a" (string-join clauses " AND "))])) + (for/list ([(id* name* formula*) + (in-query (current-conn) + (string-join + `("SELECT id, canonical_name, formula" + "FROM nutrients" + ,(where-expr) + "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))))) + (cond + [(null? clauses) ""] + [else (format "WHERE ~a" (string-join clauses " AND "))])) + (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*)] + [#f #f])) + + +;; UPDATE + +(define (update-nutrient! nutrient + #:name [name #f] + #:formula [formula #f]) + (define id(nutrient-id nutrient)) + (cond + [(and name formula) + (query-exec (current-conn) + (update nutrients + #:set [canonical_name ,name] [formula ,formula] + #:where (= id ,id)))] + [name + (query-exec (current-conn) + (update nutrients + #:set [canonical_name ,name] + #:where (= id ,id)))] + [formula + (query-exec (current-conn) + (update nutrients + #:set [formula ,formula] + #:where (= id ,id)))] + [else (void)]) + (or (get-nutrient #:id id) + (error 'update-nutrient! "No nutrient with id ~a" id))) + + +;; DELETE + +(define (delete-nutrient! nutrient) + (query-exec (current-conn) + (delete #:from nutrients + #:where (= id ,(nutrient-id nutrient))))) -- cgit v1.2.3