[Racket] Ferti hydroponic nutrient solver, redux.
Main model structs can now be manipulated by id or entire struct.
This paves the way to passing ids in URLs, and acting upon them in handlers.
Changed files
models/crop-requirement.rkt
@@ -13,9 +13,10 @@
13
13
(->* ()
14
14
(#:id (or/c #f exact-nonnegative-integer?) #:profile (or/c #f string?))
15
15
(or/c crop-requirement? #f))]
16
Removed:
[get-crop-requirement-values (-> crop-requirement? nutrient-value-hash/c)]
17
Removed:
[get-crop-requirement-value (-> crop-requirement? nutrient? number?)]
18
Removed:
[delete-crop-requirement! (-> crop-requirement? void?)]
16
Added:
[get-crop-requirement-values
17
Added:
(-> crop-requirement-or-id/c nutrient-value-hash/c)]
18
Added:
[get-crop-requirement-value (-> crop-requirement-or-id/c nutrient? number?)]
19
Added:
[delete-crop-requirement! (-> crop-requirement-or-id/c void?)]
19
20
[average-crop-requirement-nutrient-values
20
21
(-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100))))
21
22
nutrient-value-hash/c)]))
@@ -32,6 +33,15 @@
32
33
#:guard (λ (id profile crop-id nutrient-values _)
33
34
(values id profile (if (sql-null? crop-id) #f crop-id) nutrient-values)))
34
35
36
Added:
(define crop-requirement-id? exact-nonnegative-integer?)
37
Added:
38
Added:
(define crop-requirement-or-id/c (or/c crop-requirement? crop-requirement-id?))
39
Added:
40
Added:
(define (->cr-id cr-or-id)
41
Added:
(match cr-or-id
42
Added:
[(? crop-requirement-id? cr-or-id) cr-or-id]
43
Added:
[(crop-requirement id _ _ _) id]))
44
Added:
35
45
;; CREATE
36
46
37
47
(define (create-crop-requirement! profile nutrient-values [crop #f])
@@ -117,7 +127,7 @@
117
127
[(list row) (grouped-row->crop-requirement row)]
118
128
[many (error 'get-crop-requirement "expected 1 crop requirement, got ~a" (length many))]))
119
129
120
Removed:
(define (get-crop-requirement-values crop-requirement)
130
Added:
(define (get-crop-requirement-values cr-or-id)
121
131
(for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
122
132
(in-query (current-conn)
123
133
(select n.id
@@ -126,23 +136,22 @@
126
136
n.formula
127
137
nv.value_ppm
128
138
#:from (TableExpr:AST ,joined)
129
Removed:
#:where (= cr.id ,(crop-requirement-id crop-requirement))))])
139
Added:
#:where (= cr.id ,(->cr-id cr-or-id))))])
130
140
(values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
131
141
132
Removed:
(define (get-crop-requirement-value crop-requirement nutrient)
142
Added:
(define (get-crop-requirement-value cr-or-id nutrient)
133
143
(query-maybe-value (current-conn)
134
144
(select value_ppm
135
145
#:from (TableExpr:AST ,joined)
136
Removed:
#:where (and (= cr.id ,(crop-requirement-id crop-requirement))
146
Added:
#:where (and (= cr.id ,(->cr-id cr-or-id))
137
147
(= nv.nutrient_id ,(nutrient-id nutrient))))))
138
148
139
149
;; UPDATE
140
150
141
151
;; DELETE
142
152
143
Removed:
(define (delete-crop-requirement! crop-requirement)
144
Removed:
(define id (crop-requirement-id crop-requirement))
145
Removed:
(query-exec (current-conn) (delete #:from crop_requirements #:where (= id ,id))))
153
Added:
(define (delete-crop-requirement! cr-or-id)
154
Added:
(query-exec (current-conn) (delete #:from crop_requirements #:where (= id ,(->cr-id cr-or-id)))))
146
155
147
156
;; Helpers
148
157
models/fertilizer-product.rkt
@@ -13,9 +13,9 @@
13
13
(->* ()
14
14
(#:id (or/c #f exact-nonnegative-integer?) #:canonical-name (or/c #f string?))
15
15
(or/c fertilizer-product? #f))]
16
Removed:
[get-fertilizer-product-values (-> fertilizer-product? nutrient-value-hash/c)]
17
Removed:
[get-fertilizer-product-value (-> fertilizer-product? nutrient? (or/c #f number?))]
18
Removed:
[delete-fertilizer-product! (-> fertilizer-product? void?)]))
16
Added:
[get-fertilizer-product-values (-> fertilizer-product-or-id/c nutrient-value-hash/c)]
17
Added:
[get-fertilizer-product-value (-> fertilizer-product-or-id/c nutrient? (or/c #f number?))]
18
Added:
[delete-fertilizer-product! (-> fertilizer-product-or-id/c void?)]))
19
19
20
20
(require racket/contract
21
21
db
@@ -42,6 +42,15 @@
42
42
(~a (nutrient-canonical-name n) #:min-width 14)
43
43
(~a v #:max-width 6 #:align 'right)))))
44
44
45
Added:
(define fertilizer-product-id? exact-nonnegative-integer?)
46
Added:
47
Added:
(define fertilizer-product-or-id/c (or/c fertilizer-product? fertilizer-product-id?))
48
Added:
49
Added:
(define (->fp-id fp-or-id)
50
Added:
(match fp-or-id
51
Added:
[(? fertilizer-product-id? id) id]
52
Added:
[(fertilizer-product id _ _ _) id]))
53
Added:
45
54
;; CREATE
46
55
47
56
(define (create-fertilizer-product! canonical-name brand-name nutrient-values)
@@ -129,7 +138,7 @@
129
138
[(list row) (grouped-row->fertilizer-product row)]
130
139
[many (error 'get-fertilizer-product "expected 1 fertilizer product, got ~a" (length many))]))
131
140
132
Removed:
(define (get-fertilizer-product-values fertilizer-product)
141
Added:
(define (get-fertilizer-product-values fp-or-id)
133
142
(for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
134
143
(in-query (current-conn)
135
144
(select n.id
@@ -138,20 +147,19 @@
138
147
n.formula
139
148
nv.value_ppm
140
149
#:from (TableExpr:AST ,joined)
141
Removed:
#:where (= fp.id ,(fertilizer-product-id fertilizer-product))))])
150
Added:
#:where (= fp.id ,(->fp-id fp-or-id))))])
142
151
(values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
143
152
144
Removed:
(define (get-fertilizer-product-value fertilizer-product nutrient)
153
Added:
(define (get-fertilizer-product-value fp-or-id nutrient)
145
154
(query-maybe-value (current-conn)
146
155
(select value_ppm
147
156
#:from (TableExpr:AST ,joined)
148
Removed:
#:where (and (= fp.id ,(fertilizer-product-id fertilizer-product))
157
Added:
#:where (and (= fp.id ,(->fp-id fp-or-id))
149
158
(= nv.nutrient_id ,(nutrient-id nutrient))))))
150
159
151
160
;; UPDATE
152
161
153
162
;; DELETE
154
163
155
Removed:
(define (delete-fertilizer-product! fertilizer-product)
156
Removed:
(define id (fertilizer-product-id fertilizer-product))
157
Removed:
(query-exec (current-conn) (delete #:from fertilizer_products #:where (= id ,id))))
164
Added:
(define (delete-fertilizer-product! fp-or-id)
165
Added:
(query-exec (current-conn) (delete #:from fertilizer_products #:where (= id ,(->fp-id fp-or-id)))))
models/nutrient-measurement.rkt
@@ -12,11 +12,11 @@
12
12
(->* ()
13
13
(#:id (or/c #f exact-nonnegative-integer?) #:measured-on (or/c #f string?))
14
14
(or/c nutrient-measurement? #f))]
15
Removed:
[get-nutrient-measurement-values (-> nutrient-measurement? nutrient-value-hash/c)]
16
Removed:
[get-nutrient-measurement-value (-> nutrient-measurement? nutrient? (or/c number? #f))]
17
Removed:
[get-latest-nutrient-measurement-value (-> nutrient? (or/c number? #f))]
15
Added:
[get-nutrient-measurement-values (-> nutrient-measurement-or-id/c nutrient-value-hash/c)]
16
Added:
[get-nutrient-measurement-value (-> nutrient-measurement-or-id/c nutrient? (or/c real? #f))]
17
Added:
[get-latest-nutrient-measurement-value (-> nutrient? (or/c real? #f))]
18
18
[get-latest-nutrient-measurement-hash (-> nutrient-value-hash/c)]
19
Removed:
[delete-nutrient-measurement! (-> nutrient-measurement? void?)]))
19
Added:
[delete-nutrient-measurement! (-> nutrient-measurement-or-id/c void?)]))
20
20
21
21
(require racket/contract
22
22
db
@@ -38,6 +38,15 @@
38
38
(~a (nutrient-canonical-name n) #:min-width 14)
39
39
(~a v #:max-width 6 #:align 'right)))))
40
40
41
Added:
(define nutrient-measurement-id? exact-nonnegative-integer?)
42
Added:
43
Added:
(define nutrient-measurement-or-id/c (or/c nutrient-measurement? nutrient-measurement-id?))
44
Added:
45
Added:
(define (->nm-id nm-or-id)
46
Added:
(match nm-or-id
47
Added:
[(? nutrient-measurement-id? id) id]
48
Added:
[(nutrient-measurement id _ _) id]))
49
Added:
41
50
;; CREATE
42
51
43
52
(define (create-nutrient-measurement! measured-on nutrient-values)
@@ -120,7 +129,7 @@
120
129
[(list row) (grouped-row->nutrient-measurement row)]
121
130
[many (error 'get-nutrient-measurement "expected 1 nutrient measurement, got ~a" (length many))]))
122
131
123
Removed:
(define (get-nutrient-measurement-values nutrient-measurement)
132
Added:
(define (get-nutrient-measurement-values nm-or-id)
124
133
(for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
125
134
(in-query (current-conn)
126
135
(select n.id
@@ -129,14 +138,14 @@
129
138
n.formula
130
139
nv.value_ppm
131
140
#:from (TableExpr:AST ,joined)
132
Removed:
#:where (= nm.id ,(nutrient-measurement-id nutrient-measurement))))])
141
Added:
#:where (= nm.id ,(->nm-id nm-or-id))))])
133
142
(values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
134
143
135
Removed:
(define (get-nutrient-measurement-value nutrient-measurement nutrient)
144
Added:
(define (get-nutrient-measurement-value nm-or-id nutrient)
136
145
(query-maybe-value (current-conn)
137
146
(select value_ppm
138
147
#:from (TableExpr:AST ,joined)
139
Removed:
#:where (and (= nm.id ,(nutrient-measurement-id nutrient-measurement))
148
Added:
#:where (and (= nm.id ,(->nm-id nm-or-id))
140
149
(= nv.nutrient_id ,(nutrient-id nutrient))))))
141
150
142
151
(define (get-latest-nutrient-measurement-value nutrient)
@@ -171,9 +180,9 @@
171
180
172
181
;; DELETE
173
182
174
Removed:
(define (delete-nutrient-measurement! nutrient-measurement)
175
Removed:
(define id (nutrient-measurement-id nutrient-measurement))
176
Removed:
(query-exec (current-conn) (delete #:from nutrient_measurements #:where (= id ,id))))
183
Added:
(define (delete-nutrient-measurement! nm-or-id)
184
Added:
(query-exec (current-conn)
185
Added:
(delete #:from nutrient_measurements #:where (= id ,(->nm-id nm-or-id)))))
177
186
178
187
(module+ test
179
188
(require rackunit
models/nutrient-target.rkt
@@ -5,18 +5,18 @@
5
5
nutrient-target-id
6
6
(rename-out [nutrient-target-effective-on nutrient-target-date]
7
7
[nutrient-target-nutrient-values nutrient-target-values])
8
Removed:
(contract-out [create-nutrient-target! (-> string? nutrient-value-hash/c nutrient-target?)]
9
Removed:
[get-nutrient-targets (-> (listof nutrient-target?))]
10
Removed:
[get-nutrient-target
11
Removed:
(->* ()
12
Removed:
(#:id (or/c #f exact-nonnegative-integer?)
13
Removed:
#:effective-on (or/c #f string?))
14
Removed:
(or/c nutrient-target? #f))]
15
Removed:
[get-nutrient-target-values (-> nutrient-target? nutrient-value-hash/c)]
16
Removed:
[get-nutrient-target-value (-> nutrient-target? nutrient? (or/c number? #f))]
17
Removed:
[get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
18
Removed:
[get-latest-nutrient-target-hash (-> nutrient-value-hash/c)]
19
Removed:
[delete-nutrient-target! (-> nutrient-target? void?)]))
8
Added:
(contract-out
9
Added:
[create-nutrient-target! (-> string? nutrient-value-hash/c nutrient-target?)]
10
Added:
[get-nutrient-targets (-> (listof nutrient-target?))]
11
Added:
[get-nutrient-target
12
Added:
(->* ()
13
Added:
(#:id (or/c #f exact-nonnegative-integer?) #:effective-on (or/c #f string?))
14
Added:
(or/c nutrient-target? #f))]
15
Added:
[get-nutrient-target-values (-> nutrient-target-or-id/c nutrient-value-hash/c)]
16
Added:
[get-nutrient-target-value (-> nutrient-target-or-id/c nutrient? (or/c number? #f))]
17
Added:
[get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))]
18
Added:
[get-latest-nutrient-target-hash (-> nutrient-value-hash/c)]
19
Added:
[delete-nutrient-target! (-> nutrient-target-or-id/c void?)]))
20
20
21
21
(require racket/contract
22
22
db
@@ -35,6 +35,15 @@
35
35
(~a (nutrient-canonical-name n) #:min-width 14)
36
36
(~a v #:max-width 6 #:align 'right)))))
37
37
38
Added:
(define nutrient-target-id? exact-nonnegative-integer?)
39
Added:
40
Added:
(define nutrient-target-or-id/c (or/c nutrient-target? nutrient-target-id?))
41
Added:
42
Added:
(define (->nt-id nt-or-id)
43
Added:
(match nt-or-id
44
Added:
[(? nutrient-target-id? id) id]
45
Added:
[(nutrient-target id _ _) id]))
46
Added:
38
47
;; CREATE
39
48
40
49
(define (create-nutrient-target! effective-on nutrient-values)
@@ -73,19 +82,21 @@
73
82
(nutrient-target nt-id effective-on (residuals->nutrient-value-hash residuals)))
74
83
75
84
(define (get-nutrient-targets)
76
Removed:
(for/list ([grouped-row (in-query (current-conn)
77
Removed:
(select nt.id
78
Removed:
nt.effective_on
79
Removed:
n.id
80
Removed:
n.canonical_name
81
Removed:
n.french_name
82
Removed:
n.formula
83
Removed:
nv.value_ppm
84
Removed:
#:from (TableExpr:AST ,joined)
85
Removed:
#:order-by nt.effective_on
86
Removed:
#:desc)
87
Removed:
#:group '#(0 1))])
88
Removed:
(grouped-row->nutrient-target grouped-row)))
85
Added:
(define grouped-rows
86
Added:
(query-rows (current-conn)
87
Added:
(select nt.id
88
Added:
nt.effective_on
89
Added:
n.id
90
Added:
n.canonical_name
91
Added:
n.french_name
92
Added:
n.formula
93
Added:
nv.value_ppm
94
Added:
#:from (TableExpr:AST ,joined)
95
Added:
#:order-by nt.effective_on
96
Added:
#:desc)
97
Added:
#:group '#(0 1)))
98
Added:
(for/list ([row grouped-rows])
99
Added:
(grouped-row->nutrient-target row)))
89
100
90
101
(define (get-nutrient-target #:id [nt-id #f] #:effective-on [effective-on #f])
91
102
(define where
@@ -114,7 +125,7 @@
114
125
[(list row) (grouped-row->nutrient-target row)]
115
126
[many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))]))
116
127
117
Removed:
(define (get-nutrient-target-values nutrient-target)
128
Added:
(define (get-nutrient-target-values nt-or-id)
118
129
(for/hash ([(nutrient-id canonical-name french-name formula value_ppm)
119
130
(in-query (current-conn)
120
131
(select n.id
@@ -123,14 +134,14 @@
123
134
n.formula
124
135
nv.value_ppm
125
136
#:from (TableExpr:AST ,joined)
126
Removed:
#:where (= nt.id ,(nutrient-target-id nutrient-target))))])
137
Added:
#:where (= nt.id ,(->nt-id nt-or-id))))])
127
138
(values (nutrient nutrient-id canonical-name french-name formula) value_ppm)))
128
139
129
Removed:
(define (get-nutrient-target-value nutrient-target nutrient)
140
Added:
(define (get-nutrient-target-value nt-or-id nutrient)
130
141
(query-maybe-value (current-conn)
131
142
(select value_ppm
132
143
#:from (TableExpr:AST ,joined)
133
Removed:
#:where (and (= nt.id ,(nutrient-target-id nutrient-target))
144
Added:
#:where (and (= nt.id ,(->nt-id nt-or-id))
134
145
(= nv.nutrient_id ,(nutrient-id nutrient))))))
135
146
136
147
(define (get-latest-nutrient-target-value nutrient)
@@ -165,6 +176,6 @@
165
176
166
177
;; DELETE
167
178
168
Removed:
(define (delete-nutrient-target! nutrient-target)
179
Added:
(define (delete-nutrient-target! nt-or-id)
169
180
(define id (nutrient-target-id nutrient-target))
170
Removed:
(query-exec (current-conn) (delete #:from nutrient_targets #:where (= id ,id))))
181
Added:
(query-exec (current-conn) (delete #:from nutrient_targets #:where (= id ,(->nt-id nt-or-id)))))