diff options
| -rw-r--r-- | db/migrations.rkt | 20 | ||||
| -rw-r--r-- | handlers.rkt | 2 | ||||
| -rw-r--r-- | models/crop-rotation.rkt | 2 | ||||
| -rw-r--r-- | models/nutrient-target.rkt | 239 | ||||
| -rw-r--r-- | views.rkt | 23 |
5 files changed, 3 insertions, 283 deletions
diff --git a/db/migrations.rkt b/db/migrations.rkt index a0d7b9e..71296f7 100644 --- a/db/migrations.rkt +++ b/db/migrations.rkt @@ -62,36 +62,25 @@ #:if-not-exists nutrient_value_sets #:columns [id integer #:not-null] [nutrient_measurement_id integer] - [nutrient_target_id integer] [crop_requirement_id integer] [fertilizer_product_id integer] #:constraints (primary-key id) (foreign-key nutrient_measurement_id #:references (nutrient_measurements id) #:on-delete #:cascade) - (foreign-key nutrient_target_id #:references (nutrient_targets id) #:on-delete #:cascade) (foreign-key crop_requirement_id #:references (crop_requirements id) #:on-delete #:cascade) (foreign-key fertilizer_product_id #:references (fertilizer_products id) #:on-delete #:cascade) (unique nutrient_measurement_id) - (unique nutrient_target_id) (unique crop_requirement_id) (unique fertilizer_product_id) (check (or (and (is-not-null nutrient_measurement_id) - (is-null nutrient_target_id) (is-null crop_requirement_id) (is-null fertilizer_product_id)) (and (is-null nutrient_measurement_id) - (is-not-null nutrient_target_id) (is-null crop_requirement_id) (is-null fertilizer_product_id)) (and (is-null nutrient_measurement_id) - (is-null nutrient_target_id) (is-not-null crop_requirement_id) - (is-null fertilizer_product_id)) - (and (is-null nutrient_measurement_id) - (is-null nutrient_target_id) - (is-null crop_requirement_id) - (is-not-null fertilizer_product_id))))) + (is-null fertilizer_product_id))))) "CREATE INDEX IF NOT EXISTS idx_nvs_meas ON nutrient_value_sets(nutrient_measurement_id)" - "CREATE INDEX IF NOT EXISTS idx_nvs_targ ON nutrient_value_sets(nutrient_target_id)" "CREATE INDEX IF NOT EXISTS idx_nvs_crop ON nutrient_value_sets(crop_requirement_id)" "CREATE INDEX IF NOT EXISTS idx_nvs_prod ON nutrient_value_sets(fertilizer_product_id)")) @@ -115,13 +104,6 @@ #:constraints (primary-key id) (unique measurement_date)))) -(define-migration "create table nutrient_targets" - (list (create-table #:if-not-exists nutrient_targets - #:columns [id integer #:not-null] - ;; ISO8601 date - [target_date text #:not-null] - #:constraints (primary-key id) - (unique target_date)))) ;;;;;;;; ;; CROPS diff --git a/handlers.rkt b/handlers.rkt index bcd81c7..3798ca2 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -32,7 +32,7 @@ [("ferti" "measurement" "create") #:method "post" create-measurement] [("ferti" "measurement" (integer-arg)) #:method "get" show-measurement] [("ferti" "measurement" "destroy" (integer-arg)) #:method "get" destroy-measurement] - ;; Nutrient targets + ;; Crop rotations [("ferti" "rotation" "new") #:method "get" new-rotation] [("ferti" "rotation" "new" (string-arg)) #:method "get" new-rotation-for-date] [("ferti" "rotation" "create") #:method "post" create-rotation] diff --git a/models/crop-rotation.rkt b/models/crop-rotation.rkt index 37c242f..630e493 100644 --- a/models/crop-rotation.rkt +++ b/models/crop-rotation.rkt @@ -101,7 +101,7 @@ (match grouped-rows ['() #f] [(list grouped-row) (grouped-row->crop-rotation grouped-row)] - [many (error 'get-crop-rotation "expected 1 nutrient target, got ~a" (length many))])) + [many (error 'get-crop-rotation "expected 1 crop rotation, got ~a" (length many))])) (define (get-latest-crop-rotation) (define rotations (get-crop-rotations)) diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt deleted file mode 100644 index bb89273..0000000 --- a/models/nutrient-target.rkt +++ /dev/null @@ -1,239 +0,0 @@ -#lang racket - -(provide nutrient-target - nutrient-target? - nutrient-target-id - (rename-out [nutrient-target-target-date nutrient-target-date] - [nutrient-target-nutrient-values nutrient-target-values]) - (contract-out - [create-nutrient-target! (-> string? nutrient-value-hash/c nutrient-target?)] - [get-nutrient-targets (-> (listof nutrient-target?))] - [get-nutrient-target - (->* () (#:id exact-nonnegative-integer? #:date string?) (or/c nutrient-target? #f))] - [get-nutrient-target-values (-> nutrient-target-or-id/c nutrient-value-hash/c)] - [get-nutrient-target-value (-> nutrient-target-or-id/c nutrient? maybe-nutrient-value?)] - [get-latest-nutrient-target-value (-> nutrient? maybe-nutrient-value?)] - [get-latest-nutrient-target-values (-> nutrient-value-hash/c)] - [delete-nutrient-target! (-> nutrient-target-or-id/c void?)])) - -(require racket/contract - db - sql - "../db/conn.rkt" - "nutrient.rkt") - -(struct nutrient-target (id target-date nutrient-values) - #:transparent - #:property prop:custom-write - (λ (v out _) - (fprintf out "Target #~a on ~a\n" (nutrient-target-id v) (nutrient-target-target-date v)) - (for ([(n v) (in-hash (nutrient-target-nutrient-values v))]) - (fprintf out - "~a ~a\n" - (~a (nutrient-canonical-name n) #:min-width 14) - (~a v #:max-width 6 #:align 'right))))) - -(define nutrient-target-id? exact-nonnegative-integer?) -(define nutrient-target-or-id/c (or/c nutrient-target? nutrient-target-id?)) - -(define (->nt-id nt-or-id) - (match nt-or-id - [(? nutrient-target-id? id) id] - [(nutrient-target id _ _) id])) - -;; CREATE - -(define (create-nutrient-target! target-date nutrient-values) - (or (get-nutrient-target #:date target-date) - (with-tx - (query-exec (current-conn) (insert #:into nutrient_targets #:set [target_date ,target-date])) - (define nt-id - (query-value (current-conn) - (select id #:from nutrient_targets #:where (= target_date ,target-date)))) - (query-exec (current-conn) - (insert #:into nutrient_value_sets #:set [nutrient_target_id ,nt-id])) - (define nvs-id - (query-value (current-conn) - (select id #:from nutrient_value_sets #:where (= nutrient_target_id ,nt-id)))) - (for ([(n v) (in-hash nutrient-values)]) - (query-exec (current-conn) - (insert #:into nutrient_values - #:set [value_set_id ,nvs-id] - [nutrient_id ,(nutrient-id n)] - [value_ppm ,v]))) - (get-nutrient-target #:date target-date)))) - -;; READ - -(define joined - (table-expr-qq (inner-join (inner-join (inner-join (as nutrient_targets nt) - (as nutrient_value_sets nvs) - #:on (= nvs.nutrient_target_id nt.id)) - (as nutrient_values nv) - #:on (= nv.value_set_id nvs.id)) - (as nutrients n) - #:on (= n.id nv.nutrient_id)))) - -(define (grouped-row->nutrient-target grouped-row) - (match-define (vector nt-id target-date residuals) grouped-row) - (nutrient-target nt-id target-date (residuals->nutrient-value-hash residuals))) - -(define (get-nutrient-targets) - (define grouped-rows - (query-rows (current-conn) - (select nt.id - nt.target_date - n.id - n.canonical_name - n.french_name - n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by nt.target_date - #:desc) - #:group '#(0 1))) - (map grouped-row->nutrient-target grouped-rows)) - -(define (get-nutrient-target #:id [nt-id #f] #:date [target-date #f]) - (define where - (cond - [(and nt-id target-date) - (scalar-expr-qq (and (= nt.id ,nt-id) (= nt.target_date ,target-date)))] - [nt-id (scalar-expr-qq (= nt.id ,nt-id))] - [target-date (scalar-expr-qq (= nt.target_date ,target-date))] - [else (error 'get-nutrient-target "either #:id or #:date must be provided")])) - (define grouped-rows - (query-rows (current-conn) - (select nt.id - nt.target_date - n.id - n.canonical_name - n.french_name - n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:where (ScalarExpr:AST ,where) - #:order-by nt.target_date - #:desc) - #:group '#(0 1))) - (match grouped-rows - ['() #f] - [(list grouped-row) (grouped-row->nutrient-target grouped-row)] - [many (error 'get-nutrient-target "expected 1 nutrient target, got ~a" (length many))])) - -(define (get-nutrient-target-values nt-or-id) - (for/hash ([(nutrient-id canonical-name french-name formula value_ppm) - (in-query (current-conn) - (select n.id - n.canonical_name - n.french_name - n.formula - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:where (= nt.id ,(->nt-id nt-or-id))))]) - (values (nutrient nutrient-id canonical-name french-name formula) value_ppm))) - -(define (get-nutrient-target-value nt-or-id nutrient) - (query-maybe-value (current-conn) - (select value_ppm - #:from (TableExpr:AST ,joined) - #:where (and (= nt.id ,(->nt-id nt-or-id)) - (= nv.nutrient_id ,(nutrient-id nutrient)))))) - -(define (get-latest-nutrient-target-value nutrient) - (query-maybe-value (current-conn) - (select value_ppm - #:from (TableExpr:AST ,joined) - #:where (= nv.nutrient_id ,(nutrient-id nutrient)) - #:order-by nt.target_date - #:desc - #:limit 1))) - -(define (get-latest-nutrient-target-values) - (define grouped-rows - (query-rows (current-conn) - (select n.id - n.canonical_name - n.french_name - n.formula - nt.target_date - nv.value_ppm - #:from (TableExpr:AST ,joined) - #:order-by nt.target_date - #:desc) - #:group '(#(0 1 2 3)))) - (for/hash ([row grouped-rows]) - (match-define (vector n-id n-canonical-name n-french-name n-formula residual-rows) row) - ;; residual-rows is a non-empty list of vectors: #(target_date value_ppm) - (match-define (vector _ value-ppm) (first residual-rows)) - (values (nutrient n-id n-canonical-name n-french-name n-formula) value-ppm))) - -;; UPDATE - -;; DELETE - -(define (delete-nutrient-target! nt-or-id) - (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 #:date target-date)) - (check-true (nutrient-target? nt)) - (check-equal? (nutrient-target-target-date 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 #:date 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 #:date 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))))))) @@ -134,29 +134,6 @@ "Ajouter un relevé")) ,table))) -#; -(define (ferti-targets-page latest-measurement-hash latest-target-hash) - (define table - `(table ((class "table")) - (thead (tr (th "Nutriment") - (th ((class "text-end")) "Dernier Relevé") - (th ((class "text-end")) "Dernière Cible"))) - (tbody ,@(for/list ([n (get-nutrients)]) - (define latest-measurement (hash-ref latest-measurement-hash n #f)) - (define latest-target (hash-ref latest-target-hash n #f)) - `(tr (td ,(nutrient-french-name n)) - (td ((class "text-end font-monospace")) - ,(if latest-measurement - (round 2 latest-measurement) - "—")) - (td ((class "text-end font-monospace")) - ,(if latest-target - (round 2 latest-target) - "—"))))))) - (ferti-template `((h2 () "Dernière Cible") - (a ((class "btn btn-primary mb-3") [href "/ferti/target/new"]) "Créer une cible") - ,table))) - (define (ferti-recipe-page recipe-date fertilizer-recipe) (define table `(table ((class "table")) |