1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
|
#lang racket
(provide crop-rotation
crop-rotation?
crop-rotation-id
crop-rotation-requirement
(rename-out [crop-rotation-rotation-date crop-rotation-date]
[crop-rotation-requirement-proportions crop-rotation-requirements])
(contract-out
[create-crop-rotation! (-> string? requirement-proportion-hash/c crop-rotation?)]
[get-crop-rotations (-> (listof crop-rotation?))]
[get-crop-rotation (->* () (#:id db-id? #:date string?) (or/c crop-rotation? #f))]
[get-latest-crop-rotation (-> (or/c crop-rotation? #f))]
[delete-crop-rotation! (-> crop-rotation-or-id/c void?)]))
(require db
sql
"../db/conn.rkt"
"crop-requirement.rkt"
"utils.rkt")
(struct crop-rotation (id rotation-date requirement-proportions) #:transparent)
(define (crop-rotation-requirement cr requirement)
(hash-ref (crop-rotation-requirement-proportions cr) requirement #f))
(define crop-rotation-or-id/c (or/c crop-rotation? db-id?))
(define requirement-proportion-hash/c (hash/c crop-requirement? (between/c 0 100) #:immutable #t))
(define (->cr-id cr-or-id)
(match cr-or-id
[(? db-id? id) id]
[(crop-rotation id _ _) id]
[#f (error '->nt-id "#f can not be converted to an id")]))
;; CREATE
(define (create-crop-rotation! rotation-date requirement-proportions)
(or (get-crop-rotation #:date rotation-date)
(with-tx
(query-exec (current-conn) (insert #:into crop_rotations #:set [rotation_date ,rotation-date]))
(define cr-id
(query-value (current-conn)
(select id #:from crop_rotations #:where (= rotation_date ,rotation-date))))
(for ([(r p) (in-hash requirement-proportions)])
(query-exec (current-conn)
(insert #:into crop_rotation_requirements
#:set [crop_rotation_id ,cr-id]
[crop_requirement_id ,(crop-requirement-id r)]
[proportion_percent ,p])))
(get-crop-rotation #:date rotation-date))))
;; READ
(define joined
(table-expr-qq (inner-join (as crop_rotations cr)
(as crop_rotation_requirements crr)
#:on (= crr.crop_rotation_id cr.id))))
(define (residuals->requirement-proportion-hash residuals)
(for/hash ([r (in-list residuals)])
(match-define (vector requirement-id proportion) r)
;; TODO: Fix this N+1 query problem.
(values (get-crop-requirement #:id requirement-id) proportion)))
(define (grouped-row->crop-rotation grouped-row)
(match-define (vector cr-id cr-rotation-date residuals) grouped-row)
(crop-rotation cr-id cr-rotation-date (residuals->requirement-proportion-hash residuals)))
(define (get-crop-rotations)
(define grouped-rows
(query-rows (current-conn)
(select cr.id
cr.rotation_date
crr.crop_requirement_id
crr.proportion_percent
#:from (TableExpr:AST ,joined)
#:order-by cr.rotation_date
#:desc)
#:group '#(0 1)))
(map grouped-row->crop-rotation grouped-rows))
(define (get-crop-rotation #:id [cr-id #f] #:date [rotation-date #f])
(define where
(cond
[(and cr-id rotation-date)
(scalar-expr-qq (and (= cr.id ,cr-id) (= cr.rotation_date ,rotation-date)))]
[cr-id (scalar-expr-qq (= cr.id ,cr-id))]
[rotation-date (scalar-expr-qq (= cr.rotation_date ,rotation-date))]
[else (error 'get-crop-rotation "either #:id or #:date must be provided")]))
(define grouped-rows
(query-rows (current-conn)
(select cr.id
cr.rotation_date
crr.crop_requirement_id
crr.proportion_percent
#:from (TableExpr:AST ,joined)
#:where (ScalarExpr:AST ,where)
#:order-by cr.rotation_date
#:desc)
#:group '#(0 1)))
(match grouped-rows
['() #f]
[(list grouped-row) (grouped-row->crop-rotation grouped-row)]
[many (error 'get-crop-rotation "expected 1 crop rotation, got ~a" (length many))]))
(define (get-latest-crop-rotation)
(define rotations (get-crop-rotations))
(if (null? rotations)
#f
(first rotations)))
;; UPDATE
;; DELETE
(define (delete-crop-rotation! cr-or-id)
(query-exec (current-conn) (delete #:from crop_rotations #:where (= id ,(->cr-id cr-or-id)))))
(module+ test
(require rackunit
rackunit/text-ui
"../db/conn.rkt"
"../db/migrations.rkt"
"../models/nutrient.rkt"
"../models/crop.rkt"
"../models/crop-requirement.rkt")
(define rotation-date-1 "2025-01-15")
(define rotation-date-2 "2025-02-20")
(run-tests
(test-suite "Crop rotation model"
#:before (λ ()
(connect! #:path 'memory)
(migrate-all!)
(create-nutrient! "Examplium" "Examplium" "Ex")
(create-nutrient! "Ignorium" "Ignorium" "Ig")
(create-nutrient! "Testium" "Testium" "Ts"))
#:after (λ () (disconnect!))
(test-case "Create crop rotation with requirement proportions"
(define ex (get-nutrient #:name "Examplium"))
(define ig (get-nutrient #:name "Ignorium"))
(define req1 (create-crop-requirement! "vegetative" (hash ex 100 ig 50)))
(define req2 (create-crop-requirement! "fruiting" (hash ex 150 ig 75)))
(define proportions (hash req1 60 req2 40))
(define rotation (create-crop-rotation! rotation-date-1 proportions))
(check-true (crop-rotation? rotation))
(check-equal? (crop-rotation-rotation-date rotation) rotation-date-1)
(check-equal? (hash-count (crop-rotation-requirement-proportions rotation)) 2)
;; Find requirements in the returned hash by profile
(define reqs (crop-rotation-requirement-proportions rotation))
(define req1-found
(findf (λ (r) (equal? (crop-requirement-profile r) "vegetative")) (hash-keys reqs)))
(define req2-found
(findf (λ (r) (equal? (crop-requirement-profile r) "fruiting")) (hash-keys reqs)))
(check-equal? (hash-ref reqs req1-found) 60)
(check-equal? (hash-ref reqs req2-found) 40))
(test-case "Create duplicate rotation returns existing"
;; Get all requirements to find the ones we need
(define all-reqs (get-crop-requirements))
(define req1 (findf (λ (r) (equal? (crop-requirement-profile r) "vegetative")) all-reqs))
(define req2 (findf (λ (r) (equal? (crop-requirement-profile r) "fruiting")) all-reqs))
;; Try to create with different proportions - should return existing
(define proportions (hash req1 70 req2 30))
(define rotation2 (create-crop-rotation! rotation-date-1 proportions))
(check-equal? (length (get-crop-rotations)) 1)
;; The returned rotation should have original proportions (60/40), not new ones (70/30)
(define reqs2 (crop-rotation-requirement-proportions rotation2))
(define req1-from-rotation
(findf (λ (r) (equal? (crop-requirement-profile r) "vegetative")) (hash-keys reqs2)))
(define req2-from-rotation
(findf (λ (r) (equal? (crop-requirement-profile r) "fruiting")) (hash-keys reqs2)))
(check-equal? (hash-ref reqs2 req1-from-rotation) 60)
(check-equal? (hash-ref reqs2 req2-from-rotation) 40))
(test-case "Get crop rotation by id"
(define rotation1 (get-crop-rotation #:date rotation-date-1))
(define rotation2 (get-crop-rotation #:id (crop-rotation-id rotation1)))
(check-equal? (crop-rotation-id rotation1) (crop-rotation-id rotation2))
(check-equal? (crop-rotation-rotation-date rotation1) (crop-rotation-rotation-date rotation2)))
(test-case "Get crop rotation by date"
(define rotation (get-crop-rotation #:date rotation-date-1))
(check-true (crop-rotation? rotation))
(check-equal? (crop-rotation-rotation-date rotation) rotation-date-1))
(test-case "Get crop rotation with both id and date"
(define rotation1 (get-crop-rotation #:date rotation-date-1))
(define rotation2 (get-crop-rotation #:id (crop-rotation-id rotation1) #:date rotation-date-1))
(check-equal? (crop-rotation-id rotation1) (crop-rotation-id rotation2)))
(test-case "Get non-existent crop rotation"
(check-false (get-crop-rotation #:date "2099-12-31"))
(check-false (get-crop-rotation #:id 9999)))
(test-case "Get all crop rotations ordered by date descending"
(define ts (get-nutrient #:name "Testium"))
(define req3 (create-crop-requirement! "maintenance" (hash ts 80)))
(create-crop-rotation! rotation-date-2 (hash req3 100))
(define rotations (get-crop-rotations))
(check-equal? (length rotations) 2)
;; Most recent first
(check-equal? (crop-rotation-rotation-date (first rotations)) rotation-date-2)
(check-equal? (crop-rotation-rotation-date (second rotations)) rotation-date-1))
(test-case "Get latest crop rotation"
(define latest (get-latest-crop-rotation))
(check-true (crop-rotation? latest))
(check-equal? (crop-rotation-rotation-date latest) rotation-date-2))
(test-case "Get latest returns #f when no rotations exist"
(for ([rotation (get-crop-rotations)])
(delete-crop-rotation! (crop-rotation-id rotation)))
(check-false (get-latest-crop-rotation)))
(test-case "Delete crop rotation by struct"
(define ts (get-nutrient #:name "Testium"))
(define req
(findf (λ (r) (equal? (crop-requirement-profile r) "maintenance")) (get-crop-requirements)))
(create-crop-rotation! "2025-03-01" (hash req 100))
(define rotation (get-crop-rotation #:date "2025-03-01"))
(delete-crop-rotation! rotation)
(check-false (get-crop-rotation #:id (crop-rotation-id rotation))))
(test-case "Delete crop rotation by id"
(define ts (get-nutrient #:name "Testium"))
(define req
(findf (λ (r) (equal? (crop-requirement-profile r) "maintenance")) (get-crop-requirements)))
(create-crop-rotation! "2025-04-01" (hash req 100))
(define rotation (get-crop-rotation #:date "2025-04-01"))
(define rotation-id-val (crop-rotation-id rotation))
(delete-crop-rotation! rotation-id-val)
(check-false (get-crop-rotation #:id rotation-id-val)))
(test-case "Delete crop rotation cascades to crop_rotation_requirements"
(define ex (get-nutrient #:name "Examplium"))
(define req1 (create-crop-requirement! "test-profile-1" (hash ex 100)))
(define req2 (create-crop-requirement! "test-profile-2" (hash ex 200)))
(create-crop-rotation! "2025-05-01" (hash req1 50 req2 50))
(define initial-count (length (get-crop-rotations)))
(define rotation (get-crop-rotation #:date "2025-05-01"))
(delete-crop-rotation! rotation)
(check-equal? (length (get-crop-rotations)) (- initial-count 1)))
(test-case "Rotation with associated crop requirement"
(define ex (get-nutrient #:name "Examplium"))
(define test-crop (create-crop! (crop #f "test-crop-for-rotation")))
(define req-with-crop (create-crop-requirement! "crop-specific" (hash ex 120) test-crop))
(define rotation (create-crop-rotation! "2025-06-01" (hash req-with-crop 100)))
(check-equal? (crop-requirement-crop-id req-with-crop) (crop-id test-crop))
(define retrieved (get-crop-rotation #:date "2025-06-01"))
(check-equal? (hash-count (crop-rotation-requirement-proportions retrieved)) 1))
(test-case "Error when neither id nor date provided"
(check-exn exn:fail? (λ () (get-crop-rotation)))))))
|
