1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
|
#lang racket
(provide nutrient
nutrient?
nutrient-id
nutrient-name
nutrient-formula
nutrient-value-pair/c
(contract-out [create-nutrient! (-> string? string? nutrient?)]
[get-nutrients (-> (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
#:property prop:custom-write
(λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-name v))))
(define nutrient-value-pair/c (cons/c nutrient? (and/c real? (>=/c 0))))
;; CREATE
(define (create-nutrient! name formula)
(or (get-nutrient #:name name #:formula formula)
(begin
(query-exec (current-conn)
(insert #:into nutrients #:set [canonical_name ,name] [formula ,formula]))
(get-nutrient #:name name))))
;; READ
(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)))))
(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)))))
|
