[Racket] Ferti hydroponic nutrient solver, redux.
Realign fertilizer-product model with nutrient-measurement.
models/fertilizer-product.rkt
@@ -14,11 +14,11 @@
14
14
[get-fertilizer-products (-> (listof fertilizer-product?))]
15
15
[get-fertilizer-product (->* ()
16
16
(#:id (or/c #f exact-nonnegative-integer?)
17
Removed:
#:brand-name (or/c #f string?))
17
Added:
#:canonical-name (or/c #f string?))
18
18
(or/c fertilizer-product? #f))]
19
Removed:
[get-fertilizer-product-values (-> fertilizer-product? (listof (cons/c nutrient? number?)))]
19
Added:
[get-fertilizer-product-values (-> fertilizer-product?
20
Added:
(listof (cons/c nutrient? number?)))]
20
21
[get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
21
Removed:
[get-latest-fertilizer-product-value (-> nutrient? number?)]
22
22
[delete-fertilizer-product! (-> fertilizer-product? void?)]))
23
23
24
24
(require racket/contract
@@ -34,108 +34,134 @@
34
34
;; CREATE
35
35
36
36
(define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f])
37
Removed:
(define existing-fertilizer-product (get-fertilizer-product #:canonical-name canonical-name))
38
Removed:
(define (new-fertilizer-product)
39
Removed:
(with-tx
40
Removed:
(query-exec (current-conn)
41
Removed:
(cond
42
Removed:
[brand-name
43
Removed:
(insert #:into fertilizer_products
44
Removed:
#:set [canonical_name ,canonical-name] [brand_name ,brand-name])]
45
Removed:
[else
46
Removed:
(insert #:into fertilizer_products
47
Removed:
#:set [canonical_name ,canonical-name])]))
48
Removed:
(define nm-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name)))
49
Removed:
(query-exec (current-conn)
50
Removed:
(insert #:into nutrient_value_sets
51
Removed:
#:set [fertilizer_product_id ,nm-id]))
52
Removed:
(define nvs-id (query-value (current-conn)
53
Removed:
(select id
54
Removed:
#:from nutrient_value_sets
55
Removed:
#:where (= fertilizer_product_id ,nm-id))))
56
Removed:
(for ([nv nutrient-values])
57
Removed:
(match nv
58
Removed:
[(cons n v)
59
Removed:
(query-exec (current-conn)
60
Removed:
(insert #:into nutrient_values
61
Removed:
#:set
62
Removed:
[value_set_id ,nvs-id]
63
Removed:
[nutrient_id ,(nutrient-id n)]
64
Removed:
[value_ppm ,v]))])))
65
Removed:
(get-fertilizer-product #:canonical-name canonical-name))
66
Removed:
(or existing-fertilizer-product
67
Removed:
(new-fertilizer-product)))
37
Added:
(or (get-fertilizer-product #:canonical-name canonical-name)
38
Added:
(with-tx
39
Added:
(query-exec (current-conn)
40
Added:
(cond
41
Added:
[brand-name
42
Added:
(insert #:into fertilizer_products
43
Added:
#:set [canonical_name ,canonical-name] [brand_name ,brand-name])]
44
Added:
[else
45
Added:
(insert #:into fertilizer_products
46
Added:
#:set [canonical_name ,canonical-name])]))
47
Added:
(define fp-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name)))
48
Added:
(query-exec (current-conn)
49
Added:
(insert #:into nutrient_value_sets
50
Added:
#:set [fertilizer_product_id ,fp-id]))
51
Added:
(define nvs-id (query-value (current-conn)
52
Added:
(select id
53
Added:
#:from nutrient_value_sets
54
Added:
#:where (= fertilizer_product_id ,fp-id))))
55
Added:
(for ([nv nutrient-values])
56
Added:
(match nv
57
Added:
[(cons n v)
58
Added:
(query-exec (current-conn)
59
Added:
(insert #:into nutrient_values
60
Added:
#:set
61
Added:
[value_set_id ,nvs-id]
62
Added:
[nutrient_id ,(nutrient-id n)]
63
Added:
[value_ppm ,v]))])))
64
Added:
(get-fertilizer-product #:canonical-name canonical-name)))
68
65
69
66
70
67
;; READ
71
68
69
Added:
(struct acc (canonical-name brand-name pairs) #:transparent)
70
Added:
71
Added:
(define joined
72
Added:
(table-expr-qq
73
Added:
(inner-join
74
Added:
(inner-join
75
Added:
(inner-join
76
Added:
(as fertilizer_products fp)
77
Added:
(as nutrient_value_sets nvs)
78
Added:
#:on (= nvs.fertilizer_product_id fp.id))
79
Added:
(as nutrient_values nv)
80
Added:
#:on (= nv.value_set_id nvs.id))
81
Added:
(as nutrients n)
82
Added:
#:on (= n.id nv.nutrient_id))))
83
Added:
72
84
(define (get-fertilizer-products)
73
Removed:
(for/list ([(id* brand-name*)
74
Removed:
(in-query (current-conn)
75
Removed:
(select id brand_name
76
Removed:
#:from fertilizer_products
77
Removed:
#:order-by canonical_name #:asc))])
78
Removed:
(fertilizer-product id* brand-name*)))
85
Added:
(define query (select fp.id fp.canonical_name fp.brand_name
86
Added:
n.id n.canonical_name n.formula
87
Added:
nv.value_ppm
88
Added:
#:from (TableExpr:AST ,joined)
89
Added:
#:order-by canonical_name #:asc))
90
Added:
(define rows (query-rows (current-conn) query))
91
Added:
(define by-id
92
Added:
(for/fold ([h (hash)]) ([row (in-list rows)])
93
Added:
(match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
94
Added:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
95
Added:
(hash-update h fp-id
96
Added:
(λ (old-acc)
97
Added:
(acc (acc-canonical-name old-acc)
98
Added:
(acc-brand-name old-acc)
99
Added:
(cons nv-pair (acc-pairs old-acc))))
100
Added:
(λ ()
101
Added:
(acc canonical-name
102
Added:
brand-name
103
Added:
(list nv-pair))))))
104
Added:
(for/list ([(id a) (in-hash by-id)])
105
Added:
(fertilizer-product id
106
Added:
(acc-canonical-name a)
107
Added:
(reverse (acc-pairs a))
108
Added:
(acc-brand-name a))))
79
109
80
Removed:
(define (get-fertilizer-product #:id [id #f]
81
Removed:
#:canonical-name [canonical-name #f]
82
Removed:
#:brand-name [brand-name #f])
83
Removed:
(define (where-expr)
84
Removed:
(define clauses
85
Removed:
(filter values
86
Removed:
(list
87
Removed:
(and id (format "id = ~e" id))
88
Removed:
(and canonical-name (format "canonical_name = ~e" canonical-name))
89
Removed:
(and brand-name (format "brand_name = ~e" brand-name)))))
110
Added:
(define (get-fertilizer-product #:id [fp-id #f]
111
Added:
#:canonical-name [canonical-name #f])
112
Added:
(define where
90
113
(cond
91
Removed:
[(null? clauses) ""]
92
Removed:
[else (format "WHERE ~a" (string-join clauses " AND "))]))
93
Removed:
(match (query-maybe-row (current-conn)
94
Removed:
(string-join
95
Removed:
`("SELECT id, canonical_name, brand_name"
96
Removed:
"FROM fertilizer_products"
97
Removed:
,(where-expr)
98
Removed:
"ORDER BY id ASC"
99
Removed:
"LIMIT 1")))
100
Removed:
[(vector id* canonical-name* brand-name*)
101
Removed:
(fertilizer-product id* canonical-name* brand-name*)]
102
Removed:
[#f #f]))
114
Added:
[(and fp-id canonical-name)
115
Added:
(scalar-expr-qq (and (= fp.id ,fp-id)
116
Added:
(= fp.canonical_name ,canonical-name)))]
117
Added:
[fp-id
118
Added:
(scalar-expr-qq (= fp.id ,fp-id))]
119
Added:
[canonical-name
120
Added:
(scalar-expr-qq (= fp.canonical_name ,canonical-name))]))
121
Added:
(define query (select fp.id fp.canonical_name fp.brand_name
122
Added:
n.id n.canonical_name n.formula
123
Added:
nv.value_ppm
124
Added:
#:from (TableExpr:AST ,joined)
125
Added:
#:where (ScalarExpr:AST ,where)
126
Added:
#:limit 1))
127
Added:
(define rows (query-rows (current-conn) query))
128
Added:
(cond
129
Added:
[(null? rows) #f]
130
Added:
[else
131
Added:
;; Fold all nutrient value rows belonging to the single fertilizer product into one struct
132
Added:
(define the-id #f)
133
Added:
(define A #f)
134
Added:
(for ([row (in-list rows)])
135
Added:
(match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
136
Added:
(unless the-id (set! the-id fp-id))
137
Added:
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
138
Added:
(set! A (if A
139
Added:
(acc (acc-canonical-name A)
140
Added:
(acc-brand-name A)
141
Added:
(cons nv-pair (acc-pairs A)))
142
Added:
(acc canonical-name
143
Added:
brand-name
144
Added:
(list nv-pair)))))
145
Added:
(and A
146
Added:
(fertilizer-product the-id
147
Added:
(acc-canonical-name A)
148
Added:
(reverse (acc-pairs A))
149
Added:
(acc-brand-name A)))]))
103
150
104
151
(define (get-fertilizer-product-values fertilizer-product)
105
152
(for/list ([(nutrient-id name formula value_ppm)
106
153
(in-query (current-conn)
107
Removed:
(string-join
108
Removed:
'("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
109
Removed:
"FROM nutrient_values nv"
110
Removed:
"JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
111
Removed:
"JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
112
Removed:
"JOIN nutrients n ON n.id = nv.nutrient_id"
113
Removed:
"WHERE nm.id = $1"))
114
Removed:
(fertilizer-product-id fertilizer-product))])
154
Added:
(select n.id n.canonical_name n.formula nv.value_ppm
155
Added:
#:from (TableExpr:AST ,joined)
156
Added:
#:where (= nm.id ,(fertilizer-product-id fertilizer-product))))])
115
157
(cons (nutrient nutrient-id name formula) value_ppm)))
116
158
117
159
(define (get-fertilizer-product-value fertilizer-product nutrient)
118
160
(query-maybe-value (current-conn)
119
Removed:
(string-join
120
Removed:
'("SELECT value_ppm"
121
Removed:
"FROM nutrient_values nv"
122
Removed:
"JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
123
Removed:
"JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
124
Removed:
"WHERE nm.id = $1 AND nv.nutrient_id = $2"))
125
Removed:
(fertilizer-product-id fertilizer-product)
126
Removed:
(nutrient-id nutrient)))
127
Removed:
128
Removed:
(define (get-latest-fertilizer-product-value nutrient)
129
Removed:
(query-maybe-value (current-conn)
130
Removed:
(string-join
131
Removed:
'("SELECT value_ppm"
132
Removed:
"FROM nutrient_values nv"
133
Removed:
"JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
134
Removed:
"JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
135
Removed:
"WHERE nv.nutrient_id = $1"
136
Removed:
"ORDER BY nm.brand_name DESC"
137
Removed:
"LIMIT 1"))
138
Removed:
(nutrient-id nutrient)))
161
Added:
(select value_ppm
162
Added:
#:from (TableExpr:AST ,joined)
163
Added:
#:where (and (= nm.id ,(fertilizer-product-id fertilizer-product))
164
Added:
(= nv.nutrient_id ,(nutrient-id nutrient))))))
139
165
140
166
141
167
;; UPDATE