[Racket] Ferti hydroponic nutrient solver, redux.
raco fmt.
Changed files
- db/conn.rkt
- db/migrations.rkt
- db/seed.rkt
- formlets.rkt
- handlers.rkt
- main.rkt
- models/crop-requirement.rkt
- models/crop.rkt
- models/fertilizer-product.rkt
- models/nutrient-measurement.rkt
- models/nutrient-target.rkt
- models/nutrient.rkt
- models/user.rkt
- tests/models/nutrient-measurement.rkt
- tests/models/nutrient.rkt
- views.rkt
db/conn.rkt
@@ -12,11 +12,9 @@
12
12
13
13
(define (connect! #:path [path 'memory])
14
14
(cond
15
Removed:
[(connection? (current-conn))
16
Removed:
(printf "Database connection already exists: ~e\n" (current-conn))]
15
Added:
[(connection? (current-conn)) (printf "Database connection already exists: ~e\n" (current-conn))]
17
16
[else
18
Removed:
(current-conn (sqlite3-connect #:database path
19
Removed:
#:mode 'create))
17
Added:
(current-conn (sqlite3-connect #:database path #:mode 'create))
20
18
(printf "Created database connection at path: ~a\n" path)]))
21
19
22
20
(define (disconnect!)
@@ -25,10 +23,14 @@
25
23
(current-conn #f))
26
24
27
25
(define-syntax-rule (with-db body ...)
28
Removed:
(begin (connect!) body ...))
26
Added:
(begin
27
Added:
(connect!)
28
Added:
body ...))
29
29
30
30
(define-syntax-rule (with-tx body ...)
31
Removed:
(call-with-transaction (current-conn) (λ () body ...)))
31
Added:
(call-with-transaction (current-conn)
32
Added:
(λ ()
33
Added:
body ...)))
32
34
33
35
(module+ test
34
36
(require rackunit)
@@ -37,5 +39,4 @@
37
39
(check-true (connection? (current-conn)))
38
40
(disconnect!)
39
41
(check-equal? (current-conn) #f)
40
Removed:
(with-db
41
Removed:
(check-true (connection? (current-conn)))))
42
Added:
(with-db (check-true (connection? (current-conn)))))
db/migrations.rkt
@@ -14,203 +14,149 @@
14
14
(for ([pair (in-list (unbox migrations-box))])
15
15
(match pair
16
16
[(cons migration-name stmts)
17
Removed:
(with-tx
18
Removed:
(for ([stmt (in-list stmts)])
19
Removed:
(query-exec (current-conn) stmt)))
17
Added:
(with-tx (for ([stmt (in-list stmts)])
18
Added:
(query-exec (current-conn) stmt)))
20
19
(printf "Applied migration: ~a\n" migration-name)])))
21
20
22
21
(define-syntax-rule (define-migration migration-name sql)
23
Removed:
(let ((migrations (unbox migrations-box))
24
Removed:
(name-symbol (string->symbol migration-name)))
22
Added:
(let ([migrations (unbox migrations-box)]
23
Added:
[name-symbol (string->symbol migration-name)])
25
24
(if (assoc name-symbol migrations)
26
25
(error 'define-migration "migration '~a' declared more than once" migration-name)
27
26
(set-box! migrations-box (append migrations (list (cons name-symbol sql)))))))
28
27
29
Removed:
30
28
;;;;;;;;
31
29
;; USERS
32
30
;;;;;;;;
33
31
34
32
(define-migration "create table users"
35
Removed:
(list
36
Removed:
(create-table #:if-not-exists
37
Removed:
users
38
Removed:
#:columns
39
Removed:
[id integer #:not-null]
40
Removed:
[name text #:not-null]
41
Removed:
[role_id integer]
42
Removed:
#:constraints
43
Removed:
(primary-key id)
44
Removed:
(unique name)
45
Removed:
(foreign-key role_id
46
Removed:
#:references (user_roles id)))))
33
Added:
(list (create-table #:if-not-exists users
34
Added:
#:columns [id integer #:not-null]
35
Added:
[name text #:not-null]
36
Added:
[role_id integer]
37
Added:
#:constraints (primary-key id)
38
Added:
(unique name)
39
Added:
(foreign-key role_id #:references (user_roles id)))))
47
40
48
41
(define-migration "create table user_roles"
49
Removed:
(list
50
Removed:
(create-table #:if-not-exists
51
Removed:
user_roles
52
Removed:
#:columns
53
Removed:
[id integer #:not-null]
54
Removed:
[name text #:not-null]
55
Removed:
#:constraints
56
Removed:
(primary-key id)
57
Removed:
(unique name))))
42
Added:
(list (create-table #:if-not-exists user_roles
43
Added:
#:columns [id integer #:not-null]
44
Added:
[name text #:not-null]
45
Added:
#:constraints (primary-key id)
46
Added:
(unique name))))
58
47
59
Removed:
60
48
;;;;;;;;;;;;
61
49
;; NUTRIENTS
62
50
;;;;;;;;;;;;
63
51
64
52
(define-migration "create table nutrients"
65
Removed:
(list
66
Removed:
(create-table #:if-not-exists
67
Removed:
nutrients
68
Removed:
#:columns
69
Removed:
[id integer #:not-null]
70
Removed:
[canonical_name text #:not-null]
71
Removed:
[formula text #:not-null]
72
Removed:
#:constraints
73
Removed:
(primary-key id)
74
Removed:
(unique canonical_name)
75
Removed:
(unique formula))))
53
Added:
(list (create-table #:if-not-exists nutrients
54
Added:
#:columns [id integer #:not-null]
55
Added:
[canonical_name text #:not-null]
56
Added:
[formula text #:not-null]
57
Added:
#:constraints (primary-key id)
58
Added:
(unique canonical_name)
59
Added:
(unique formula))))
76
60
77
Removed:
(define-migration "create table nutrient_value_sets"
78
Removed:
(list
79
Removed:
(create-table #:if-not-exists
80
Removed:
nutrient_value_sets
81
Removed:
#:columns
82
Removed:
[id integer #:not-null]
83
Removed:
[nutrient_measurement_id integer]
84
Removed:
[nutrient_target_id integer]
85
Removed:
[crop_requirement_id integer]
86
Removed:
[fertilizer_product_id integer]
87
Removed:
#:constraints
88
Removed:
(primary-key id)
89
Removed:
(foreign-key nutrient_measurement_id
90
Removed:
#:references (nutrient_measurements id)
91
Removed:
#:on-delete #:cascade)
92
Removed:
(foreign-key nutrient_target_id
93
Removed:
#:references (nutrient_targets id)
94
Removed:
#:on-delete #:cascade)
95
Removed:
(foreign-key crop_requirement_id
96
Removed:
#:references (crop_requirements id)
97
Removed:
#:on-delete #:cascade)
98
Removed:
(foreign-key fertilizer_product_id
99
Removed:
#:references (fertilizer_products id)
100
Removed:
#:on-delete #:cascade)
101
Removed:
(unique nutrient_measurement_id)
102
Removed:
(unique nutrient_target_id)
103
Removed:
(unique crop_requirement_id)
104
Removed:
(unique fertilizer_product_id)
105
Removed:
(check (or (and (is-not-null nutrient_measurement_id)
106
Removed:
(is-null nutrient_target_id)
107
Removed:
(is-null crop_requirement_id)
108
Removed:
(is-null fertilizer_product_id))
109
Removed:
(and (is-null nutrient_measurement_id)
110
Removed:
(is-not-null nutrient_target_id)
111
Removed:
(is-null crop_requirement_id)
112
Removed:
(is-null fertilizer_product_id))
113
Removed:
(and (is-null nutrient_measurement_id)
114
Removed:
(is-null nutrient_target_id)
115
Removed:
(is-not-null crop_requirement_id)
116
Removed:
(is-null fertilizer_product_id))
117
Removed:
(and (is-null nutrient_measurement_id)
118
Removed:
(is-null nutrient_target_id)
119
Removed:
(is-null crop_requirement_id)
120
Removed:
(is-not-null fertilizer_product_id)))))
121
Removed:
"CREATE INDEX IF NOT EXISTS idx_nvs_meas ON nutrient_value_sets(nutrient_measurement_id)"
122
Removed:
"CREATE INDEX IF NOT EXISTS idx_nvs_targ ON nutrient_value_sets(nutrient_target_id)"
123
Removed:
"CREATE INDEX IF NOT EXISTS idx_nvs_crop ON nutrient_value_sets(crop_requirement_id)"
124
Removed:
"CREATE INDEX IF NOT EXISTS idx_nvs_prod ON nutrient_value_sets(fertilizer_product_id)"))
61
Added:
(define-migration
62
Added:
"create table nutrient_value_sets"
63
Added:
(list
64
Added:
(create-table
65
Added:
#:if-not-exists nutrient_value_sets
66
Added:
#:columns [id integer #:not-null]
67
Added:
[nutrient_measurement_id integer]
68
Added:
[nutrient_target_id integer]
69
Added:
[crop_requirement_id integer]
70
Added:
[fertilizer_product_id integer]
71
Added:
#:constraints (primary-key id)
72
Added:
(foreign-key nutrient_measurement_id #:references (nutrient_measurements id) #:on-delete #:cascade)
73
Added:
(foreign-key nutrient_target_id #:references (nutrient_targets id) #:on-delete #:cascade)
74
Added:
(foreign-key crop_requirement_id #:references (crop_requirements id) #:on-delete #:cascade)
75
Added:
(foreign-key fertilizer_product_id #:references (fertilizer_products id) #:on-delete #:cascade)
76
Added:
(unique nutrient_measurement_id)
77
Added:
(unique nutrient_target_id)
78
Added:
(unique crop_requirement_id)
79
Added:
(unique fertilizer_product_id)
80
Added:
(check (or (and (is-not-null nutrient_measurement_id)
81
Added:
(is-null nutrient_target_id)
82
Added:
(is-null crop_requirement_id)
83
Added:
(is-null fertilizer_product_id))
84
Added:
(and (is-null nutrient_measurement_id)
85
Added:
(is-not-null nutrient_target_id)
86
Added:
(is-null crop_requirement_id)
87
Added:
(is-null fertilizer_product_id))
88
Added:
(and (is-null nutrient_measurement_id)
89
Added:
(is-null nutrient_target_id)
90
Added:
(is-not-null crop_requirement_id)
91
Added:
(is-null fertilizer_product_id))
92
Added:
(and (is-null nutrient_measurement_id)
93
Added:
(is-null nutrient_target_id)
94
Added:
(is-null crop_requirement_id)
95
Added:
(is-not-null fertilizer_product_id)))))
96
Added:
"CREATE INDEX IF NOT EXISTS idx_nvs_meas ON nutrient_value_sets(nutrient_measurement_id)"
97
Added:
"CREATE INDEX IF NOT EXISTS idx_nvs_targ ON nutrient_value_sets(nutrient_target_id)"
98
Added:
"CREATE INDEX IF NOT EXISTS idx_nvs_crop ON nutrient_value_sets(crop_requirement_id)"
99
Added:
"CREATE INDEX IF NOT EXISTS idx_nvs_prod ON nutrient_value_sets(fertilizer_product_id)"))
125
100
126
Removed:
(define-migration "create table nutrient_values"
127
Removed:
(list
128
Removed:
(create-table #:if-not-exists
129
Removed:
nutrient_values
130
Removed:
#:columns
131
Removed:
[value_set_id integer #:not-null]
132
Removed:
[nutrient_id integer #:not-null]
133
Removed:
[value_ppm real #:not-null]
134
Removed:
#:constraints
135
Removed:
(primary-key value_set_id nutrient_id)
136
Removed:
(foreign-key value_set_id
137
Removed:
#:references (nutrient_value_sets id)
138
Removed:
#:on-delete #:cascade)
139
Removed:
(foreign-key nutrient_id
140
Removed:
#:references (nutrients id)
141
Removed:
#:on-delete #:cascade))
142
Removed:
"CREATE INDEX IF NOT EXISTS idx_nv_set_nutrient ON nutrient_values(value_set_id, nutrient_id)"))
101
Added:
(define-migration
102
Added:
"create table nutrient_values"
103
Added:
(list
104
Added:
(create-table #:if-not-exists nutrient_values
105
Added:
#:columns [value_set_id integer #:not-null]
106
Added:
[nutrient_id integer #:not-null]
107
Added:
[value_ppm real #:not-null]
108
Added:
#:constraints (primary-key value_set_id nutrient_id)
109
Added:
(foreign-key value_set_id #:references (nutrient_value_sets id) #:on-delete #:cascade)
110
Added:
(foreign-key nutrient_id #:references (nutrients id) #:on-delete #:cascade))
111
Added:
"CREATE INDEX IF NOT EXISTS idx_nv_set_nutrient ON nutrient_values(value_set_id, nutrient_id)"))
143
112
144
113
(define-migration "create table nutrient_measurements"
145
Removed:
(list
146
Removed:
(create-table #:if-not-exists
147
Removed:
nutrient_measurements
148
Removed:
#:columns
149
Removed:
[id integer #:not-null]
150
Removed:
;; ISO8601 date
151
Removed:
[measured_on text #:not-null]
152
Removed:
#:constraints
153
Removed:
(primary-key id)
154
Removed:
(unique measured_on))))
114
Added:
(list (create-table #:if-not-exists nutrient_measurements
115
Added:
#:columns [id integer #:not-null]
116
Added:
;; ISO8601 date
117
Added:
[measured_on text #:not-null]
118
Added:
#:constraints (primary-key id)
119
Added:
(unique measured_on))))
155
120
156
121
(define-migration "create table nutrient_targets"
157
Removed:
(list
158
Removed:
(create-table #:if-not-exists
159
Removed:
nutrient_targets
160
Removed:
#:columns
161
Removed:
[id integer #:not-null]
162
Removed:
;; ISO8601 date
163
Removed:
[effective_on text #:not-null]
164
Removed:
#:constraints
165
Removed:
(primary-key id)
166
Removed:
(unique effective_on))))
122
Added:
(list (create-table #:if-not-exists nutrient_targets
123
Added:
#:columns [id integer #:not-null]
124
Added:
;; ISO8601 date
125
Added:
[effective_on text #:not-null]
126
Added:
#:constraints (primary-key id)
127
Added:
(unique effective_on))))
167
128
168
Removed:
169
129
;;;;;;;;
170
130
;; CROPS
171
131
;;;;;;;;
172
132
173
133
(define-migration "create table crops"
174
Removed:
(list
175
Removed:
(create-table #:if-not-exists
176
Removed:
crops
177
Removed:
#:columns
178
Removed:
[id integer #:not-null]
179
Removed:
[canonical_name integer #:not-null]
180
Removed:
#:constraints
181
Removed:
(primary-key id)
182
Removed:
(unique canonical_name))))
134
Added:
(list (create-table #:if-not-exists crops
135
Added:
#:columns [id integer #:not-null]
136
Added:
[canonical_name integer #:not-null]
137
Added:
#:constraints (primary-key id)
138
Added:
(unique canonical_name))))
183
139
184
Removed:
(define-migration "create table crop_requirements"
185
Removed:
(list
186
Removed:
(create-table #:if-not-exists
187
Removed:
crop_requirements
188
Removed:
#:columns
189
Removed:
[id integer #:not-null]
190
Removed:
[crop_id integer]
191
Removed:
[profile text #:not-null]
192
Removed:
#:constraints
193
Removed:
(primary-key id)
194
Removed:
(foreign-key crop_id
195
Removed:
#:references (crops id)
196
Removed:
#:on-delete #:cascade))))
140
Added:
(define-migration
141
Added:
"create table crop_requirements"
142
Added:
(list (create-table #:if-not-exists crop_requirements
143
Added:
#:columns [id integer #:not-null]
144
Added:
[crop_id integer]
145
Added:
[profile text #:not-null]
146
Added:
#:constraints (primary-key id)
147
Added:
(foreign-key crop_id #:references (crops id) #:on-delete #:cascade))))
197
148
198
Removed:
199
149
;;;;;;;;;;;;;;
200
150
;; FERTILIZERS
201
151
;;;;;;;;;;;;;;
202
152
203
153
(define-migration "create table fertilizer_products"
204
Removed:
(list
205
Removed:
(create-table #:if-not-exists
206
Removed:
fertilizer_products
207
Removed:
#:columns
208
Removed:
[id integer #:not-null]
209
Removed:
[canonical_name text #:not-null]
210
Removed:
[brand_name text]
211
Removed:
#:constraints
212
Removed:
(primary-key id)
213
Removed:
(unique canonical_name))))
154
Added:
(list (create-table #:if-not-exists fertilizer_products
155
Added:
#:columns [id integer #:not-null]
156
Added:
[canonical_name text #:not-null]
157
Added:
[brand_name text]
158
Added:
#:constraints (primary-key id)
159
Added:
(unique canonical_name))))
214
160
215
161
(module+ test
216
162
(connect!)
db/seed.rkt
@@ -20,29 +20,27 @@
20
20
(define (seed-nutrients!)
21
21
(define nutrient-names (map nutrient-name (get-nutrients)))
22
22
(define default-nutrients
23
Removed:
'(("Nitrate Nitrogen" "NNO3")
24
Removed:
("Phosphorus" "P")
25
Removed:
("Potassium" "K")
26
Removed:
("Calcium" "Ca")
27
Removed:
("Magnesium" "Mg")
28
Removed:
("Sulfur" "S")
29
Removed:
("Sodium" "Na")
30
Removed:
("Chloride" "Cl")
31
Removed:
("Silicon" "Si")
32
Removed:
("Iron" "Fe")
33
Removed:
("Zinc" "Zn")
34
Removed:
("Boron" "B")
35
Removed:
("Manganese" "Mn")
36
Removed:
("Copper" "Cu")
37
Removed:
("Molybdenum" "Mo")
38
Removed:
("Ammonium Nitrogen" "NNH4")))
39
Removed:
(with-tx
40
Removed:
(for ([pair (in-list default-nutrients)])
41
Removed:
(define name (first pair))
42
Removed:
(define formula (second pair))
43
Removed:
;; Ensure idempotence
44
Removed:
(unless (member name nutrient-names)
45
Removed:
(create-nutrient! name formula)))))
23
Added:
'(("Nitrate Nitrogen" "NNO3") ("Phosphorus" "P")
24
Added:
("Potassium" "K")
25
Added:
("Calcium" "Ca")
26
Added:
("Magnesium" "Mg")
27
Added:
("Sulfur" "S")
28
Added:
("Sodium" "Na")
29
Added:
("Chloride" "Cl")
30
Added:
("Silicon" "Si")
31
Added:
("Iron" "Fe")
32
Added:
("Zinc" "Zn")
33
Added:
("Boron" "B")
34
Added:
("Manganese" "Mn")
35
Added:
("Copper" "Cu")
36
Added:
("Molybdenum" "Mo")
37
Added:
("Ammonium Nitrogen" "NNH4")))
38
Added:
(with-tx (for ([pair (in-list default-nutrients)])
39
Added:
(define name (first pair))
40
Added:
(define formula (second pair))
41
Added:
;; Ensure idempotence
42
Added:
(unless (member name nutrient-names)
43
Added:
(create-nutrient! name formula)))))
46
44
47
45
(define-runtime-path measurement-csv "data/dolibarr_nutrient_measurements_ppm.csv")
48
46
(define (seed-historical-nutrient-measurements!)
@@ -58,20 +56,15 @@
58
56
(define v (string->number (cdr nm)))
59
57
(cons n v)))
60
58
(create-nutrient-measurement! measured-on nutrient-values))
61
Removed:
(with-tx
62
Removed:
(csv-for-each row->seed! next-row)))
59
Added:
(with-tx (csv-for-each row->seed! next-row)))
63
60
64
61
(define (seed-crops!)
65
62
(define crop-names (map crop-name (get-crops)))
66
Removed:
(define default-crops '("salade"
67
Removed:
"laitue"
68
Removed:
"tomate"
69
Removed:
"framboise"))
70
Removed:
(with-tx
71
Removed:
(for ([name (in-list default-crops)])
72
Removed:
;; Ensure idempotence
73
Removed:
(unless (member name crop-names)
74
Removed:
(create-crop! name)))))
63
Added:
(define default-crops '("salade" "laitue" "tomate" "framboise"))
64
Added:
(with-tx (for ([name (in-list default-crops)])
65
Added:
;; Ensure idempotence
66
Added:
(unless (member name crop-names)
67
Added:
(create-crop! name)))))
75
68
76
69
(define-runtime-path requirements-csv "data/dolibarr_crop_requirements_ppm.csv")
77
70
(define (seed-crop-requirements!)
@@ -91,10 +84,8 @@
91
84
[(non-empty-string? crop-name)
92
85
(define crop (get-crop #:name crop-name))
93
86
(create-crop-requirement! profile nutrient-values crop)]
94
Removed:
[else
95
Removed:
(create-crop-requirement! profile nutrient-values)]))
96
Removed:
(with-tx
97
Removed:
(csv-for-each row->seed! next-row)))
87
Added:
[else (create-crop-requirement! profile nutrient-values)]))
88
Added:
(with-tx (csv-for-each row->seed! next-row)))
98
89
99
90
(define-runtime-path fertilizer-csv "data/dolibarr_fertilizer_compositions_percentage.csv")
100
91
(define (seed-existing-fertilizer-products!)
@@ -113,10 +104,8 @@
113
104
(cond
114
105
[(non-empty-string? brand-name)
115
106
(create-fertilizer-product! canonical-name nutrient-values brand-name)]
116
Removed:
[else
117
Removed:
(create-fertilizer-product! canonical-name nutrient-values)]))
118
Removed:
(with-tx
119
Removed:
(csv-for-each row->seed! next-row)))
107
Added:
[else (create-fertilizer-product! canonical-name nutrient-values)]))
108
Added:
(with-tx (csv-for-each row->seed! next-row)))
120
109
121
110
(define seed-sequence
122
111
(list (cons "nutrients" seed-nutrients!)
formlets.rkt
@@ -10,87 +10,73 @@
10
10
"models/crop.rkt"
11
11
"models/crop-requirement.rkt")
12
12
13
Removed:
14
13
(define date-formlet
15
Removed:
(formlet
16
Removed:
,{=> (to-string
17
Removed:
(required
18
Removed:
(input #:type "date"
19
Removed:
#:value (date->iso8601 (today))
20
Removed:
#:attributes '([class "form-control"] [required "required"]))))
21
Removed:
date-b}
22
Removed:
date-b))
14
Added:
(formlet ,{=>
15
Added:
(to-string (required (input #:type "date"
16
Added:
#:value (date->iso8601 (today))
17
Added:
#:attributes
18
Added:
'((class "form-control") [required "required"]))))
19
Added:
date-b}
20
Added:
date-b))
23
21
24
22
(define (measurement-formlet nutrient)
25
23
(define id (nutrient-id nutrient))
26
24
(define number-input
27
25
(input #:type "number"
28
Removed:
#:attributes `([class "form-control"]
29
Removed:
[id ,(number->string id)]
30
Removed:
[step "0.1"]
31
Removed:
[placeholder ,(nutrient-name nutrient)])))
32
Removed:
(define input-label `(label ([for ,(number->string id)]) ,(nutrient-name nutrient)))
33
Removed:
(formlet
34
Removed:
(#%#
35
Removed:
(div ([class "form-floating mb-3"])
36
Removed:
,{=> number-input nutrient-value-b}
37
Removed:
,input-label))
38
Removed:
(let ([nutrient-value (string->number
39
Removed:
(bytes->string/utf-8
40
Removed:
(binding:form-value nutrient-value-b)))])
41
Removed:
(and nutrient-value (cons id nutrient-value)))))
26
Added:
#:attributes `((class "form-control") [id ,(number->string id)]
27
Added:
[step "0.1"]
28
Added:
[placeholder ,(nutrient-name nutrient)])))
29
Added:
(define input-label
30
Added:
`(label ((for ,(number->string id)
31
Added:
))
32
Added:
,(nutrient-name nutrient)))
33
Added:
(formlet (#%# (div ((class "form-floating mb-3")) ,{=> number-input nutrient-value-b} ,input-label))
34
Added:
(let ([nutrient-value (string->number (bytes->string/utf-8
35
Added:
(binding:form-value nutrient-value-b)))])
36
Added:
(and nutrient-value (cons id nutrient-value)))))
42
37
43
38
(define (measurements-formlet)
44
Removed:
(formlet*
45
Removed:
(#%#
46
Removed:
`(div ([class "mb-3"])
47
Removed:
(h5 "Date du relevé")
48
Removed:
,{=>* date-formlet measured-on*})
49
Removed:
`(div ([class "mb-3"])
50
Removed:
(h5 "Valeurs du relevé")
51
Removed:
,@(for/list ([nutrient (get-nutrients)])
52
Removed:
{=>* (measurement-formlet nutrient) measurements*}))
53
Removed:
{=>* (submit "Enregistrer le relevé" #:attributes '([class "btn btn-primary"])) _})
54
Removed:
(let ([measured-on (first measured-on*)]
55
Removed:
[measurements (filter pair? measurements*)]) ; drop #f’s from empty values
56
Removed:
(values measured-on measurements))))
39
Added:
(formlet* (#%# `(div ((class "mb-3")) (h5 "Date du relevé") ,{=>* date-formlet measured-on*})
40
Added:
`(div ((class "mb-3"))
41
Added:
(h5 "Valeurs du relevé")
42
Added:
,@(for/list ([nutrient (get-nutrients)])
43
Added:
{=>* (measurement-formlet nutrient) measurements*}))
44
Added:
{=>* (submit "Enregistrer le relevé" #:attributes '((class "btn btn-primary"))) _})
45
Added:
(let ([measured-on (first measured-on*)]
46
Added:
[measurements (filter pair? measurements*)]) ; drop #f’s from empty values
47
Added:
(values measured-on measurements))))
57
48
58
49
(define (crop-requirement-formlet requirement)
59
50
(define id (crop-requirement-id requirement))
60
51
(define profile (crop-requirement-profile requirement))
61
52
(define maybe-crop (crop-requirement-crop-id requirement))
62
Removed:
(define crop (if maybe-crop (crop-name (get-crop #:id maybe-crop)) #f))
53
Added:
(define crop
54
Added:
(if maybe-crop
55
Added:
(crop-name (get-crop #:id maybe-crop))
56
Added:
#f))
63
57
(define number-input
64
58
(input #:type "number"
65
Removed:
#:attributes `([class "form-control"]
66
Removed:
[id ,(number->string id)]
67
Removed:
[step "1"]
68
Removed:
[placeholder ,profile])))
69
Removed:
(define input-label `(label ([for ,(number->string id)])
70
Removed:
,(if crop
71
Removed:
(format "~a (~a)" crop profile)
72
Removed:
(format "~a" profile))))
59
Added:
#:attributes
60
Added:
`((class "form-control") [id ,(number->string id)] [step "1"] [placeholder ,profile])))
61
Added:
(define input-label
62
Added:
`(label ((for ,(number->string id)
63
Added:
))
64
Added:
,(if crop
65
Added:
(format "~a (~a)" crop profile)
66
Added:
(format "~a" profile))))
73
67
(formlet
74
Removed:
(#%#
75
Removed:
(div ([class "form-floating mb-3"])
76
Removed:
,{=> number-input requirement-proportion-b}
77
Removed:
,input-label))
78
Removed:
(let ([requirement-proportion (string->number
79
Removed:
(bytes->string/utf-8
80
Removed:
(binding:form-value requirement-proportion-b)))])
68
Added:
(#%# (div ((class "form-floating mb-3")) ,{=> number-input requirement-proportion-b} ,input-label))
69
Added:
(let ([requirement-proportion
70
Added:
(string->number (bytes->string/utf-8 (binding:form-value requirement-proportion-b)))])
81
71
(and requirement-proportion (cons requirement requirement-proportion)))))
82
72
83
73
(define (targets-formlet)
84
Removed:
(formlet*
85
Removed:
(#%#
86
Removed:
`(div ([class "mb-3"])
87
Removed:
(h5 "Date ciblée")
88
Removed:
,{=>* date-formlet effective-on*})
89
Removed:
`(div ([class "mb-3"])
90
Removed:
(h5 "Valeurs cibles")
91
Removed:
,@(for/list ([requirement (get-crop-requirements)])
92
Removed:
{=>* (crop-requirement-formlet requirement) requirements*}))
93
Removed:
{=>* (submit "Enregistrer la cible" #:attributes '([class "btn btn-primary"])) _})
94
Removed:
(let ([effective-on (first effective-on*)]
95
Removed:
[requirements (filter pair? requirements*)]) ; drop #f’s from empty values
96
Removed:
(values effective-on requirements))))
74
Added:
(formlet* (#%# `(div ((class "mb-3")) (h5 "Date ciblée") ,{=>* date-formlet effective-on*})
75
Added:
`(div ((class "mb-3"))
76
Added:
(h5 "Valeurs cibles")
77
Added:
,@(for/list ([requirement (get-crop-requirements)])
78
Added:
{=>* (crop-requirement-formlet requirement) requirements*}))
79
Added:
{=>* (submit "Enregistrer la cible" #:attributes '((class "btn btn-primary"))) _})
80
Added:
(let ([effective-on (first effective-on*)]
81
Added:
[requirements (filter pair? requirements*)]) ; drop #f’s from empty values
82
Added:
(values effective-on requirements))))
handlers.rkt
@@ -14,44 +14,39 @@
14
14
"services/nnls.rkt")
15
15
16
16
(define-values (app-dispatch _)
17
Removed:
(dispatch-rules
18
Removed:
;; Ferti dashboard
19
Removed:
[("ferti") #:method "get" ferti]
20
Removed:
;; Nutrient measurements
21
Removed:
[("measurement" "new") #:method "get" new-measurement]
22
Removed:
[("measurement" "create") #:method "post" create-measurement]
23
Removed:
[("measurement" "destroy") #:method "post" destroy-measurement]
24
Removed:
;; Nutrient targets
25
Removed:
[("target" "new") #:method "get" new-target]
26
Removed:
[("target" "create") #:method "post" create-target]
27
Removed:
;; Index
28
Removed:
[("") #:method "get" index]
29
Removed:
[else fallback]))
17
Added:
;; Ferti dashboard
18
Added:
(dispatch-rules [("ferti") #:method "get" ferti]
19
Added:
;; Nutrient measurements
20
Added:
[("measurement" "new") #:method "get" new-measurement]
21
Added:
[("measurement" "create") #:method "post" create-measurement]
22
Added:
[("measurement" "destroy") #:method "post" destroy-measurement]
23
Added:
;; Nutrient targets
24
Added:
[("target" "new") #:method "get" new-target]
25
Added:
[("target" "create") #:method "post" create-target]
26
Added:
;; Index
27
Added:
[("") #:method "get" index]
28
Added:
[else fallback]))
30
29
31
30
(define (ferti _)
32
Removed:
(define measurements (get-nutrient-measurements))
33
31
(define ferti-recipe (find-ferti-recipe))
32
Added:
(define latest-measurement-hash (get-latest-nutrient-measurement-hash))
33
Added:
(define latest-target-hash (get-latest-nutrient-target-hash))
34
Added:
(define latest-measurements (take* (get-nutrient-measurements) 10))
34
35
(response/xexpr
35
36
#:preamble #"<!DOCTYPE html>"
36
Removed:
(ferti-page measurements ferti-recipe)))
37
Added:
(ferti-page ferti-recipe latest-measurement-hash latest-target-hash latest-measurements)))
37
38
38
39
(define (index _)
39
40
(define user (get-current-user))
40
Removed:
(response/xexpr
41
Removed:
#:preamble #"<!DOCTYPE html>"
42
Removed:
(index-page user)))
41
Added:
(response/xexpr #:preamble #"<!DOCTYPE html>" (index-page user)))
43
42
44
Removed:
45
43
;; Nutrient measurements
46
44
47
45
(define (new-measurement _)
48
Removed:
(response/xexpr
49
Removed:
#:preamble #"<!DOCTYPE html>"
50
Removed:
(new-measurement-page)))
46
Added:
(response/xexpr #:preamble #"<!DOCTYPE html>" (new-measurement-page)))
51
47
52
48
(define (create-measurement req)
53
Removed:
(define-values (measured-on measurements)
54
Removed:
(formlet-process (measurements-formlet) req))
49
Added:
(define-values (measured-on measurements) (formlet-process (measurements-formlet) req))
55
50
(create-nutrient-measurement! measured-on measurements)
56
51
(redirect-to "/"))
57
52
@@ -59,23 +54,16 @@
59
54
(delete-nutrient-measurement! req)
60
55
(redirect-to "/"))
61
56
62
Removed:
63
57
;; Nutrient targets
64
58
65
59
(define (new-target _)
66
Removed:
(response/xexpr
67
Removed:
#:preamble #"<!DOCTYPE html>"
68
Removed:
(new-target-page)))
60
Added:
(response/xexpr #:preamble #"<!DOCTYPE html>" (new-target-page)))
69
61
70
62
(define (create-target req)
71
Removed:
(define-values (effective-on crop-requirement-mix)
72
Removed:
(formlet-process (targets-formlet) req))
73
Removed:
(define target-nutrient-values
74
Removed:
(average-crop-requirement-nutrient-values crop-requirement-mix))
63
Added:
(define-values (effective-on crop-requirement-mix) (formlet-process (targets-formlet) req))
64
Added:
(define target-nutrient-values (average-crop-requirement-nutrient-values crop-requirement-mix))
75
65
(create-nutrient-target! effective-on target-nutrient-values)
76
66
(redirect-to "/"))
77
67
78
68
(define (fallback _)
79
Removed:
(response/xexpr
80
Removed:
#:preamble #"<!DOCTYPE html>"
81
Removed:
(fallback-page 404)))
69
Added:
(response/xexpr #:preamble #"<!DOCTYPE html>" (fallback-page 404)))
main.rkt
@@ -10,5 +10,4 @@
10
10
(connect! #:path "storage/development.sqlite3")
11
11
(migrate-all!)
12
12
(seed-database!)
13
Removed:
(serve/dispatch
14
Removed:
app-dispatch))
13
Added:
(serve/dispatch app-dispatch))
models/crop-requirement.rkt
@@ -1,29 +1,29 @@
1
1
#lang racket
2
2
3
Removed:
(provide
4
Removed:
;; Model struct
5
Removed:
crop-requirement
6
Removed:
crop-requirement?
7
Removed:
crop-requirement-id crop-requirement-profile crop-requirement-crop-id
8
Removed:
(contract-out
9
Removed:
;; SQL CRUD
10
Removed:
[create-crop-requirement! (->* (string?
11
Removed:
(listof nutrient-value-pair/c))
12
Removed:
((or/c #f crop?))
13
Removed:
crop-requirement?)]
14
Removed:
[get-crop-requirements (-> (listof crop-requirement?))]
15
Removed:
[get-crop-requirement (->* ()
16
Removed:
(#:id (or/c #f exact-nonnegative-integer?)
17
Removed:
#:profile (or/c #f string?))
18
Removed:
(or/c crop-requirement? #f))]
19
Removed:
[get-crop-requirement-values (-> crop-requirement? (listof nutrient-value-pair/c))]
20
Removed:
[get-crop-requirement-value (-> crop-requirement? nutrient? number?)]
21
Removed:
[get-latest-crop-requirement-value (-> nutrient? number?)]
22
Removed:
[delete-crop-requirement! (-> crop-requirement? void?)]
23
Removed:
;; Helpers
24
Removed:
[average-crop-requirement-nutrient-values (-> (listof (cons/c crop-requirement?
25
Removed:
(and/c real? (>=/c 0) (<=/c 100))))
26
Removed:
(listof nutrient-value-pair/c))]))
3
Added:
;; Model struct
4
Added:
(provide crop-requirement
5
Added:
crop-requirement?
6
Added:
crop-requirement-id
7
Added:
crop-requirement-profile
8
Added:
crop-requirement-crop-id
9
Added:
(rename-out [crop-requirement-nutrient-values crop-requirement-values])
10
Added:
(contract-out
11
Added:
;; SQL CRUD
12
Added:
[create-crop-requirement!
13
Added:
(->* (string? (listof nutrient-value-pair/c)) ((or/c #f crop?)) crop-requirement?)]
14
Added:
[get-crop-requirements (-> (listof crop-requirement?))]
15
Added:
[get-crop-requirement
16
Added:
(->* ()
17
Added:
(#:id (or/c #f exact-nonnegative-integer?) #:profile (or/c #f string?))
18
Added:
(or/c crop-requirement? #f))]
19
Added:
[get-crop-requirement-values (-> crop-requirement? (listof nutrient-value-pair/c))]
20
Added:
[get-crop-requirement-value (-> crop-requirement? nutrient? number?)]
21
Added:
[get-latest-crop-requirement-value (-> nutrient? number?)]
22
Added:
[delete-crop-requirement! (-> crop-requirement? void?)]
23
Added:
;; Helpers
24
Added:
[average-crop-requirement-nutrient-values
25
Added:
(-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100))))
26
Added:
(listof nutrient-value-pair/c))]))
27
27
28
28
(require racket/contract
29
29
db
@@ -41,31 +41,26 @@
41
41
(define (create-crop-requirement! profile nutrient-values [crop #f])
42
42
(or (get-crop-requirement #:profile profile)
43
43
(with-tx
44
Removed:
(query-exec (current-conn)
45
Removed:
(if crop
46
Removed:
(insert #:into crop_requirements
47
Removed:
#:set [crop_id ,(crop-id crop)] [profile ,profile])
48
Removed:
(insert #:into crop_requirements
49
Removed:
#:set [profile ,profile])))
50
Removed:
(define cr-id (crop-requirement-id (get-crop-requirement #:profile profile)))
51
Removed:
(query-exec (current-conn)
52
Removed:
(insert #:into nutrient_value_sets
53
Removed:
#:set [crop_requirement_id ,cr-id]))
54
Removed:
(define nvs-id (query-value (current-conn)
55
Removed:
(select id
56
Removed:
#:from nutrient_value_sets
57
Removed:
#:where (= crop_requirement_id ,cr-id))))
58
Removed:
(for ([nv nutrient-values])
59
Removed:
(match-define (cons n v) nv)
60
Removed:
(query-exec (current-conn)
61
Removed:
(insert #:into nutrient_values
62
Removed:
#:set
63
Removed:
[value_set_id ,nvs-id]
64
Removed:
[nutrient_id ,(nutrient-id n)]
65
Removed:
[value_ppm ,v])))
66
Removed:
(get-crop-requirement #:profile profile))))
44
Added:
(query-exec
45
Added:
(current-conn)
46
Added:
(if crop
47
Added:
(insert #:into crop_requirements #:set [crop_id ,(crop-id crop)] [profile ,profile])
48
Added:
(insert #:into crop_requirements #:set [profile ,profile])))
49
Added:
(define cr-id (crop-requirement-id (get-crop-requirement #:profile profile)))
50
Added:
(query-exec (current-conn)
51
Added:
(insert #:into nutrient_value_sets #:set [crop_requirement_id ,cr-id]))
52
Added:
(define nvs-id
53
Added:
(query-value (current-conn)
54
Added:
(select id #:from nutrient_value_sets #:where (= crop_requirement_id ,cr-id))))
55
Added:
(for ([nv nutrient-values])
56
Added:
(match-define (cons n v) nv)
57
Added:
(query-exec (current-conn)
58
Added:
(insert #:into nutrient_values
59
Added:
#:set [value_set_id ,nvs-id]
60
Added:
[nutrient_id ,(nutrient-id n)]
61
Added:
[value_ppm ,v])))
62
Added:
(get-crop-requirement #:profile profile))))
67
63
68
Removed:
69
64
;; READ
70
65
71
66
(define (get-crop-requirements)
@@ -103,13 +98,12 @@
103
98
(define (get-crop-requirement-values crop-requirement)
104
99
(for/list ([(nutrient-id name formula value_ppm)
105
100
(in-query (current-conn)
106
Removed:
(string-join
107
Removed:
'("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
108
Removed:
"FROM nutrient_values nv"
109
Removed:
"JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
110
Removed:
"JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id"
111
Removed:
"JOIN nutrients n ON n.id = nv.nutrient_id"
112
Removed:
"WHERE cr.id = $1"))
101
Added:
(string-join '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
102
Added:
"FROM nutrient_values nv"
103
Added:
"JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
104
Added:
"JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id"
105
Added:
"JOIN nutrients n ON n.id = nv.nutrient_id"
106
Added:
"WHERE cr.id = $1"))
113
107
(crop-requirement-id crop-requirement))])
114
108
(cons (nutrient nutrient-id name formula) value_ppm)))
115
109
@@ -139,28 +133,21 @@
139
133
140
134
;; UPDATE
141
135
142
Removed:
143
136
;; DELETE
144
137
145
138
(define (delete-crop-requirement! crop-requirement)
146
139
(define id (crop-requirement-id crop-requirement))
147
Removed:
(query-exec (current-conn)
148
Removed:
(delete #:from crop_requirements
149
Removed:
#:where (= id ,id))))
140
Added:
(query-exec (current-conn) (delete #:from crop_requirements #:where (= id ,id))))
150
141
151
Removed:
152
142
;; Helpers
153
143
154
144
(define (average-crop-requirement-nutrient-values mix)
155
145
(define average-values
156
146
(for/fold ([acc (hash)]) ([pair (in-list mix)])
157
Removed:
(define crop-requirement (car pair))
158
Removed:
(define percentage (/ (cdr pair) 100))
159
Removed:
(for/fold ([acc acc])
160
Removed:
([nv (in-list (get-crop-requirement-values crop-requirement))])
147
Added:
(match-define (cons crop-requirement percentage) pair)
148
Added:
(for/fold ([acc acc]) ([nv (in-list (get-crop-requirement-values crop-requirement))])
161
149
(match-define (cons n v) nv)
162
Removed:
(hash-update acc n
163
Removed:
(λ (old) (+ old (* v percentage)))
164
Removed:
(λ () (* v percentage))))))
150
Added:
(define nutrient-contribution (* v (/ percentage 100)))
151
Added:
(hash-update acc n (λ (old) (+ old nutrient-contribution)) (λ () nutrient-contribution)))))
165
152
(for/list ([(n v) (in-hash average-values)])
166
153
(cons n v)))
models/crop.rkt
@@ -1,22 +1,20 @@
1
1
#lang racket
2
2
3
Removed:
(provide
4
Removed:
;; Model struct
5
Removed:
crop
6
Removed:
crop?
7
Removed:
crop-id crop-name
8
Removed:
(contract-out
9
Removed:
;; SQL CRUD
10
Removed:
[create-crop! (-> string? crop?)]
11
Removed:
[get-crops (-> (listof crop?))]
12
Removed:
[get-crop (->* ()
13
Removed:
(#:id (or/c #f exact-nonnegative-integer?)
14
Removed:
#:name (or/c #f string?))
15
Removed:
(or/c crop? #f))]
16
Removed:
[update-crop! (->* (exact-nonnegative-integer?)
17
Removed:
(#:name (or/c #f string?))
18
Removed:
(or/c crop? #f))]
19
Removed:
[delete-crop! (-> exact-nonnegative-integer? void?)]))
3
Added:
;; Model struct
4
Added:
(provide crop
5
Added:
crop?
6
Added:
crop-id
7
Added:
crop-name
8
Added:
;; SQL CRUD
9
Added:
(contract-out [create-crop! (-> string? crop?)]
10
Added:
[get-crops (-> (listof crop?))]
11
Added:
[get-crop
12
Added:
(->* ()
13
Added:
(#:id (or/c #f exact-nonnegative-integer?) #:name (or/c #f string?))
14
Added:
(or/c crop? #f))]
15
Added:
[update-crop!
16
Added:
(->* (exact-nonnegative-integer?) (#:name (or/c #f string?)) (or/c crop? #f))]
17
Added:
[delete-crop! (-> exact-nonnegative-integer? void?)]))
20
18
21
19
(require racket/contract
22
20
db
@@ -25,67 +23,48 @@
25
23
26
24
(struct crop (id name) #:transparent)
27
25
28
Removed:
29
26
;; CREATE
30
27
31
28
(define (create-crop! name)
32
29
(or (get-crop #:name name)
33
30
(begin
34
Removed:
(query-exec (current-conn)
35
Removed:
(insert #:into crops
36
Removed:
#:set [canonical_name ,name]))
31
Added:
(query-exec (current-conn) (insert #:into crops #:set [canonical_name ,name]))
37
32
(get-crop #:name name))))
38
33
39
Removed:
40
34
;; READ
41
35
42
36
(define (get-crops)
43
Removed:
(for/list ([(id* name*)
44
Removed:
(in-query (current-conn)
45
Removed:
(select id canonical_name
46
Removed:
#:from crops
47
Removed:
#:order-by id #:asc))])
37
Added:
(for/list ([(id* name*) (in-query (current-conn)
38
Added:
(select id canonical_name #:from crops #:order-by id #:asc))])
48
39
(crop id* name*)))
49
40
50
Removed:
(define (get-crop #:id [id #f]
51
Removed:
#:name [name #f])
41
Added:
(define (get-crop #:id [id #f] #:name [name #f])
52
42
(define where
53
43
(cond
54
Removed:
[(and id name)
55
Removed:
(scalar-expr-qq (and (= id ,id)
56
Removed:
(= canonical_name ,name)))]
57
Removed:
[id
58
Removed:
(scalar-expr-qq (= id ,id))]
59
Removed:
[name
60
Removed:
(scalar-expr-qq (= canonical_name ,name))]))
61
Removed:
(define query (select id canonical_name
62
Removed:
#:from crops
63
Removed:
#:where (ScalarExpr:AST ,where)
64
Removed:
#:order-by id #:asc
65
Removed:
#:limit 1))
44
Added:
[(and id name) (scalar-expr-qq (and (= id ,id) (= canonical_name ,name)))]
45
Added:
[id (scalar-expr-qq (= id ,id))]
46
Added:
[name (scalar-expr-qq (= canonical_name ,name))]))
47
Added:
(define query
48
Added:
(select id
49
Added:
canonical_name
50
Added:
#:from crops
51
Added:
#:where (ScalarExpr:AST ,where)
52
Added:
#:order-by id
53
Added:
#:asc
54
Added:
#:limit 1))
66
55
(match (query-maybe-row (current-conn) query)
67
Removed:
[(vector id* name*)
68
Removed:
(crop id* name*)]
56
Added:
[(vector id* name*) (crop id* name*)]
69
57
[#f #f]))
70
58
71
Removed:
72
59
;; UPDATE
73
60
74
Removed:
(define (update-crop! id
75
Removed:
#:name [name #f])
61
Added:
(define (update-crop! id #:name [name #f])
76
62
(cond
77
Removed:
[name
78
Removed:
(query-exec (current-conn)
79
Removed:
(update crops
80
Removed:
#:set [canonical_name ,name]
81
Removed:
#:where (= id ,id)))]
63
Added:
[name (query-exec (current-conn) (update crops #:set [canonical_name ,name] #:where (= id ,id)))]
82
64
[else (void)])
83
Removed:
(or (get-crop #:id id)
84
Removed:
(error 'update-crop! "No crop with id ~a" id)))
65
Added:
(or (get-crop #:id id) (error 'update-crop! "No crop with id ~a" id)))
85
66
86
Removed:
87
67
;; DELETE
88
68
89
69
(define (delete-crop! id)
90
Removed:
(query-exec (current-conn)
91
Removed:
(delete #:from crops #:where (= id ,id))))
70
Added:
(query-exec (current-conn) (delete #:from crops #:where (= id ,id))))
models/fertilizer-product.rkt
@@ -1,29 +1,24 @@
1
1
#lang racket
2
2
3
Removed:
(provide
4
Removed:
;; Model struct
5
Removed:
fertilizer-product
6
Removed:
fertilizer-product?
7
Removed:
fertilizer-product-id
8
Removed:
(rename-out
9
Removed:
[fertilizer-product-canonical-name fertilizer-name]
10
Removed:
[fertilizer-product-nutrient-values fertilizer-product-values]
11
Removed:
[fertilizer-product-brand-name fertilizer-brand-name])
12
Removed:
(contract-out
13
Removed:
;; SQL CRUD
14
Removed:
[create-fertilizer-product! (->* (string?
15
Removed:
(listof nutrient-value-pair/c))
16
Removed:
(string?)
17
Removed:
fertilizer-product?)]
18
Removed:
[get-fertilizer-products (-> (listof fertilizer-product?))]
19
Removed:
[get-fertilizer-product (->* ()
20
Removed:
(#:id (or/c #f exact-nonnegative-integer?)
21
Removed:
#:canonical-name (or/c #f string?))
22
Removed:
(or/c fertilizer-product? #f))]
23
Removed:
[get-fertilizer-product-values (-> fertilizer-product?
24
Removed:
(listof nutrient-value-pair/c))]
25
Removed:
[get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
26
Removed:
[delete-fertilizer-product! (-> fertilizer-product? void?)]))
3
Added:
;; Model struct
4
Added:
(provide fertilizer-product
5
Added:
fertilizer-product?
6
Added:
fertilizer-product-id
7
Added:
(rename-out [fertilizer-product-canonical-name fertilizer-name]
8
Added:
[fertilizer-product-nutrient-values fertilizer-product-values]
9
Added:
[fertilizer-product-brand-name fertilizer-brand-name])
10
Added:
(contract-out
11
Added:
;; SQL CRUD
12
Added:
[create-fertilizer-product!
13
Added:
(->* (string? (listof nutrient-value-pair/c)) (string?) fertilizer-product?)]
14
Added:
[get-fertilizer-products (-> (listof fertilizer-product?))]
15
Added:
[get-fertilizer-product
16
Added:
(->* ()
17
Added:
(#:id (or/c #f exact-nonnegative-integer?) #:canonical-name (or/c #f string?))
18
Added:
(or/c fertilizer-product? #f))]
19
Added:
[get-fertilizer-product-values (-> fertilizer-product? (listof nutrient-value-pair/c))]
20
Added:
[get-fertilizer-product-value (-> fertilizer-product? nutrient? number?)]
21
Added:
[delete-fertilizer-product! (-> fertilizer-product? void?)]))
27
22
28
23
(require racket/contract
29
24
db
@@ -34,123 +29,112 @@
34
29
;; Instances of this struct are persisted in the fertilizer_products table.
35
30
(struct fertilizer-product (id canonical-name nutrient-values brand-name)
36
31
#:transparent
37
Removed:
#:guard
38
Removed:
(λ (id canonical-name nutrient-values brand-name _)
39
Removed:
(values id
40
Removed:
canonical-name
41
Removed:
nutrient-values
42
Removed:
(if (sql-null? brand-name) #f brand-name)))
32
Added:
#:guard (λ (id canonical-name nutrient-values brand-name _)
33
Added:
(values id canonical-name nutrient-values (if (sql-null? brand-name) #f brand-name)))
43
34
#:property prop:custom-write
44
35
(λ (v out _mode)
45
36
(fprintf out "Fertilizer #~a\n" (fertilizer-product-id v))
46
37
(if (fertilizer-product-brand-name v)
47
Removed:
(fprintf out "~a (~a)\n"
38
Added:
(fprintf out
39
Added:
"~a (~a)\n"
48
40
(fertilizer-product-canonical-name v)
49
41
(fertilizer-product-brand-name v))
50
Removed:
(fprintf out "~a\n"
51
Removed:
(fertilizer-product-canonical-name v)))
42
Added:
(fprintf out "~a\n" (fertilizer-product-canonical-name v)))
52
43
(for ([nv (in-list (fertilizer-product-nutrient-values v))])
53
44
(match-define (cons n v) nv)
54
Removed:
(fprintf out "~a ~a\n"
45
Added:
(fprintf out
46
Added:
"~a ~a\n"
55
47
(~a (nutrient-name n) #:min-width 14)
56
48
(~a v #:max-width 6 #:align 'right)))))
57
49
58
Removed:
59
50
;; CREATE
60
51
61
52
(define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f])
62
Removed:
(or (get-fertilizer-product #:canonical-name canonical-name)
63
Removed:
(with-tx
64
Removed:
(query-exec (current-conn)
65
Removed:
(cond
66
Removed:
[brand-name
67
Removed:
(insert #:into fertilizer_products
68
Removed:
#:set [canonical_name ,canonical-name] [brand_name ,brand-name])]
69
Removed:
[else
70
Removed:
(insert #:into fertilizer_products
71
Removed:
#:set [canonical_name ,canonical-name])]))
72
Removed:
(define fp-id (query-value (current-conn)
73
Removed:
(select id
74
Removed:
#:from fertilizer_products
75
Removed:
#:where (= canonical_name ,canonical-name))))
76
Removed:
(query-exec (current-conn)
77
Removed:
(insert #:into nutrient_value_sets
78
Removed:
#:set [fertilizer_product_id ,fp-id]))
79
Removed:
(define nvs-id (query-value (current-conn)
80
Removed:
(select id
81
Removed:
#:from nutrient_value_sets
82
Removed:
#:where (= fertilizer_product_id ,fp-id))))
83
Removed:
(for ([nv nutrient-values])
84
Removed:
(match-define (cons n v) nv)
85
Removed:
(query-exec (current-conn)
86
Removed:
(insert #:into nutrient_values
87
Removed:
#:set
88
Removed:
[value_set_id ,nvs-id]
89
Removed:
[nutrient_id ,(nutrient-id n)]
90
Removed:
[value_ppm ,v])))
91
Removed:
(get-fertilizer-product #:canonical-name canonical-name))))
53
Added:
(or
54
Added:
(get-fertilizer-product #:canonical-name canonical-name)
55
Added:
(with-tx
56
Added:
(query-exec (current-conn)
57
Added:
(cond
58
Added:
[brand-name
59
Added:
(insert #:into fertilizer_products
60
Added:
#:set [canonical_name ,canonical-name]
61
Added:
[brand_name ,brand-name])]
62
Added:
[else (insert #:into fertilizer_products #:set [canonical_name ,canonical-name])]))
63
Added:
(define fp-id
64
Added:
(query-value (current-conn)
65
Added:
(select id #:from fertilizer_products #:where (= canonical_name ,canonical-name))))
66
Added:
(query-exec (current-conn)
67
Added:
(insert #:into nutrient_value_sets #:set [fertilizer_product_id ,fp-id]))
68
Added:
(define nvs-id
69
Added:
(query-value (current-conn)
70
Added:
(select id #:from nutrient_value_sets #:where (= fertilizer_product_id ,fp-id))))
71
Added:
(for ([nv nutrient-values])
72
Added:
(match-define (cons n v) nv)
73
Added:
(query-exec (current-conn)
74
Added:
(insert #:into nutrient_values
75
Added:
#:set [value_set_id ,nvs-id]
76
Added:
[nutrient_id ,(nutrient-id n)]
77
Added:
[value_ppm ,v])))
78
Added:
(get-fertilizer-product #:canonical-name canonical-name))))
92
79
93
Removed:
94
80
;; READ
95
81
96
82
(struct acc (canonical-name brand-name pairs) #:transparent)
97
83
98
84
(define joined
99
Removed:
(table-expr-qq
100
Removed:
(inner-join
101
Removed:
(inner-join
102
Removed:
(inner-join
103
Removed:
(as fertilizer_products fp)
104
Removed:
(as nutrient_value_sets nvs)
105
Removed:
#:on (= nvs.fertilizer_product_id fp.id))
106
Removed:
(as nutrient_values nv)
107
Removed:
#:on (= nv.value_set_id nvs.id))
108
Removed:
(as nutrients n)
109
Removed:
#:on (= n.id nv.nutrient_id))))
85
Added:
(table-expr-qq (inner-join (inner-join (inner-join (as fertilizer_products fp)
86
Added:
(as nutrient_value_sets nvs)
87
Added:
#:on (= nvs.fertilizer_product_id fp.id))
88
Added:
(as nutrient_values nv)
89
Added:
#:on (= nv.value_set_id nvs.id))
90
Added:
(as nutrients n)
91
Added:
#:on (= n.id nv.nutrient_id))))
110
92
111
93
(define (get-fertilizer-products)
112
Removed:
(define query (select fp.id fp.canonical_name fp.brand_name
113
Removed:
n.id n.canonical_name n.formula
114
Removed:
nv.value_ppm
115
Removed:
#:from (TableExpr:AST ,joined)
116
Removed:
#:order-by fp.canonical_name #:asc))
94
Added:
(define query
95
Added:
(select fp.id
96
Added:
fp.canonical_name
97
Added:
fp.brand_name
98
Added:
n.id
99
Added:
n.canonical_name
100
Added:
n.formula
101
Added:
nv.value_ppm
102
Added:
#:from (TableExpr:AST ,joined)
103
Added:
#:order-by fp.canonical_name
104
Added:
#:asc))
117
105
(define rows (query-rows (current-conn) query))
118
106
(define by-id
119
107
(for/fold ([h (hash)]) ([row (in-list rows)])
120
108
(match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
121
109
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
122
Removed:
(hash-update h fp-id
110
Added:
(hash-update h
111
Added:
fp-id
123
112
(λ (old-acc)
124
113
(acc (acc-canonical-name old-acc)
125
114
(acc-brand-name old-acc)
126
115
(cons nv-pair (acc-pairs old-acc))))
127
Removed:
(λ ()
128
Removed:
(acc canonical-name
129
Removed:
brand-name
130
Removed:
(list nv-pair))))))
116
Added:
(λ () (acc canonical-name brand-name (list nv-pair))))))
131
117
(for/list ([(id a) (in-hash by-id)])
132
Removed:
(fertilizer-product id
133
Removed:
(acc-canonical-name a)
134
Removed:
(reverse (acc-pairs a))
135
Removed:
(acc-brand-name a))))
118
Added:
(fertilizer-product id (acc-canonical-name a) (reverse (acc-pairs a)) (acc-brand-name a))))
136
119
137
Removed:
(define (get-fertilizer-product #:id [fp-id #f]
138
Removed:
#:canonical-name [canonical-name #f])
120
Added:
(define (get-fertilizer-product #:id [fp-id #f] #:canonical-name [canonical-name #f])
139
121
(define where
140
122
(cond
141
123
[(and fp-id canonical-name)
142
Removed:
(scalar-expr-qq (and (= fp.id ,fp-id)
143
Removed:
(= fp.canonical_name ,canonical-name)))]
144
Removed:
[fp-id
145
Removed:
(scalar-expr-qq (= fp.id ,fp-id))]
146
Removed:
[canonical-name
147
Removed:
(scalar-expr-qq (= fp.canonical_name ,canonical-name))]))
148
Removed:
(define query (select fp.id fp.canonical_name fp.brand_name
149
Removed:
n.id n.canonical_name n.formula
150
Removed:
nv.value_ppm
151
Removed:
#:from (TableExpr:AST ,joined)
152
Removed:
#:where (ScalarExpr:AST ,where)
153
Removed:
#:limit 1))
124
Added:
(scalar-expr-qq (and (= fp.id ,fp-id) (= fp.canonical_name ,canonical-name)))]
125
Added:
[fp-id (scalar-expr-qq (= fp.id ,fp-id))]
126
Added:
[canonical-name (scalar-expr-qq (= fp.canonical_name ,canonical-name))]))
127
Added:
(define query
128
Added:
(select fp.id
129
Added:
fp.canonical_name
130
Added:
fp.brand_name
131
Added:
n.id
132
Added:
n.canonical_name
133
Added:
n.formula
134
Added:
nv.value_ppm
135
Added:
#:from (TableExpr:AST ,joined)
136
Added:
#:where (ScalarExpr:AST ,where)
137
Added:
#:limit 1))
154
138
(define rows (query-rows (current-conn) query))
155
139
(cond
156
140
[(null? rows) #f]
@@ -160,24 +144,22 @@
160
144
(define A #f)
161
145
(for ([row (in-list rows)])
162
146
(match-define (vector fp-id canonical-name brand-name n-id n-name n-formula value-ppm) row)
163
Removed:
(unless the-id (set! the-id fp-id))
147
Added:
(unless the-id
148
Added:
(set! the-id fp-id))
164
149
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
165
Removed:
(set! A (if A
166
Removed:
(acc (acc-canonical-name A)
167
Removed:
(acc-brand-name A)
168
Removed:
(cons nv-pair (acc-pairs A)))
169
Removed:
(acc canonical-name
170
Removed:
brand-name
171
Removed:
(list nv-pair)))))
172
Removed:
(fertilizer-product the-id
173
Removed:
(acc-canonical-name A)
174
Removed:
(reverse (acc-pairs A))
175
Removed:
(acc-brand-name A))]))
150
Added:
(set! A
151
Added:
(if A
152
Added:
(acc (acc-canonical-name A) (acc-brand-name A) (cons nv-pair (acc-pairs A)))
153
Added:
(acc canonical-name brand-name (list nv-pair)))))
154
Added:
(fertilizer-product the-id (acc-canonical-name A) (reverse (acc-pairs A)) (acc-brand-name A))]))
176
155
177
156
(define (get-fertilizer-product-values fertilizer-product)
178
157
(for/list ([(nutrient-id name formula value_ppm)
179
158
(in-query (current-conn)
180
Removed:
(select n.id n.canonical_name n.formula nv.value_ppm
159
Added:
(select n.id
160
Added:
n.canonical_name
161
Added:
n.formula
162
Added:
nv.value_ppm
181
163
#:from (TableExpr:AST ,joined)
182
164
#:where (= nm.id ,(fertilizer-product-id fertilizer-product))))])
183
165
(cons (nutrient nutrient-id name formula) value_ppm)))
@@ -189,14 +171,10 @@
189
171
#:where (and (= nm.id ,(fertilizer-product-id fertilizer-product))
190
172
(= nv.nutrient_id ,(nutrient-id nutrient))))))
191
173
192
Removed:
193
174
;; UPDATE
194
175
195
Removed:
196
176
;; DELETE
197
177
198
178
(define (delete-fertilizer-product! fertilizer-product)
199
179
(define id (fertilizer-product-id fertilizer-product))
200
Removed:
(query-exec (current-conn)
201
Removed:
(delete #:from fertilizer_products
202
Removed:
#:where (= id ,id))))
180
Added:
(query-exec (current-conn) (delete #:from fertilizer_products #:where (= id ,id))))
models/nutrient-measurement.rkt
@@ -35,63 +35,54 @@
35
35
#:transparent
36
36
#:property prop:custom-write
37
37
(λ (v out _)
38
Removed:
(fprintf out "Measurement #~a on ~a\n"
38
Added:
(fprintf out
39
Added:
"Measurement #~a on ~a\n"
39
40
(nutrient-measurement-id v)
40
41
(nutrient-measurement-measured-on v))
41
42
(for ([nv (nutrient-measurement-nutrient-values v)])
42
43
(match-define (cons n v) nv)
43
Removed:
(fprintf out "~a ~a\n"
44
Added:
(fprintf out
45
Added:
"~a ~a\n"
44
46
(~a (nutrient-name n) #:min-width 14)
45
47
(~a v #:max-width 6 #:align 'right)))))
46
48
47
Removed:
48
49
;; CREATE
49
50
50
51
(define (create-nutrient-measurement! measured-on nutrient-values)
51
Removed:
(or (get-nutrient-measurement #:measured-on measured-on)
52
Removed:
(with-tx
53
Removed:
(query-exec (current-conn)
54
Removed:
(insert #:into nutrient_measurements
55
Removed:
#:set [measured_on ,measured-on]))
56
Removed:
(define nm-id (query-value (current-conn)
57
Removed:
(select id
58
Removed:
#:from nutrient_measurements
59
Removed:
#:where (= measured_on ,measured-on))))
60
Removed:
(query-exec (current-conn)
61
Removed:
(insert #:into nutrient_value_sets
62
Removed:
#:set [nutrient_measurement_id ,nm-id]))
63
Removed:
(define nvs-id (query-value (current-conn)
64
Removed:
(select id
65
Removed:
#:from nutrient_value_sets
66
Removed:
#:where (= nutrient_measurement_id ,nm-id))))
67
Removed:
(for ([nv nutrient-values])
68
Removed:
(match-define (cons n v) nv)
69
Removed:
(query-exec (current-conn)
70
Removed:
(insert #:into nutrient_values
71
Removed:
#:set
72
Removed:
[value_set_id ,nvs-id]
73
Removed:
[nutrient_id ,(nutrient-id n)]
74
Removed:
[value_ppm ,v])))
75
Removed:
(get-nutrient-measurement #:measured-on measured-on))))
52
Added:
(or
53
Added:
(get-nutrient-measurement #:measured-on measured-on)
54
Added:
(with-tx
55
Added:
(query-exec (current-conn) (insert #:into nutrient_measurements #:set [measured_on ,measured-on]))
56
Added:
(define nm-id
57
Added:
(query-value (current-conn)
58
Added:
(select id #:from nutrient_measurements #:where (= measured_on ,measured-on))))
59
Added:
(query-exec (current-conn)
60
Added:
(insert #:into nutrient_value_sets #:set [nutrient_measurement_id ,nm-id]))
61
Added:
(define nvs-id
62
Added:
(query-value (current-conn)
63
Added:
(select id #:from nutrient_value_sets #:where (= nutrient_measurement_id ,nm-id))))
64
Added:
(for ([nv nutrient-values])
65
Added:
(match-define (cons n v) nv)
66
Added:
(query-exec (current-conn)
67
Added:
(insert #:into nutrient_values
68
Added:
#:set [value_set_id ,nvs-id]
69
Added:
[nutrient_id ,(nutrient-id n)]
70
Added:
[value_ppm ,v])))
71
Added:
(get-nutrient-measurement #:measured-on measured-on))))
76
72
77
Removed:
78
73
;; READ
79
74
80
75
(struct acc (measured-on pairs) #:transparent)
81
Removed:
82
76
(define joined
83
Removed:
(table-expr-qq
84
Removed:
(inner-join
85
Removed:
(inner-join
86
Removed:
(inner-join
87
Removed:
(as nutrient_measurements nm)
88
Removed:
(as nutrient_value_sets nvs)
89
Removed:
#:on (= nvs.nutrient_measurement_id nm.id))
90
Removed:
(as nutrient_values nv)
91
Removed:
#:on (= nv.value_set_id nvs.id))
92
Removed:
(as nutrients n)
93
Removed:
#:on (= n.id nv.nutrient_id))))
77
Added:
(table-expr-qq (inner-join (inner-join (inner-join (as nutrient_measurements nm)
78
Added:
(as nutrient_value_sets nvs)
79
Added:
#:on (= nvs.nutrient_measurement_id nm.id))
80
Added:
(as nutrient_values nv)
81
Added:
#:on (= nv.value_set_id nvs.id))
82
Added:
(as nutrients n)
83
Added:
#:on (= n.id nv.nutrient_id))))
94
84
85
Added:
95
86
(define (get-nutrient-measurements)
96
87
(define query (select nm.id nm.measured_on
97
88
n.id n.canonical_name n.formula
@@ -155,7 +146,10 @@
155
146
(define (get-nutrient-measurement-values nutrient-measurement)
156
147
(for/list ([(nutrient-id name formula value_ppm)
157
148
(in-query (current-conn)
158
Removed:
(select n.id n.canonical_name n.formula nv.value_ppm
149
Added:
(select n.id
150
Added:
n.canonical_name
151
Added:
n.formula
152
Added:
nv.value_ppm
159
153
#:from (TableExpr:AST ,joined)
160
154
#:where (= nm.id ,(nutrient-measurement-id nutrient-measurement))))])
161
155
(cons (nutrient nutrient-id name formula) value_ppm)))
@@ -172,17 +166,15 @@
172
166
(select value_ppm
173
167
#:from (TableExpr:AST ,joined)
174
168
#:where (= nv.nutrient_id ,(nutrient-id nutrient))
175
Removed:
#:order-by nm.measured_on #:desc
169
Added:
#:order-by nm.measured_on
170
Added:
#:desc
176
171
#:limit 1)))
177
172
178
173
179
174
;; UPDATE
180
175
181
Removed:
182
176
;; DELETE
183
177
184
178
(define (delete-nutrient-measurement! nutrient-measurement)
185
179
(define id (nutrient-measurement-id nutrient-measurement))
186
Removed:
(query-exec (current-conn)
187
Removed:
(delete #:from nutrient_measurements
188
Removed:
#:where (= id ,id))))
180
Added:
(query-exec (current-conn) (delete #:from nutrient_measurements #:where (= id ,id))))
models/nutrient-target.rkt
@@ -34,102 +34,89 @@
34
34
#:transparent
35
35
#:property prop:custom-write
36
36
(λ (v out _)
37
Removed:
(fprintf out "Target #~a on ~a\n"
38
Removed:
(nutrient-target-id v)
39
Removed:
(nutrient-target-effective-on v))
37
Added:
(fprintf out "Target #~a on ~a\n" (nutrient-target-id v) (nutrient-target-effective-on v))
40
38
(for ([nv (nutrient-target-nutrient-values v)])
41
39
(match-define (cons n v) nv)
42
Removed:
(fprintf out "~a ~a\n"
40
Added:
(fprintf out
41
Added:
"~a ~a\n"
43
42
(~a (nutrient-name n) #:min-width 14)
44
43
(~a v #:max-width 6 #:align 'right)))))
45
44
46
Removed:
47
45
;; CREATE
48
46
49
47
(define (create-nutrient-target! effective-on nutrient-values)
50
48
(or (get-nutrient-target #:effective-on effective-on)
51
49
(with-tx
52
Removed:
(query-exec (current-conn)
53
Removed:
(insert #:into nutrient_targets
54
Removed:
#:set [effective_on ,effective-on]))
55
Removed:
(define nt-id (query-value (current-conn)
56
Removed:
(select id
57
Removed:
#:from nutrient_targets
58
Removed:
#:where (= effective_on ,effective-on))))
59
Removed:
(query-exec (current-conn)
60
Removed:
(insert #:into nutrient_value_sets
61
Removed:
#:set [nutrient_target_id ,nt-id]))
62
Removed:
(define nvs-id (query-value (current-conn)
63
Removed:
(select id
64
Removed:
#:from nutrient_value_sets
65
Removed:
#:where (= nutrient_target_id ,nt-id))))
66
Removed:
(for ([nv nutrient-values])
67
Removed:
(match-define (cons n v) nv)
68
Removed:
(query-exec (current-conn)
69
Removed:
(insert #:into nutrient_values
70
Removed:
#:set
71
Removed:
[value_set_id ,nvs-id]
72
Removed:
[nutrient_id ,(nutrient-id n)]
73
Removed:
[value_ppm ,v])))
74
Removed:
(get-nutrient-target #:effective-on effective-on))))
50
Added:
(query-exec (current-conn) (insert #:into nutrient_targets #:set [effective_on ,effective-on]))
51
Added:
(define nt-id
52
Added:
(query-value (current-conn)
53
Added:
(select id #:from nutrient_targets #:where (= effective_on ,effective-on))))
54
Added:
(query-exec (current-conn)
55
Added:
(insert #:into nutrient_value_sets #:set [nutrient_target_id ,nt-id]))
56
Added:
(define nvs-id
57
Added:
(query-value (current-conn)
58
Added:
(select id #:from nutrient_value_sets #:where (= nutrient_target_id ,nt-id))))
59
Added:
(for ([nv nutrient-values])
60
Added:
(match-define (cons n v) nv)
61
Added:
(query-exec (current-conn)
62
Added:
(insert #:into nutrient_values
63
Added:
#:set [value_set_id ,nvs-id]
64
Added:
[nutrient_id ,(nutrient-id n)]
65
Added:
[value_ppm ,v])))
66
Added:
(get-nutrient-target #:effective-on effective-on))))
75
67
76
Removed:
77
68
;; READ
78
69
79
70
(struct acc (effective-on pairs) #:transparent)
80
71
81
72
(define joined
82
Removed:
(table-expr-qq
83
Removed:
(inner-join
84
Removed:
(inner-join
85
Removed:
(inner-join
86
Removed:
(as nutrient_targets nt)
87
Removed:
(as nutrient_value_sets nvs)
88
Removed:
#:on (= nvs.nutrient_target_id nt.id))
89
Removed:
(as nutrient_values nv)
90
Removed:
#:on (= nv.value_set_id nvs.id))
91
Removed:
(as nutrients n)
92
Removed:
#:on (= n.id nv.nutrient_id))))
73
Added:
(table-expr-qq (inner-join (inner-join (inner-join (as nutrient_targets nt)
74
Added:
(as nutrient_value_sets nvs)
75
Added:
#:on (= nvs.nutrient_target_id nt.id))
76
Added:
(as nutrient_values nv)
77
Added:
#:on (= nv.value_set_id nvs.id))
78
Added:
(as nutrients n)
79
Added:
#:on (= n.id nv.nutrient_id))))
93
80
94
81
(define (get-nutrient-targets)
95
Removed:
(define query (select nt.id nt.effective_on
96
Removed:
n.id n.canonical_name n.formula
97
Removed:
nv.value_ppm
98
Removed:
#:from (TableExpr:AST ,joined)
99
Removed:
#:order-by nt.effective_on #:desc))
82
Added:
(define query
83
Added:
(select nt.id
84
Added:
nt.effective_on
85
Added:
n.id
86
Added:
n.canonical_name
87
Added:
n.formula
88
Added:
nv.value_ppm
89
Added:
#:from (TableExpr:AST ,joined)
90
Added:
#:order-by nt.effective_on
91
Added:
#:desc))
100
92
(define rows (query-rows (current-conn) query))
101
93
(define by-id
102
94
(for/fold ([h (hash)]) ([row (in-list rows)])
103
95
(match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row)
104
96
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
105
Removed:
(hash-update h nt-id
106
Removed:
(λ (old-acc)
107
Removed:
(acc (acc-effective-on old-acc)
108
Removed:
(cons nv-pair (acc-pairs old-acc))))
109
Removed:
(λ ()
110
Removed:
(acc effective-on
111
Removed:
(list nv-pair))))))
97
Added:
(hash-update h
98
Added:
nt-id
99
Added:
(λ (old-acc) (acc (acc-effective-on old-acc) (cons nv-pair (acc-pairs old-acc))))
100
Added:
(λ () (acc effective-on (list nv-pair))))))
112
101
(for/list ([(id a) (in-hash by-id)])
113
Removed:
(nutrient-target id
114
Removed:
(acc-effective-on a)
115
Removed:
(reverse (acc-pairs a)))))
102
Added:
(nutrient-target id (acc-effective-on a) (reverse (acc-pairs a)))))
116
103
117
Removed:
(define (get-nutrient-target #:id [nt-id #f]
118
Removed:
#:effective-on [effective-on #f])
104
Added:
(define (get-nutrient-target #:id [nt-id #f] #:effective-on [effective-on #f])
119
105
(define where
120
106
(cond
121
107
[(and nt-id effective-on)
122
Removed:
(scalar-expr-qq (and (= nt.id ,nt-id)
123
Removed:
(= nt.effective_on ,effective-on)))]
124
Removed:
[nt-id
125
Removed:
(scalar-expr-qq (= nt.id ,nt-id))]
126
Removed:
[effective-on
127
Removed:
(scalar-expr-qq (= nt.effective_on ,effective-on))]))
128
Removed:
(define query (select nt.id nt.effective_on
129
Removed:
n.id n.canonical_name n.formula
130
Removed:
nv.value_ppm
131
Removed:
#:from (TableExpr:AST ,joined)
132
Removed:
#:where (ScalarExpr:AST ,where)))
108
Added:
(scalar-expr-qq (and (= nt.id ,nt-id) (= nt.effective_on ,effective-on)))]
109
Added:
[nt-id (scalar-expr-qq (= nt.id ,nt-id))]
110
Added:
[effective-on (scalar-expr-qq (= nt.effective_on ,effective-on))]))
111
Added:
(define query
112
Added:
(select nt.id
113
Added:
nt.effective_on
114
Added:
n.id
115
Added:
n.canonical_name
116
Added:
n.formula
117
Added:
nv.value_ppm
118
Added:
#:from (TableExpr:AST ,joined)
119
Added:
#:where (ScalarExpr:AST ,where)))
133
120
(define rows (query-rows (current-conn) query))
134
121
(cond
135
122
[(null? rows) #f]
@@ -139,21 +126,22 @@
139
126
(define A #f)
140
127
(for ([row (in-list rows)])
141
128
(match-define (vector nt-id effective-on n-id n-name n-formula value-ppm) row)
142
Removed:
(unless the-id (set! the-id nt-id))
129
Added:
(unless the-id
130
Added:
(set! the-id nt-id))
143
131
(define nv-pair (cons (nutrient n-id n-name n-formula) value-ppm))
144
Removed:
(set! A (if A
145
Removed:
(acc (acc-effective-on A)
146
Removed:
(cons nv-pair (acc-pairs A)))
147
Removed:
(acc effective-on (list nv-pair)))))
148
Removed:
(and A
149
Removed:
(nutrient-target the-id
150
Removed:
(acc-effective-on A)
151
Removed:
(reverse (acc-pairs A))))]))
132
Added:
(set! A
133
Added:
(if A
134
Added:
(acc (acc-effective-on A) (cons nv-pair (acc-pairs A)))
135
Added:
(acc effective-on (list nv-pair)))))
136
Added:
(and A (nutrient-target the-id (acc-effective-on A) (reverse (acc-pairs A))))]))
152
137
153
138
(define (get-nutrient-target-values nutrient-target)
154
139
(for/list ([(nutrient-id name formula value_ppm)
155
140
(in-query (current-conn)
156
Removed:
(select n.id n.canonical_name n.formula nv.value_ppm
141
Added:
(select n.id
142
Added:
n.canonical_name
143
Added:
n.formula
144
Added:
nv.value_ppm
157
145
#:from (TableExpr:AST ,joined)
158
146
#:where (= nm.id ,(nutrient-target-id nutrient-target))))])
159
147
(cons (nutrient nutrient-id name formula) value_ppm)))
@@ -170,17 +158,15 @@
170
158
(select value_ppm
171
159
#:from (TableExpr:AST ,joined)
172
160
#:where (= nv.nutrient_id ,(nutrient-id nutrient))
173
Removed:
#:order-by nt.effective_on #:desc
161
Added:
#:order-by nt.effective_on
162
Added:
#:desc
174
163
#:limit 1)))
175
164
176
165
177
166
;; UPDATE
178
167
179
Removed:
180
168
;; DELETE
181
169
182
170
(define (delete-nutrient-target! nutrient-target)
183
171
(define id (nutrient-target-id nutrient-target))
184
Removed:
(query-exec (current-conn)
185
Removed:
(delete #:from nutrient_targets
186
Removed:
#:where (= id ,id))))
172
Added:
(query-exec (current-conn) (delete #:from nutrient_targets #:where (= id ,id))))
models/nutrient.rkt
@@ -1,26 +1,27 @@
1
1
#lang racket
2
2
3
Removed:
(provide
4
Removed:
;; Model struct
5
Removed:
nutrient
6
Removed:
nutrient?
7
Removed:
nutrient-id nutrient-name nutrient-formula
8
Removed:
;; Contracts
9
Removed:
nutrient-value-pair/c
10
Removed:
(contract-out
11
Removed:
;; SQL CRUD
12
Removed:
[create-nutrient! (-> string? string? nutrient?)]
13
Removed:
[get-nutrients (-> (listof nutrient?))]
14
Removed:
[get-nutrient (->* ()
15
Removed:
(#:id (or/c #f exact-nonnegative-integer?)
16
Removed:
#:name (or/c #f string?)
17
Removed:
#:formula (or/c #f string?))
18
Removed:
(or/c nutrient? #f))]
19
Removed:
[update-nutrient! (->* (nutrient?)
20
Removed:
(#:name (or/c #f string?)
21
Removed:
#:formula (or/c #f string?))
22
Removed:
(or/c nutrient? #f))]
23
Removed:
[delete-nutrient! (-> nutrient? void?)]))
3
Added:
;; Model struct
4
Added:
(provide nutrient
5
Added:
nutrient?
6
Added:
nutrient-id
7
Added:
nutrient-name
8
Added:
nutrient-formula
9
Added:
;; Contracts
10
Added:
nutrient-value-pair/c
11
Added:
;; SQL CRUD
12
Added:
(contract-out [create-nutrient! (-> string? string? nutrient?)]
13
Added:
[get-nutrients (-> (listof nutrient?))]
14
Added:
[get-nutrient
15
Added:
(->* ()
16
Added:
(#:id (or/c #f exact-nonnegative-integer?)
17
Added:
#:name (or/c #f string?)
18
Added:
#:formula (or/c #f string?))
19
Added:
(or/c nutrient? #f))]
20
Added:
[update-nutrient!
21
Added:
(->* (nutrient?)
22
Added:
(#:name (or/c #f string?) #:formula (or/c #f string?))
23
Added:
(or/c nutrient? #f))]
24
Added:
[delete-nutrient! (-> nutrient? void?)]))
24
25
25
26
(require racket/contract
26
27
db
@@ -30,39 +31,28 @@
30
31
(struct nutrient (id name formula)
31
32
#:transparent
32
33
#:property prop:custom-write
33
Removed:
(λ (v out _)
34
Removed:
(fprintf out "#<~a ~a>"
35
Removed:
(nutrient-id v)
36
Removed:
(nutrient-name v))))
34
Added:
(λ (v out _) (fprintf out "#<~a ~a>" (nutrient-id v) (nutrient-name v))))
37
35
38
Removed:
(define nutrient-value-pair/c
39
Removed:
(cons/c nutrient? (and/c real? (>=/c 0))))
36
Added:
(define nutrient-value-pair/c (cons/c nutrient? (and/c real? (>=/c 0))))
40
37
41
Removed:
42
38
;; CREATE
43
39
44
40
(define (create-nutrient! name formula)
45
41
(or (get-nutrient #:name name #:formula formula)
46
42
(begin
47
43
(query-exec (current-conn)
48
Removed:
(insert #:into nutrients
49
Removed:
#:set [canonical_name ,name] [formula ,formula]))
44
Added:
(insert #:into nutrients #:set [canonical_name ,name] [formula ,formula]))
50
45
(get-nutrient #:name name))))
51
46
52
Removed:
53
47
;; READ
54
48
55
49
(define (get-nutrients)
56
50
(for/list ([(id* name* formula*)
57
51
(in-query (current-conn)
58
Removed:
(select id canonical_name formula
59
Removed:
#:from nutrients
60
Removed:
#:order-by id #:asc))])
52
Added:
(select id canonical_name formula #:from nutrients #:order-by id #:asc))])
61
53
(nutrient id* name* formula*)))
62
54
63
Removed:
(define (get-nutrient #:id [id #f]
64
Removed:
#:name [name #f]
65
Removed:
#:formula [formula #f])
55
Added:
(define (get-nutrient #:id [id #f] #:name [name #f] #:formula [formula #f])
66
56
(define (where-expr)
67
57
(define clauses
68
58
(filter values
@@ -73,47 +63,30 @@
73
63
[(null? clauses) ""]
74
64
[else (format "WHERE ~a" (string-join clauses " AND "))]))
75
65
(match (query-maybe-row (current-conn)
76
Removed:
(string-join
77
Removed:
`("SELECT id, canonical_name, formula"
78
Removed:
"FROM nutrients"
79
Removed:
,(where-expr)
80
Removed:
"ORDER BY id ASC"
81
Removed:
"LIMIT 1")))
82
Removed:
[(vector id* name* formula*)
83
Removed:
(nutrient id* name* formula*)]
66
Added:
(string-join `("SELECT id, canonical_name, formula" "FROM nutrients"
67
Added:
,(where-expr)
68
Added:
"ORDER BY id ASC"
69
Added:
"LIMIT 1")))
70
Added:
[(vector id* name* formula*) (nutrient id* name* formula*)]
84
71
[#f #f]))
85
72
86
Removed:
87
73
;; UPDATE
88
74
89
Removed:
(define (update-nutrient! nutrient
90
Removed:
#:name [name #f]
91
Removed:
#:formula [formula #f])
92
Removed:
(define id(nutrient-id nutrient))
75
Added:
(define (update-nutrient! nutrient #:name [name #f] #:formula [formula #f])
76
Added:
(define id (nutrient-id nutrient))
93
77
(cond
94
78
[(and name formula)
95
Removed:
(query-exec (current-conn)
96
Removed:
(update nutrients
97
Removed:
#:set [canonical_name ,name] [formula ,formula]
98
Removed:
#:where (= id ,id)))]
79
Added:
(query-exec
80
Added:
(current-conn)
81
Added:
(update nutrients #:set [canonical_name ,name] [formula ,formula] #:where (= id ,id)))]
99
82
[name
100
Removed:
(query-exec (current-conn)
101
Removed:
(update nutrients
102
Removed:
#:set [canonical_name ,name]
103
Removed:
#:where (= id ,id)))]
83
Added:
(query-exec (current-conn) (update nutrients #:set [canonical_name ,name] #:where (= id ,id)))]
104
84
[formula
105
Removed:
(query-exec (current-conn)
106
Removed:
(update nutrients
107
Removed:
#:set [formula ,formula]
108
Removed:
#:where (= id ,id)))]
85
Added:
(query-exec (current-conn) (update nutrients #:set [formula ,formula] #:where (= id ,id)))]
109
86
[else (void)])
110
Removed:
(or (get-nutrient #:id id)
111
Removed:
(error 'update-nutrient! "No nutrient with id ~a" id)))
87
Added:
(or (get-nutrient #:id id) (error 'update-nutrient! "No nutrient with id ~a" id)))
112
88
113
Removed:
114
89
;; DELETE
115
90
116
91
(define (delete-nutrient! nutrient)
117
Removed:
(query-exec (current-conn)
118
Removed:
(delete #:from nutrients
119
Removed:
#:where (= id ,(nutrient-id nutrient)))))
92
Added:
(query-exec (current-conn) (delete #:from nutrients #:where (= id ,(nutrient-id nutrient)))))
models/user.rkt
@@ -1,16 +1,13 @@
1
1
#lang racket
2
2
3
Removed:
(provide
4
Removed:
;; Model struct
5
Removed:
user
6
Removed:
user?
7
Removed:
user-id
8
Removed:
user-name
9
Removed:
user-role
10
Removed:
(contract-out
11
Removed:
;; SQL CRUD
12
Removed:
[get-current-user (-> (or/c user? #f))]
13
Removed:
#; [delete-user! (-> user? void?)]))
3
Added:
;; Model struct
4
Added:
(provide user
5
Added:
user?
6
Added:
user-id
7
Added:
user-name
8
Added:
user-role
9
Added:
;; SQL CRUD
10
Added:
(contract-out [get-current-user (-> (or/c user? #f))] #;[delete-user! (-> user? void?)]))
14
11
15
12
(require racket/contract
16
13
db
@@ -21,10 +18,7 @@
21
18
22
19
(define (get-current-user)
23
20
(define current-user-id "foobar")
24
Removed:
(define query (select id name role_id
25
Removed:
#:from users
26
Removed:
#:where (= id ,current-user-id)
27
Removed:
#:limit 1))
21
Added:
(define query (select id name role_id #:from users #:where (= id ,current-user-id) #:limit 1))
28
22
(define row (query-maybe-row (current-conn) query))
29
23
(cond
30
24
[(false? row) #f]
tests/models/nutrient-measurement.rkt
@@ -11,59 +11,56 @@
11
11
(define measurement-date "2025-09-01")
12
12
13
13
(run-tests
14
Removed:
(test-suite
15
Removed:
"Nutrient measurement model"
16
Removed:
#:before (λ ()
17
Removed:
(connect! #:path 'memory)
18
Removed:
;; (connect! #:path "test.sqlite3")
19
Removed:
(migrate-all!)
20
Removed:
(create-nutrient! "Nitrogen" "N")
21
Removed:
(create-nutrient! "Phosphorus" "P")
22
Removed:
(create-nutrient! "Potassium" "K"))
23
Removed:
#:after (λ ()
24
Removed:
(disconnect!))
14
Added:
(test-suite "Nutrient measurement model"
15
Added:
#:before (λ ()
16
Added:
(connect! #:path 'memory)
17
Added:
;; (connect! #:path "test.sqlite3")
18
Added:
(migrate-all!)
19
Added:
(create-nutrient! "Nitrogen" "N")
20
Added:
(create-nutrient! "Phosphorus" "P")
21
Added:
(create-nutrient! "Potassium" "K"))
22
Added:
#:after (λ () (disconnect!))
25
23
26
Removed:
(test-case "Create measurement with date and values"
27
Removed:
(define nitrogen (get-nutrient #:name "Nitrogen"))
28
Removed:
(define phosphorus (get-nutrient #:name "Phosphorus"))
29
Removed:
(create-nutrient-measurement! measurement-date
30
Removed:
`((,nitrogen . 12.3)
31
Removed:
(,phosphorus . 4.5)))
32
Removed:
(check-equal? (length (get-nutrient-measurements)) 1)
33
Removed:
(define nm (get-nutrient-measurement #:measured-on measurement-date))
34
Removed:
(check-true (nutrient-measurement? nm))
35
Removed:
(check-equal? (nutrient-measurement-date nm) measurement-date))
24
Added:
(test-case "Create measurement with date and values"
25
Added:
(define nitrogen (get-nutrient #:name "Nitrogen"))
26
Added:
(define phosphorus (get-nutrient #:name "Phosphorus"))
27
Added:
(create-nutrient-measurement! measurement-date `((,nitrogen . 12.3) (,phosphorus . 4.5)))
28
Added:
(check-equal? (length (get-nutrient-measurements)) 1)
29
Added:
(define nm (get-nutrient-measurement #:measured-on measurement-date))
30
Added:
(check-true (nutrient-measurement? nm))
31
Added:
(check-equal? (nutrient-measurement-date nm) measurement-date))
36
32
37
Removed:
(test-case "Check all measurement values"
38
Removed:
(define nitrogen (get-nutrient #:name "Nitrogen"))
39
Removed:
(define phosphorus (get-nutrient #:name "Phosphorus"))
33
Added:
(test-case "Check all measurement values"
34
Added:
(define nitrogen (get-nutrient #:name "Nitrogen"))
35
Added:
(define phosphorus (get-nutrient #:name "Phosphorus"))
40
36
41
Removed:
(define nm (get-nutrient-measurement #:measured-on measurement-date))
42
Removed:
(check-equal? (get-nutrient-measurement-value nm nitrogen) 12.3)
43
Removed:
(check-equal? (get-nutrient-measurement-value nm phosphorus) 4.5)
37
Added:
(define nm (get-nutrient-measurement #:measured-on measurement-date))
38
Added:
(check-equal? (get-nutrient-measurement-value nm nitrogen) 12.3)
39
Added:
(check-equal? (get-nutrient-measurement-value nm phosphorus) 4.5)
44
40
45
Removed:
(define nmv (nutrient-measurement-values nm))
46
Removed:
(check-equal? (get-nutrient-measurement-values nm) nmv
47
Removed:
"return value of get-nutrient-measurement-values ≠ nutrient-measurement-values struct accessor")
48
Removed:
(check-equal? (length nmv) 2)
49
Removed:
(check-equal? (cdr (assoc nitrogen nmv)) 12.3)
50
Removed:
(check-equal? (cdr (assoc phosphorus nmv)) 4.5))
41
Added:
(define nmv (nutrient-measurement-values nm))
42
Added:
(check-equal?
43
Added:
(get-nutrient-measurement-values nm)
44
Added:
nmv
45
Added:
"return value of get-nutrient-measurement-values ≠ nutrient-measurement-values struct accessor")
46
Added:
(check-equal? (length nmv) 2)
47
Added:
(check-equal? (cdr (assoc nitrogen nmv)) 12.3)
48
Added:
(check-equal? (cdr (assoc phosphorus nmv)) 4.5))
51
49
52
Removed:
(test-case "Retrieve latest measurement values"
53
Removed:
(define nitrogen (get-nutrient #:name "Nitrogen"))
54
Removed:
(define phosphorus (get-nutrient #:name "Phosphorus"))
55
Removed:
(define second-measurement-date "2025-09-02")
56
Removed:
(create-nutrient-measurement! second-measurement-date
57
Removed:
`((,nitrogen . 6.7)
58
Removed:
(,phosphorus . 8.9)))
50
Added:
(test-case "Retrieve latest measurement values"
51
Added:
(define nitrogen (get-nutrient #:name "Nitrogen"))
52
Added:
(define phosphorus (get-nutrient #:name "Phosphorus"))
53
Added:
(define second-measurement-date "2025-09-02")
54
Added:
(create-nutrient-measurement! second-measurement-date `((,nitrogen . 6.7) (,phosphorus . 8.9)))
59
55
60
Removed:
(check-equal? (get-latest-nutrient-measurement-value nitrogen) 6.7)
61
Removed:
(check-equal? (get-latest-nutrient-measurement-value phosphorus) 8.9))
56
Added:
(check-equal? (get-latest-nutrient-measurement-value nitrogen) 6.7)
57
Added:
(check-equal? (get-latest-nutrient-measurement-value phosphorus) 8.9))
62
58
63
Removed:
(test-case "Delete measurement and cascade to measurement values"
64
Removed:
(define nm (get-nutrient-measurement #:measured-on measurement-date))
65
Removed:
(delete-nutrient-measurement! nm)
66
Removed:
(check-false (get-nutrient-measurement #:id (nutrient-measurement-id nm)))
67
Removed:
(check-equal? (length (get-nutrient-measurements)) 1
68
Removed:
"wrong number of nutrient measurements were deleted")
69
Removed:
(check-true (null? (get-nutrient-measurement-values nm)))))))
59
Added:
(test-case "Delete measurement and cascade to measurement values"
60
Added:
(define nm (get-nutrient-measurement #:measured-on measurement-date))
61
Added:
(delete-nutrient-measurement! nm)
62
Added:
(check-false (get-nutrient-measurement #:id (nutrient-measurement-id nm)))
63
Added:
(check-equal? (length (get-nutrient-measurements))
64
Added:
1
65
Added:
"wrong number of nutrient measurements were deleted")
66
Added:
(check-true (null? (get-nutrient-measurement-values nm)))))))
tests/models/nutrient.rkt
@@ -7,70 +7,62 @@
7
7
"../../db/migrations.rkt"
8
8
"../../models/nutrient.rkt")
9
9
10
Removed:
(run-tests
11
Removed:
(test-suite
12
Removed:
"Nutrient model"
13
Removed:
#:before (λ ()
14
Removed:
(connect! #:path 'memory)
15
Removed:
(migrate-all!))
16
Removed:
#:after (λ ()
17
Removed:
(disconnect!))
10
Added:
(run-tests (test-suite "Nutrient model"
11
Added:
#:before (λ ()
12
Added:
(connect! #:path 'memory)
13
Added:
(migrate-all!))
14
Added:
#:after (λ () (disconnect!))
18
15
19
Removed:
(test-case "Create nutrients"
20
Removed:
(create-nutrient! "Examplium" "Ex")
21
Removed:
(check-equal? (length (get-nutrients)) 1)
22
Removed:
(create-nutrient! "Ignorium" "Ig")
23
Removed:
(check-equal? (length (get-nutrients)) 2))
16
Added:
(test-case "Create nutrients"
17
Added:
(create-nutrient! "Examplium" "Ex")
18
Added:
(check-equal? (length (get-nutrients)) 1)
19
Added:
(create-nutrient! "Ignorium" "Ig")
20
Added:
(check-equal? (length (get-nutrients)) 2))
24
21
25
Removed:
(test-case "Read nutrient"
26
Removed:
(define examplium (get-nutrient #:id 1))
27
Removed:
(check-true (nutrient? examplium))
28
Removed:
(check-equal? (nutrient-id examplium) 1))
29
Removed:
30
Removed:
(test-case "Read nutrient by name"
31
Removed:
(define examplium (get-nutrient #:name "Examplium"))
32
Removed:
(check-true (nutrient? examplium))
33
Removed:
(check-equal? (nutrient-name examplium) "Examplium"))
22
Added:
(test-case "Read nutrient"
23
Added:
(define examplium (get-nutrient #:id 1))
24
Added:
(check-true (nutrient? examplium))
25
Added:
(check-equal? (nutrient-id examplium) 1))
34
26
35
Removed:
(test-case "Read nutrient by formula"
36
Removed:
(define examplium (get-nutrient #:formula "Ex"))
37
Removed:
(check-true (nutrient? examplium))
38
Removed:
(check-equal? (nutrient-formula examplium) "Ex"))
39
Removed:
40
Removed:
(test-case "Read inexisting nutrient"
41
Removed:
(check-false (get-nutrient #:name "Inexistium")))
27
Added:
(test-case "Read nutrient by name"
28
Added:
(define examplium (get-nutrient #:name "Examplium"))
29
Added:
(check-true (nutrient? examplium))
30
Added:
(check-equal? (nutrient-name examplium) "Examplium"))
42
31
43
Removed:
(test-case "Update nutrient name"
44
Removed:
(define examplium (get-nutrient #:name "Examplium"))
45
Removed:
(define examplium-nitrate
46
Removed:
(update-nutrient! examplium #:name "Examplium Nitrate"))
47
Removed:
(check-equal? (length (get-nutrients)) 2)
48
Removed:
(check-equal? (nutrient-name examplium-nitrate) "Examplium Nitrate")
49
Removed:
(check-equal? (nutrient-formula examplium-nitrate) "Ex"))
32
Added:
(test-case "Read nutrient by formula"
33
Added:
(define examplium (get-nutrient #:formula "Ex"))
34
Added:
(check-true (nutrient? examplium))
35
Added:
(check-equal? (nutrient-formula examplium) "Ex"))
50
36
51
Removed:
(test-case "Update nutrient formula"
52
Removed:
(define examplium-nitrate (get-nutrient #:name "Examplium Nitrate"))
53
Removed:
(define examplium-sulfate
54
Removed:
(update-nutrient! examplium-nitrate #:formula "ExSO4"))
55
Removed:
(check-equal? (length (get-nutrients)) 2)
56
Removed:
(check-equal? (nutrient-name examplium-sulfate) "Examplium Nitrate")
57
Removed:
(check-equal? (nutrient-formula examplium-sulfate) "ExSO4"))
37
Added:
(test-case "Read inexisting nutrient"
38
Added:
(check-false (get-nutrient #:name "Inexistium")))
58
39
59
Removed:
(test-case "Update nutrient name and formula"
60
Removed:
(define examplium-nitrate
61
Removed:
(get-nutrient #:name "Examplium Nitrate"))
62
Removed:
(define examplium-sulfate
63
Removed:
(update-nutrient! examplium-nitrate
64
Removed:
#:name "Examplium Sulfate"
65
Removed:
#:formula "ExNO3"))
66
Removed:
(check-equal? (length (get-nutrients)) 2)
67
Removed:
(check-equal? (nutrient-name examplium-sulfate) "Examplium Sulfate")
68
Removed:
(check-equal? (nutrient-formula examplium-sulfate) "ExNO3"))
40
Added:
(test-case "Update nutrient name"
41
Added:
(define examplium (get-nutrient #:name "Examplium"))
42
Added:
(define examplium-nitrate (update-nutrient! examplium #:name "Examplium Nitrate"))
43
Added:
(check-equal? (length (get-nutrients)) 2)
44
Added:
(check-equal? (nutrient-name examplium-nitrate) "Examplium Nitrate")
45
Added:
(check-equal? (nutrient-formula examplium-nitrate) "Ex"))
69
46
70
Removed:
(test-case "Delete nutrient"
71
Removed:
(define examplium-sulfate (get-nutrient #:name "Examplium Sulfate"))
72
Removed:
(delete-nutrient! examplium-sulfate)
73
Removed:
(check-equal? (length (get-nutrients)) 1)
74
Removed:
(define ignorium (get-nutrient #:name "Ignorium"))
75
Removed:
(delete-nutrient! ignorium)
76
Removed:
(check-equal? (length (get-nutrients)) 0)))))
47
Added:
(test-case "Update nutrient formula"
48
Added:
(define examplium-nitrate (get-nutrient #:name "Examplium Nitrate"))
49
Added:
(define examplium-sulfate (update-nutrient! examplium-nitrate #:formula "ExSO4"))
50
Added:
(check-equal? (length (get-nutrients)) 2)
51
Added:
(check-equal? (nutrient-name examplium-sulfate) "Examplium Nitrate")
52
Added:
(check-equal? (nutrient-formula examplium-sulfate) "ExSO4"))
53
Added:
54
Added:
(test-case "Update nutrient name and formula"
55
Added:
(define examplium-nitrate (get-nutrient #:name "Examplium Nitrate"))
56
Added:
(define examplium-sulfate
57
Added:
(update-nutrient! examplium-nitrate #:name "Examplium Sulfate" #:formula "ExNO3"))
58
Added:
(check-equal? (length (get-nutrients)) 2)
59
Added:
(check-equal? (nutrient-name examplium-sulfate) "Examplium Sulfate")
60
Added:
(check-equal? (nutrient-formula examplium-sulfate) "ExNO3"))
61
Added:
62
Added:
(test-case "Delete nutrient"
63
Added:
(define examplium-sulfate (get-nutrient #:name "Examplium Sulfate"))
64
Added:
(delete-nutrient! examplium-sulfate)
65
Added:
(check-equal? (length (get-nutrients)) 1)
66
Added:
(define ignorium (get-nutrient #:name "Ignorium"))
67
Added:
(delete-nutrient! ignorium)
68
Added:
(check-equal? (length (get-nutrients)) 0)))))
views.rkt
@@ -15,130 +15,102 @@
15
15
"models/nutrient-target.rkt"
16
16
"models/fertilizer-product.rkt")
17
17
18
Removed:
19
18
(define (page-template title body-xexpr)
20
Removed:
`(html
21
Removed:
(head
22
Removed:
(meta ([charset "utf-8"]))
23
Removed:
(meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
24
Removed:
(title ,title)
25
Removed:
;; Bootstrap CSS
26
Removed:
(link ([href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/css/bootstrap.min.css"]
27
Removed:
[rel "stylesheet"]
28
Removed:
[integrity "sha384-QWTKZyjpPEjISv5WaRU9OFeRpok6YctnYmDr5pNlyT2bRjXh0JMhjY6hW+ALEwIH"]
29
Removed:
[crossorigin "anonymous"])))
30
Removed:
(body
31
Removed:
,navbar
32
Removed:
(div ([class "container"])
33
Removed:
,@body-xexpr)
34
Removed:
;; Bootstrap JS bundle
35
Removed:
(script ([src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/js/bootstrap.bundle.min.js"]
36
Removed:
[integrity "sha384-YvpcrYf0tY3lHB60NNkmXc5s9fDVZLESaAA55NDzOxhy9GkcIdslK1eN7N6jIeHz"]
37
Removed:
[crossorigin "anonymous"])))))
19
Added:
`(html (head (meta ([charset "utf-8"]))
20
Added:
(meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
21
Added:
(title ,title)
22
Added:
;; Bootstrap CSS
23
Added:
(link ([href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/css/bootstrap.min.css"]
24
Added:
[rel "stylesheet"]
25
Added:
[integrity
26
Added:
"sha384-QWTKZyjpPEjISv5WaRU9OFeRpok6YctnYmDr5pNlyT2bRjXh0JMhjY6hW+ALEwIH"]
27
Added:
[crossorigin "anonymous"])))
28
Added:
(body ,navbar
29
Added:
(div ((class "container")) ,@body-xexpr)
30
Added:
;; Bootstrap JS bundle
31
Added:
(script
32
Added:
([src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/js/bootstrap.bundle.min.js"]
33
Added:
[integrity "sha384-YvpcrYf0tY3lHB60NNkmXc5s9fDVZLESaAA55NDzOxhy9GkcIdslK1eN7N6jIeHz"]
34
Added:
[crossorigin "anonymous"])))))
38
35
39
Removed:
40
36
;; Page components
41
37
42
38
(define navbar
43
39
'(nav
44
Removed:
([class "navbar navbar-expand-lg navbar-light bg-light"])
40
Added:
((class "navbar navbar-expand-lg navbar-light bg-light"))
45
41
(div
46
Removed:
([class "container-fluid"])
47
Removed:
(a ([class "navbar-brand"] [href "/"]) "FAPG")
48
Removed:
(button ([class "navbar-toggler"]
49
Removed:
[type "button"]
50
Removed:
[data-bs-toggle "collapse"]
51
Removed:
[data-bs-target "#navbarSupportedContent"]
52
Removed:
[aria-controls "navbarSupportedContent"]
53
Removed:
[aria-expanded "false"]
54
Removed:
[aria-label "Toggle navigation"])
55
Removed:
(span ([class "navbar-toggler-icon"])))
56
Removed:
(div ([class "collapse navbar-collapse"] [id "navbarSupportedContent"])
57
Removed:
(ul ([class "navbar-nav me-auto mb-2 mb-lg-0"])
58
Removed:
#; (li ([class "nav-item dropdown"])
59
Removed:
(a ([class "nav-link dropdown-toggle"]
60
Removed:
[href "#"]
61
Removed:
[id "navbarDropdown"]
62
Removed:
[role "button"]
63
Removed:
[data-bs-toggle "dropdown"]
64
Removed:
[aria-expanded "false"])
65
Removed:
"Dropdown")
66
Removed:
(ul ([class "dropdown-menu"] [aria-labelledby "navbarDropdown"])
67
Removed:
(li (a ([class "dropdown-item"] [href "#"]) "Action"))
68
Removed:
(li (a ([class "dropdown-item"] [href "#"]) "Another action"))
69
Removed:
(li (hr ([class "dropdown-divider"])))
70
Removed:
(li (a ([class "dropdown-item"] [href "#"]) "Something else here"))))
71
Removed:
(li ([class "nav-item"])
72
Removed:
(a ([class "nav-link disabled"]
73
Removed:
[href "#"]
74
Removed:
[tabindex "-1"]
75
Removed:
[aria-disabled "true"])
42
Added:
((class "container-fluid"))
43
Added:
(a ((class "navbar-brand") [href "/"]) "FAPG")
44
Added:
(button ((class "navbar-toggler") [type "button"]
45
Added:
[data-bs-toggle "collapse"]
46
Added:
[data-bs-target "#navbarSupportedContent"]
47
Added:
[aria-controls "navbarSupportedContent"]
48
Added:
[aria-expanded "false"]
49
Added:
[aria-label "Toggle navigation"])
50
Added:
(span ((class "navbar-toggler-icon"))))
51
Added:
(div ((class "collapse navbar-collapse") [id "navbarSupportedContent"])
52
Added:
(ul ((class "navbar-nav me-auto mb-2 mb-lg-0"))
53
Added:
#;(li ((class "nav-item dropdown"))
54
Added:
(a ((class "nav-link dropdown-toggle") [href "#"]
55
Added:
[id "navbarDropdown"]
56
Added:
[role "button"]
57
Added:
[data-bs-toggle "dropdown"]
58
Added:
[aria-expanded "false"])
59
Added:
"Dropdown")
60
Added:
(ul ((class "dropdown-menu") [aria-labelledby "navbarDropdown"])
61
Added:
(li (a ((class "dropdown-item") [href "#"]) "Action"))
62
Added:
(li (a ((class "dropdown-item") [href "#"]) "Another action"))
63
Added:
(li (hr ((class "dropdown-divider"))))
64
Added:
(li (a ((class "dropdown-item") [href "#"]) "Something else here"))))
65
Added:
(li ((class "nav-item"))
66
Added:
(a ((class "nav-link disabled") [href "#"] [tabindex "-1"] [aria-disabled "true"])
76
67
"Clients"))
77
Removed:
(li ([class "nav-item"])
78
Removed:
(a ([class "nav-link active"]
79
Removed:
[aria-current "page"]
80
Removed:
[href "/ferti"])
81
Removed:
"Ferti"))
82
Removed:
(li ([class "nav-item"])
83
Removed:
(a ([class "nav-link disabled"]
84
Removed:
[href "#"]
85
Removed:
[tabindex "-1"]
86
Removed:
[aria-disabled "true"])
68
Added:
(li ((class "nav-item"))
69
Added:
(a ((class "nav-link active") [aria-current "page"] [href "/ferti"]) "Ferti"))
70
Added:
(li ((class "nav-item"))
71
Added:
(a ((class "nav-link disabled") [href "#"] [tabindex "-1"] [aria-disabled "true"])
87
72
"Cultures"))
88
Removed:
(li ([class "nav-item"])
89
Removed:
(a ([class "nav-link"]
90
Removed:
[href "/contact"])
91
Removed:
"Contact")))
92
Removed:
#; (form ([class "d-flex"])
93
Removed:
(input ([class "form-control me-2"]
94
Removed:
[type "search"]
95
Removed:
[placeholder "Search"]
96
Removed:
[aria-label "Search"]))
97
Removed:
(button ([class "btn btn-outline-success"] [type "submit"]) "Search"))))))
73
Added:
(li ((class "nav-item")) (a ((class "nav-link") [href "/contact"]) "Contact")))
74
Added:
#;(form ((class "d-flex"))
75
Added:
(input ((class "form-control me-2") [type "search"]
76
Added:
[placeholder "Search"]
77
Added:
[aria-label "Search"]))
78
Added:
(button ((class "btn btn-outline-success") [type "submit"]) "Search"))))))
98
79
99
Removed:
100
80
;; Page helpers
101
81
102
82
(define (round n number)
103
83
(~r number #:precision `(= ,n)))
104
84
105
Removed:
106
85
;; Pages
107
86
108
87
(define (ferti-page measurements ferti-recipe)
109
88
(page-template
110
89
"Ferti"
111
Removed:
`((h1 ([class "display-1 mb-3"]) "Ferti")
112
Removed:
113
Removed:
90
Added:
`((h1 ((class "display-1 mb-3")) "Ferti")
114
91
;;;;;;;;
115
92
;; Ferti
116
93
;;;;;;;;
117
Removed:
118
94
(h2 () "Recette")
119
95
,(if (ormap (λ (pair) (not (zero? (cdr pair)))) ferti-recipe)
120
Removed:
`(table ([class "table"])
121
Removed:
(tr (th "Intrant")
122
Removed:
(th ([class "text-end"]) "Quantité (g/L)"))
96
Added:
`(table ((class "table"))
97
Added:
(tr (th "Intrant") (th ((class "text-end")) "Quantité (g/L)"))
123
98
,@(for/list ([fertilizer-amount ferti-recipe]
124
99
#:when (not (zero? (cdr fertilizer-amount))))
125
100
(match-define (cons fertilizer amount) fertilizer-amount)
126
101
`(tr (td () ,(fertilizer-name fertilizer))
127
Removed:
(td ([class "text-end font-monospace"]) ,(round 2 amount)))))
102
Added:
(td ((class "text-end font-monospace")) ,(round 2 amount)))))
128
103
`(p "La recette Ferti requiert au moins un relevé et une cible."))
129
Removed:
130
Removed:
131
104
;;;;;;;;;
132
105
;; Cibles
133
106
;;;;;;;;;
134
Removed:
135
107
(h2 () "Dernière Cible")
136
Removed:
(a ([class "btn btn-primary mb-3"] [href "/target/new"]) "Créer une cible")
137
Removed:
(table ([class "table"])
108
Added:
(a ((class "btn btn-primary mb-3") [href "/target/new"]) "Créer une cible")
109
Added:
(table ((class "table"))
138
110
(tr (th "Nutriment")
139
Removed:
(th ([class "text-end"]) "Dernier Relevé")
140
Removed:
(th ([class "text-end"]) "Dernière Cible")
141
Removed:
(th ([class "text-end"]) "Delta (%)"))
111
Added:
(th ((class "text-end")) "Dernier Relevé")
112
Added:
(th ((class "text-end")) "Dernière Cible")
113
Added:
(th ((class "text-end")) "Delta (%)"))
142
114
,@(for/list ([n (get-nutrients)])
143
115
(define latest-target (get-latest-nutrient-target-value n))
144
116
(define latest-measurement (get-latest-nutrient-measurement-value n))
@@ -163,14 +135,13 @@
163
135
;;;;;;;;;;
164
136
;; Relevés
165
137
;;;;;;;;;;
166
Removed:
167
138
(h2 () "Relevés")
168
Removed:
(a ([class "btn btn-primary mb-3"] [href "/measurement/new"]) "Ajouter un relevé")
169
Removed:
(table ([class "table table-striped"])
139
Added:
(a ((class "btn btn-primary mb-3") [href "/measurement/new"]) "Ajouter un relevé")
140
Added:
(table ((class "table table-striped"))
170
141
(tr (th "Date")
171
Removed:
(th ([class "text-end"]) "N")
172
Removed:
(th ([class "text-end"]) "P")
173
Removed:
(th ([class "text-end"]) "K"))
142
Added:
(th ((class "text-end")) "N")
143
Added:
(th ((class "text-end")) "P")
144
Added:
(th ((class "text-end")) "K"))
174
145
,@(for/list ([m measurements])
175
146
(define measured-on (nutrient-measurement-date m))
176
147
(define-values (n p k)
@@ -182,47 +153,40 @@
182
153
(round 2 mnv)
183
154
"—"))))
184
155
`(tr (td ,measured-on)
185
Removed:
(td ([class "text-end font-monospace"]) ,n)
186
Removed:
(td ([class "text-end font-monospace"]) ,p)
187
Removed:
(td ([class "text-end font-monospace"]) ,k)))))))
156
Added:
(td ((class "text-end font-monospace")) ,n)
157
Added:
(td ((class "text-end font-monospace")) ,p)
158
Added:
(td ((class "text-end font-monospace")) ,k)))))))
188
159
189
160
(define (new-measurement-page)
190
Removed:
(page-template
191
Removed:
"Nouveau relevé"
192
Removed:
`((h1 ([class "display-1 mb-3"]) "Nouveau relevé")
193
Removed:
(div ([class "mb-3"] [style "max-width: 30em"])
194
Removed:
(form
195
Removed:
([action "/measurement/create"]
196
Removed:
[method "POST"])
197
Removed:
,@(formlet-display (measurements-formlet)))))))
161
Added:
(page-template "Nouveau relevé"
162
Added:
`((h1 ((class "display-1 mb-3")) "Nouveau relevé")
163
Added:
(div ((class "mb-3") [style "max-width: 30em"])
164
Added:
(form ([action "/measurement/create"] [method "POST"])
165
Added:
,@(formlet-display (measurements-formlet)))))))
198
166
199
167
(define (new-target-page)
200
Removed:
(page-template
201
Removed:
"Nouvelle cible"
202
Removed:
`((h1 ([class "display-1 mb-3"]) "Nouvelle cible")
203
Removed:
(div ([class "mb-3"] [style "max-width: 30em"])
204
Removed:
(form
205
Removed:
([action "/target/create"]
206
Removed:
[method "POST"])
207
Removed:
,@(formlet-display (targets-formlet)))))))
168
Added:
(page-template "Nouvelle cible"
169
Added:
`((h1 ((class "display-1 mb-3")) "Nouvelle cible")
170
Added:
(div ((class "mb-3") [style "max-width: 30em"])
171
Added:
(form ([action "/target/create"] [method "POST"])
172
Added:
,@(formlet-display (targets-formlet)))))))
208
173
209
174
(define (index-page user)
210
175
(page-template
211
176
"Bienvenue à la FAPG"
212
Removed:
`((h1 ([class "display-1 mb-3"])
177
Added:
`((h1 ((class "display-1 mb-3"))
213
178
,(format "~a, ~a."
214
Removed:
(if (<= (->hours (current-time #:tz "Europe/Paris")) 17)
215
Removed:
"Bonjour"
216
Removed:
"Bonsoir")
217
Removed:
(if user (user-name user) "et bienvenue")))
218
Removed:
(a ([class "btn btn-primary mb-3"] [href "/ferti"]) "Accéder à Ferti"))))
179
Added:
(if (<= (->hours (current-time #:tz "Europe/Paris")) 17) "Bonjour" "Bonsoir")
180
Added:
(if user
181
Added:
(user-name user)
182
Added:
"et bienvenue")))
183
Added:
(a ((class "btn btn-primary mb-3") [href "/ferti"]) "Accéder à Ferti"))))
219
184
220
185
(define (fallback-page request-code)
221
Removed:
(page-template
222
Removed:
(format "Réponse: ~a" request-code)
223
Removed:
`((h1 ([class "display-1 text-danger"]) ,(number->string request-code))
224
Removed:
(p ,(fallback-message request-code))
225
Removed:
(a ([href "/"]) "Revenir à la page d'accueil"))))
186
Added:
(page-template (format "Réponse: ~a" request-code)
187
Added:
`((h1 ((class "display-1 text-danger")) ,(number->string request-code))
188
Added:
(p ,(fallback-message request-code))
189
Added:
(a ([href "/"]) "Revenir à la page d'accueil"))))
226
190
227
191
(define (fallback-message request-code)
228
192
(string-join
@@ -240,8 +204,11 @@
240
204
[(403) "Vous n'avez pas le droit de consulter cette page."]
241
205
[(404) "Vous avez demandé de consulter une page qui n'existe pas."]
242
206
;; Server errors
243
Removed:
[(500) "Je suis dans une situation que je ne sais pas gérer, et ne peux vous en dire davantage."]
244
Removed:
[(502) "Un tiers ne m'a pas transmis les informations nécessaires pour répondre à votre requête."]
245
Removed:
[(503) "Je ne peux pas vous aider, il se peut que je sois momentanément surchargé. Revenez plus tard."]
207
Added:
[(500)
208
Added:
"Je suis dans une situation que je ne sais pas gérer, et ne peux vous en dire davantage."]
209
Added:
[(502)
210
Added:
"Un tiers ne m'a pas transmis les informations nécessaires pour répondre à votre requête."]
211
Added:
[(503)
212
Added:
"Je ne peux pas vous aider, il se peut que je sois momentanément surchargé. Revenez plus tard."]
246
213
;; Fallback message
247
214
[else (format "Je ne sais pas encore interpréter le code ~a." request-code)]))))