diff options
Diffstat (limited to 'models')
| -rw-r--r-- | models/crop-requirement.rkt | 90 | ||||
| -rw-r--r-- | models/crop.rkt | 5 | ||||
| -rw-r--r-- | models/fertilizer-product.rkt | 98 | ||||
| -rw-r--r-- | models/nutrient-target.rkt | 64 |
4 files changed, 252 insertions, 5 deletions
diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt index 733126e..e26f1dc 100644 --- a/models/crop-requirement.rkt +++ b/models/crop-requirement.rkt @@ -163,3 +163,93 @@ ([(nutrient value) (in-hash (crop-requirement-nutrient-values crop-requirement))]) (define contribution (* value weight)) (hash-update acc nutrient (λ (old) (+ old contribution)) 0)))) + +(module+ test + (require rackunit + rackunit/text-ui + "../db/conn.rkt" + "../db/migrations.rkt" + "../models/nutrient.rkt" + "../models/crop.rkt") + + (define requirement-profile "Tomato - Vegetative") + + (run-tests + (test-suite "Crop requirement model" + #:before (λ () + (connect! #:path 'memory) + (migrate-all!) + (create-nutrient! "Nitrogen" "Azote" "N") + (create-nutrient! "Phosphorus" "Phosphore" "P") + (create-nutrient! "Potassium" "Potassium" "K")) + #:after (λ () (disconnect!)) + + (test-case "Create requirement with profile and values" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define phosphorus (get-nutrient #:name "Phosphorus")) + + (create-crop-requirement! requirement-profile (hash nitrogen 150 phosphorus 50)) + + (check-equal? (length (get-crop-requirements)) 1) + + (define cr (get-crop-requirement #:profile requirement-profile)) + (check-true (crop-requirement? cr)) + (check-equal? (crop-requirement-profile cr) requirement-profile)) + + (test-case "Create requirement with associated crop" + (define tomato (create-crop! "Tomato")) + (define nitrogen (get-nutrient #:name "Nitrogen")) + + (define cr (create-crop-requirement! "Tomato - Fruiting" (hash nitrogen 200) tomato)) + + (check-equal? (crop-requirement-crop-id cr) (crop-id tomato))) + + (test-case "Check all requirement values" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define phosphorus (get-nutrient #:name "Phosphorus")) + + (define cr (get-crop-requirement #:profile requirement-profile)) + + (check-= (get-crop-requirement-value cr nitrogen) 150 0) + (check-= (get-crop-requirement-value cr phosphorus) 50 0) + + (define crv (crop-requirement-nutrient-values cr)) + + (check-equal? + (get-crop-requirement-values cr) + crv + "return value of get-crop-requirement-values ≠ crop-requirement-values struct accessor") + + (check-equal? (hash-count crv) 2) + (check-= (hash-ref crv nitrogen) 150 0) + (check-= (hash-ref crv phosphorus) 50 0)) + + (test-case "Get requirement by id" + (define cr (get-crop-requirement #:profile requirement-profile)) + (define cr-by-id (get-crop-requirement #:id (crop-requirement-id cr))) + + (check-equal? cr cr-by-id)) + + (test-case "Average crop requirement nutrient values" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define phosphorus (get-nutrient #:name "Phosphorus")) + + (define cr1 (get-crop-requirement #:profile requirement-profile)) + (define cr2 (create-crop-requirement! "Lettuce" (hash nitrogen 100 phosphorus 30))) + + (define mix (list (cons cr1 60) (cons cr2 40))) + (define avg (average-crop-requirement-nutrient-values mix)) + + ;; 150 * 0.6 + 100 * 0.4 = 90 + 40 = 130 + (check-= (hash-ref avg nitrogen) 130 0.01) + ;; 50 * 0.6 + 30 * 0.4 = 30 + 12 = 42 + (check-= (hash-ref avg phosphorus) 42 0.01)) + + (test-case "Delete requirement and cascade to requirement values" + (define cr (get-crop-requirement #:profile requirement-profile)) + (delete-crop-requirement! cr) + (check-false (get-crop-requirement #:id (crop-requirement-id cr))) + (check-equal? (length (get-crop-requirements)) + 2 + "wrong number of crop requirements were deleted") + (check-true (hash-empty? (get-crop-requirement-values cr))))))) diff --git a/models/crop.rkt b/models/crop.rkt index d1d2159..eff54a3 100644 --- a/models/crop.rkt +++ b/models/crop.rkt @@ -25,9 +25,8 @@ (define (create-crop! name) (or (get-crop #:name name) - (with-tx - (query-exec (current-conn) (insert #:into crops #:set [canonical_name ,name])) - (get-crop #:name name)))) + (with-tx (query-exec (current-conn) (insert #:into crops #:set [canonical_name ,name])) + (get-crop #:name name)))) ;; READ diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt index 4481010..5c0de6c 100644 --- a/models/fertilizer-product.rkt +++ b/models/fertilizer-product.rkt @@ -26,7 +26,10 @@ (struct fertilizer-product (id canonical-name nutrient-values brand-name) #:transparent #:guard (λ (id canonical-name nutrient-values brand-name _) - (values id canonical-name nutrient-values (if (sql-null? brand-name) #f brand-name))) + (values id + canonical-name + nutrient-values + (if (or (sql-null? brand-name) (= (string-length brand-name) 0)) #f brand-name))) #:property prop:custom-write (λ (v out _mode) (fprintf out "Fertilizer #~a\n" (fertilizer-product-id v)) @@ -163,3 +166,96 @@ (define (delete-fertilizer-product! fp-or-id) (query-exec (current-conn) (delete #:from fertilizer_products #:where (= id ,(->fp-id fp-or-id))))) + +(module+ test + (require rackunit + rackunit/text-ui + "../db/conn.rkt" + "../db/migrations.rkt" + "../models/nutrient.rkt") + + (define canonical-product-name "MasterBlend 4-20") + + (run-tests + (test-suite "Fertilizer product model" + #:before (λ () + (connect! #:path 'memory) + (migrate-all!) + (create-nutrient! "Nitrogen" "Azote" "N") + (create-nutrient! "Phosphorus" "Phosphore" "P") + (create-nutrient! "Potassium" "Potassium" "K")) + #:after (λ () (disconnect!)) + + (test-case "Create product with name, brand, and values" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define phosphorus (get-nutrient #:name "Phosphorus")) + + (create-fertilizer-product! canonical-product-name + "MasterBlend" + (hash nitrogen 40 phosphorus 200)) + + (check-equal? (length (get-fertilizer-products)) 1) + + (define fp (get-fertilizer-product #:canonical-name canonical-product-name)) + (check-true (fertilizer-product? fp)) + (check-equal? (fertilizer-product-canonical-name fp) canonical-product-name) + (check-equal? (fertilizer-product-brand-name fp) "MasterBlend")) + + (test-case "Create product without brand name" + (define nitrogen (get-nutrient #:name "Nitrogen")) + + (define fp (create-fertilizer-product! "Generic N" "" (hash nitrogen 100))) + + (check-false (fertilizer-product-brand-name fp))) + + (test-case "Check all product values" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define phosphorus (get-nutrient #:name "Phosphorus")) + + (define fp (get-fertilizer-product #:canonical-name canonical-product-name)) + + (check-= (get-fertilizer-product-value fp nitrogen) 40 0) + (check-= (get-fertilizer-product-value fp phosphorus) 200 0) + + (define fpv (fertilizer-product-nutrient-values fp)) + + (check-equal? + (get-fertilizer-product-values fp) + fpv + "return value of get-fertilizer-product-values ≠ fertilizer-product-values struct accessor") + + (check-equal? (hash-count fpv) 2)) + + (test-case "Get product by id" + (define fp (get-fertilizer-product #:canonical-name canonical-product-name)) + (define fp-by-id (get-fertilizer-product #:id (fertilizer-product-id fp))) + + (check-equal? fp fp-by-id)) + + (test-case "Handle missing nutrient in product" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define potassium (get-nutrient #:name "Potassium")) + + (define fp (get-fertilizer-product #:canonical-name canonical-product-name)) + (check-false (get-fertilizer-product-value fp potassium))) + + (test-case "Custom write property formatting" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define fp (create-fertilizer-product! "Test Fertilizer" "TestBrand" (hash nitrogen 50))) + + (define output (open-output-string)) + (write fp output) + (define result (get-output-string output)) + + (check-true (string-contains? result "Fertilizer #")) + (check-true (string-contains? result "Test Fertilizer")) + (check-true (string-contains? result "TestBrand"))) + + (test-case "Delete product and cascade to product values" + (define fp (get-fertilizer-product #:canonical-name canonical-product-name)) + (delete-fertilizer-product! fp) + (check-false (get-fertilizer-product #:id (fertilizer-product-id fp))) + (check-equal? (length (get-fertilizer-products)) + 2 + "wrong number of fertilizer products were deleted") + (check-true (hash-empty? (get-fertilizer-product-values fp))))))) diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt index 10c0c42..0a117b5 100644 --- a/models/nutrient-target.rkt +++ b/models/nutrient-target.rkt @@ -177,5 +177,67 @@ ;; DELETE (define (delete-nutrient-target! nt-or-id) - (define id (nutrient-target-id nutrient-target)) (query-exec (current-conn) (delete #:from nutrient_targets #:where (= id ,(->nt-id nt-or-id))))) + +(module+ test + (require rackunit + rackunit/text-ui + "../db/conn.rkt" + "../db/migrations.rkt" + "../models/nutrient.rkt") + + (define target-date "2025-09-01") + + (run-tests + (test-suite "Nutrient target model" + #:before (λ () + (connect! #:path 'memory) + (migrate-all!) + (create-nutrient! "Nitrogen" "" "N") + (create-nutrient! "Phosphorus" "" "P") + (create-nutrient! "Potassium" "" "K")) + #:after (λ () (disconnect!)) + + (test-case "Create target with date and values" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define phosphorus (get-nutrient #:name "Phosphorus")) + (create-nutrient-target! target-date (hash nitrogen 12.3 phosphorus 4.5)) + (check-equal? (length (get-nutrient-targets)) 1) + (define nt (get-nutrient-target #:effective-on target-date)) + (check-true (nutrient-target? nt)) + (check-equal? (nutrient-target-effective-on nt) target-date)) + + (test-case "Check all target values" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define phosphorus (get-nutrient #:name "Phosphorus")) + + (define nt (get-nutrient-target #:effective-on target-date)) + (check-equal? (get-nutrient-target-value nt nitrogen) 12.3) + (check-equal? (get-nutrient-target-value nt phosphorus) 4.5) + + (define ntv (nutrient-target-nutrient-values nt)) + (check-equal? + (get-nutrient-target-values nt) + ntv + "return value of get-nutrient-target-values ≠ nutrient-target-values struct accessor") + (check-equal? (hash-count ntv) 2) + (check-equal? (hash-ref ntv nitrogen) 12.3) + (check-equal? (hash-ref ntv phosphorus) 4.5)) + + (test-case "Retrieve latest target values" + (define nitrogen (get-nutrient #:name "Nitrogen")) + (define phosphorus (get-nutrient #:name "Phosphorus")) + (define second-target-date "2025-09-02") + (create-nutrient-target! second-target-date (hash nitrogen 6.7 phosphorus 8.9)) + + (check-equal? (get-latest-nutrient-target-value nitrogen) 6.7) + (check-equal? (get-latest-nutrient-target-value phosphorus) 8.9)) + + (test-case "Delete target and cascade to target values" + (define nt (get-nutrient-target #:effective-on target-date)) + (delete-nutrient-target! nt) + (check-false (get-nutrient-target #:id (nutrient-target-id nt))) + (check-equal? (length (get-nutrient-targets)) + 1 + "wrong number of nutrient targets were deleted") + (check-true (hash-empty? (get-nutrient-target-values nt))))))) |