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
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
|
#lang racket
(provide
;; Struct definitions
fertilizer-product
fertilizer-product?
fertilizer-product-id fertilizer-product-brand-name
;; SQL CRUD
(contract-out
[create-fertilizer-product! (->* (string?
(listof (cons/c nutrient? number?)))
(string?)
fertilizer-product?)]
[get-fertilizer-products (-> (listof fertilizer-product?))]
[get-fertilizer-product (->* ()
(#:id (or/c #f exact-nonnegative-integer?)
#:canonical-name (or/c #f string?))
(or/c fertilizer-product? #f))]
[get-fertilizer-product-values (-> fertilizer-product?
(listof (cons/c nutrient? number?)))]
[get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
[delete-fertilizer-product! (-> fertilizer-product? void?)]))
(require racket/contract
db
sql
"../db/conn.rkt"
"nutrient.rkt")
;; Instances of this struct are persisted in the fertilizer_products table.
(struct fertilizer-product (id canonical-name brand-name) #:transparent)
;; CREATE
(define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f])
(or (get-fertilizer-product #:canonical-name canonical-name)
(with-tx
(query-exec (current-conn)
(cond
[brand-name
(insert #:into fertilizer_products
#:set [canonical_name ,canonical-name] [brand_name ,brand-name])]
[else
(insert #:into fertilizer_products
#:set [canonical_name ,canonical-name])]))
(define fp-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name)))
(query-exec (current-conn)
(insert #:into nutrient_value_sets
#:set [fertilizer_product_id ,fp-id]))
(define nvs-id (query-value (current-conn)
(select id
#:from nutrient_value_sets
#:where (= fertilizer_product_id ,fp-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-fertilizer-product #:canonical-name canonical-name)))
;; READ
(struct acc (canonical-name brand-name pairs) #:transparent)
(define joined
(table-expr-qq
(inner-join
(inner-join
(inner-join
(as fertilizer_products fp)
(as nutrient_value_sets nvs)
#:on (= nvs.fertilizer_product_id fp.id))
(as nutrient_values nv)
#:on (= nv.value_set_id nvs.id))
(as nutrients n)
#:on (= n.id nv.nutrient_id))))
(define (get-fertilizer-products)
(define query (select fp.id fp.canonical_name fp.brand_name
n.id n.canonical_name n.formula
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:order-by canonical_name #:asc))
(define rows (query-rows (current-conn) query))
(define by-id
(for/fold ([h (hash)]) ([row (in-list rows)])
(match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
(hash-update h fp-id
(λ (old-acc)
(acc (acc-canonical-name old-acc)
(acc-brand-name old-acc)
(cons nv-pair (acc-pairs old-acc))))
(λ ()
(acc canonical-name
brand-name
(list nv-pair))))))
(for/list ([(id a) (in-hash by-id)])
(fertilizer-product id
(acc-canonical-name a)
(reverse (acc-pairs a))
(acc-brand-name a))))
(define (get-fertilizer-product #:id [fp-id #f]
#:canonical-name [canonical-name #f])
(define where
(cond
[(and fp-id canonical-name)
(scalar-expr-qq (and (= fp.id ,fp-id)
(= fp.canonical_name ,canonical-name)))]
[fp-id
(scalar-expr-qq (= fp.id ,fp-id))]
[canonical-name
(scalar-expr-qq (= fp.canonical_name ,canonical-name))]))
(define query (select fp.id fp.canonical_name fp.brand_name
n.id n.canonical_name n.formula
nv.value_ppm
#:from (TableExpr:AST ,joined)
#:where (ScalarExpr:AST ,where)
#:limit 1))
(define rows (query-rows (current-conn) query))
(cond
[(null? rows) #f]
[else
;; Fold all nutrient value rows belonging to the single fertilizer product into one struct
(define the-id #f)
(define A #f)
(for ([row (in-list rows)])
(match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
(unless the-id (set! the-id fp-id))
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
(set! A (if A
(acc (acc-canonical-name A)
(acc-brand-name A)
(cons nv-pair (acc-pairs A)))
(acc canonical-name
brand-name
(list nv-pair)))))
(and A
(fertilizer-product the-id
(acc-canonical-name A)
(reverse (acc-pairs A))
(acc-brand-name A)))]))
(define (get-fertilizer-product-values fertilizer-product)
(for/list ([(nutrient-id name formula value_ppm)
(in-query (current-conn)
(select n.id n.canonical_name n.formula nv.value_ppm
#:from (TableExpr:AST ,joined)
#:where (= nm.id ,(fertilizer-product-id fertilizer-product))))])
(cons (nutrient nutrient-id name formula) value_ppm)))
(define (get-fertilizer-product-value fertilizer-product nutrient)
(query-maybe-value (current-conn)
(select value_ppm
#:from (TableExpr:AST ,joined)
#:where (and (= nm.id ,(fertilizer-product-id fertilizer-product))
(= nv.nutrient_id ,(nutrient-id nutrient))))))
;; UPDATE
;; DELETE
(define (delete-fertilizer-product! fertilizer-product)
(define id (fertilizer-product-id fertilizer-product))
(query-exec (current-conn)
(delete #:from fertilizer_products
#:where (= id ,id))))
|
