Absorb existing domain data.

1 files changed, 123 insertions, 0 deletions

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)))))