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