From a3e00cb41614056b898d74bafe0f86afb2590c56 Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sat, 29 Nov 2025 18:10:26 +0100 Subject: Main model structs can now be manipulated by id or entire struct. This paves the way to passing ids in URLs, and acting upon them in handlers. --- models/crop-requirement.rkt | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) (limited to 'models/crop-requirement.rkt') diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt index c0eb753..733126e 100644 --- a/models/crop-requirement.rkt +++ b/models/crop-requirement.rkt @@ -13,9 +13,10 @@ (->* () (#:id (or/c #f exact-nonnegative-integer?) #:profile (or/c #f string?)) (or/c crop-requirement? #f))] - [get-crop-requirement-values (-> crop-requirement? nutrient-value-hash/c)] - [get-crop-requirement-value (-> crop-requirement? nutrient? number?)] - [delete-crop-requirement! (-> crop-requirement? void?)] + [get-crop-requirement-values + (-> crop-requirement-or-id/c nutrient-value-hash/c)] + [get-crop-requirement-value (-> crop-requirement-or-id/c nutrient? number?)] + [delete-crop-requirement! (-> crop-requirement-or-id/c void?)] [average-crop-requirement-nutrient-values (-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100)))) nutrient-value-hash/c)])) @@ -32,6 +33,15 @@ #:guard (λ (id profile crop-id nutrient-values _) (values id profile (if (sql-null? crop-id) #f crop-id) nutrient-values))) +(define crop-requirement-id? exact-nonnegative-integer?) + +(define crop-requirement-or-id/c (or/c crop-requirement? crop-requirement-id?)) + +(define (->cr-id cr-or-id) + (match cr-or-id + [(? crop-requirement-id? cr-or-id) cr-or-id] + [(crop-requirement id _ _ _) id])) + ;; CREATE (define (create-crop-requirement! profile nutrient-values [crop #f]) @@ -117,7 +127,7 @@ [(list row) (grouped-row->crop-requirement row)] [many (error 'get-crop-requirement "expected 1 crop requirement, got ~a" (length many))])) -(define (get-crop-requirement-values crop-requirement) +(define (get-crop-requirement-values cr-or-id) (for/hash ([(nutrient-id canonical-name french-name formula value_ppm) (in-query (current-conn) (select n.id @@ -126,23 +136,22 @@ n.formula nv.value_ppm #:from (TableExpr:AST ,joined) - #:where (= cr.id ,(crop-requirement-id crop-requirement))))]) + #:where (= cr.id ,(->cr-id cr-or-id))))]) (values (nutrient nutrient-id canonical-name french-name formula) value_ppm))) -(define (get-crop-requirement-value crop-requirement nutrient) +(define (get-crop-requirement-value cr-or-id nutrient) (query-maybe-value (current-conn) (select value_ppm #:from (TableExpr:AST ,joined) - #:where (and (= cr.id ,(crop-requirement-id crop-requirement)) + #:where (and (= cr.id ,(->cr-id cr-or-id)) (= nv.nutrient_id ,(nutrient-id nutrient)))))) ;; UPDATE ;; DELETE -(define (delete-crop-requirement! crop-requirement) - (define id (crop-requirement-id crop-requirement)) - (query-exec (current-conn) (delete #:from crop_requirements #:where (= id ,id)))) +(define (delete-crop-requirement! cr-or-id) + (query-exec (current-conn) (delete #:from crop_requirements #:where (= id ,(->cr-id cr-or-id))))) ;; Helpers -- cgit v1.2.3