diff options
| -rw-r--r-- | models/crop-requirement.rkt | 47 | ||||
| -rw-r--r-- | models/crop.rkt | 2 | ||||
| -rw-r--r-- | models/fertilizer-product.rkt | 7 | ||||
| -rw-r--r-- | models/nutrient-measurement.rkt | 42 | ||||
| -rw-r--r-- | models/nutrient-target.rkt | 44 | ||||
| -rw-r--r-- | models/nutrient.rkt | 3 | ||||
| -rw-r--r-- | models/user.rkt | 4 | ||||
| -rw-r--r-- | views.rkt | 30 |
8 files changed, 78 insertions, 101 deletions
diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt index 8d99434..f6193bf 100644 --- a/models/crop-requirement.rkt +++ b/models/crop-requirement.rkt @@ -1,6 +1,5 @@ #lang racket -;; Model struct (provide crop-requirement crop-requirement? crop-requirement-id @@ -8,7 +7,6 @@ crop-requirement-crop-id (rename-out [crop-requirement-nutrient-values crop-requirement-values]) (contract-out - ;; SQL CRUD [create-crop-requirement! (->* (string? (listof nutrient-value-pair/c)) ((or/c #f crop?)) crop-requirement?)] [get-crop-requirements (-> (listof crop-requirement?))] @@ -18,9 +16,7 @@ (or/c crop-requirement? #f))] [get-crop-requirement-values (-> crop-requirement? (listof nutrient-value-pair/c))] [get-crop-requirement-value (-> crop-requirement? nutrient? number?)] - [get-latest-crop-requirement-value (-> nutrient? number?)] [delete-crop-requirement! (-> crop-requirement? void?)] - ;; Helpers [average-crop-requirement-nutrient-values (-> (listof (cons/c crop-requirement? (and/c real? (>=/c 0) (<=/c 100)))) (listof nutrient-value-pair/c))])) @@ -39,27 +35,28 @@ ;; CREATE (define (create-crop-requirement! profile nutrient-values [crop #f]) - (or (get-crop-requirement #:profile profile) - (with-tx - (query-exec - (current-conn) - (if crop - (insert #:into crop_requirements #:set [crop_id ,(crop-id crop)] [profile ,profile]) - (insert #:into crop_requirements #:set [profile ,profile]))) - (define cr-id (crop-requirement-id (get-crop-requirement #:profile profile))) - (query-exec (current-conn) - (insert #:into nutrient_value_sets #:set [crop_requirement_id ,cr-id])) - (define nvs-id - (query-value (current-conn) - (select id #:from nutrient_value_sets #:where (= crop_requirement_id ,cr-id)))) - (for ([nv nutrient-values]) - (match-define (cons n v) nv) - (query-exec (current-conn) - (insert #:into nutrient_values - #:set [value_set_id ,nvs-id] - [nutrient_id ,(nutrient-id n)] - [value_ppm ,v]))) - (get-crop-requirement #:profile profile)))) + (or + (get-crop-requirement #:profile profile) + (with-tx + (query-exec + (current-conn) + (if crop + (insert #:into crop_requirements #:set [crop_id ,(crop-id crop)] [profile ,profile]) + (insert #:into crop_requirements #:set [profile ,profile]))) + (define cr-id + (query-value (current-conn) (select id #:from crop_requirements #:where (= profile ,profile)))) + (query-exec (current-conn) (insert #:into nutrient_value_sets #:set [crop_requirement_id ,cr-id])) + (define nvs-id + (query-value (current-conn) + (select id #:from nutrient_value_sets #:where (= crop_requirement_id ,cr-id)))) + (for ([nv nutrient-values]) + (match-define (cons n v) nv) + (query-exec (current-conn) + (insert #:into nutrient_values + #:set [value_set_id ,nvs-id] + [nutrient_id ,(nutrient-id n)] + [value_ppm ,v]))) + (get-crop-requirement #:profile profile)))) ;; READ diff --git a/models/crop.rkt b/models/crop.rkt index edbb7a3..44a38ce 100644 --- a/models/crop.rkt +++ b/models/crop.rkt @@ -1,11 +1,9 @@ #lang racket -;; Model struct (provide crop crop? crop-id crop-name - ;; SQL CRUD (contract-out [create-crop! (-> string? crop?)] [get-crops (-> (listof crop?))] [get-crop diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt index 225af10..d4006ac 100644 --- a/models/fertilizer-product.rkt +++ b/models/fertilizer-product.rkt @@ -1,6 +1,5 @@ #lang racket -;; Model struct (provide fertilizer-product fertilizer-product? fertilizer-product-id @@ -8,7 +7,6 @@ [fertilizer-product-nutrient-values fertilizer-product-values] [fertilizer-product-brand-name fertilizer-brand-name]) (contract-out - ;; SQL CRUD [create-fertilizer-product! (->* (string? (listof nutrient-value-pair/c)) (string?) fertilizer-product?)] [get-fertilizer-products (-> (listof fertilizer-product?))] @@ -26,7 +24,6 @@ "../db/conn.rkt" "nutrient.rkt") -;; Instances of this struct are persisted in the fertilizer_products table. (struct fertilizer-product (id canonical-name nutrient-values brand-name) #:transparent #:guard (λ (id canonical-name nutrient-values brand-name _) @@ -161,14 +158,14 @@ n.formula nv.value_ppm #:from (TableExpr:AST ,joined) - #:where (= nm.id ,(fertilizer-product-id fertilizer-product))))]) + #:where (= fp.id ,(fertilizer-product-id fertilizer-product))))]) (cons (nutrient nutrient-id name formula) value_ppm))) (define (get-fertilizer-product-value fertilizer-product nutrient) (query-maybe-value (current-conn) (select value_ppm #:from (TableExpr:AST ,joined) - #:where (and (= nm.id ,(fertilizer-product-id fertilizer-product)) + #:where (and (= fp.id ,(fertilizer-product-id fertilizer-product)) (= nv.nutrient_id ,(nutrient-id nutrient)))))) ;; UPDATE diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt index 5b999d8..1cabf63 100644 --- a/models/nutrient-measurement.rkt +++ b/models/nutrient-measurement.rkt @@ -1,28 +1,23 @@ #lang racket -(provide - ;; Model struct - nutrient-measurement - nutrient-measurement? - nutrient-measurement-id - (rename-out - [nutrient-measurement-measured-on nutrient-measurement-date] - [nutrient-measurement-nutrient-values nutrient-measurement-values]) - (contract-out - ;; SQL CRUD - [create-nutrient-measurement! (-> string? - (listof nutrient-value-pair/c) - nutrient-measurement?)] - [get-nutrient-measurements (-> (listof nutrient-measurement?))] - [get-nutrient-measurement (->* () - (#:id (or/c #f exact-nonnegative-integer?) - #:measured-on (or/c #f string?)) - (or/c nutrient-measurement? #f))] - [get-nutrient-measurement-values (-> nutrient-measurement? - (listof nutrient-value-pair/c))] - [get-nutrient-measurement-value (-> nutrient-measurement? nutrient? number?)] - [get-latest-nutrient-measurement-value (-> nutrient? (or/c number? #f))] - [delete-nutrient-measurement! (-> nutrient-measurement? void?)])) +(provide nutrient-measurement + nutrient-measurement? + nutrient-measurement-id + (rename-out [nutrient-measurement-measured-on nutrient-measurement-date] + [nutrient-measurement-nutrient-values nutrient-measurement-values]) + (contract-out + [create-nutrient-measurement! + (-> string? (listof nutrient-value-pair/c) nutrient-measurement?)] + [get-nutrient-measurements (-> (listof nutrient-measurement?))] + [get-nutrient-measurement + (->* () + (#:id (or/c #f exact-nonnegative-integer?) #:measured-on (or/c #f string?)) + (or/c nutrient-measurement? #f))] + [get-nutrient-measurement-values (-> nutrient-measurement? (listof nutrient-value-pair/c))] + [get-nutrient-measurement-value (-> nutrient-measurement? nutrient? number?)] + [get-latest-nutrient-measurement-value (-> nutrient? (or/c number? #f))] + [get-latest-nutrient-measurement-hash (-> (hash/c nutrient? number?))] + [delete-nutrient-measurement! (-> nutrient-measurement? void?)])) (require racket/contract db @@ -30,7 +25,6 @@ "../db/conn.rkt" "nutrient.rkt") -;; Instances of this struct are persisted in the nutrient_measurements table. (struct nutrient-measurement (id measured-on nutrient-values) #:transparent #:property prop:custom-write diff --git a/models/nutrient-target.rkt b/models/nutrient-target.rkt index 922dba7..77d0b4c 100644 --- a/models/nutrient-target.rkt +++ b/models/nutrient-target.rkt @@ -1,27 +1,22 @@ #lang racket -(provide - ;; Model struct - nutrient-target - nutrient-target? - nutrient-target-id - (rename-out - [nutrient-target-effective-on nutrient-target-date] - [nutrient-target-nutrient-values nutrient-target-values]) - (contract-out - ;; SQL CRUD - [create-nutrient-target! (-> string? - (listof nutrient-value-pair/c) - nutrient-target?)] - [get-nutrient-targets (-> (listof nutrient-target?))] - [get-nutrient-target (->* () - (#:id (or/c #f exact-nonnegative-integer?) - #:effective-on (or/c #f string?)) - (or/c nutrient-target? #f))] - [get-nutrient-target-values (-> nutrient-target? (listof nutrient-value-pair/c))] - [get-nutrient-target-value (-> nutrient-target? nutrient? number?)] - [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))] - [delete-nutrient-target! (-> nutrient-target? void?)])) +(provide nutrient-target + nutrient-target? + nutrient-target-id + (rename-out [nutrient-target-effective-on nutrient-target-date] + [nutrient-target-nutrient-values nutrient-target-values]) + (contract-out + [create-nutrient-target! (-> string? (listof nutrient-value-pair/c) nutrient-target?)] + [get-nutrient-targets (-> (listof nutrient-target?))] + [get-nutrient-target + (->* () + (#:id (or/c #f exact-nonnegative-integer?) #:effective-on (or/c #f string?)) + (or/c nutrient-target? #f))] + [get-nutrient-target-values (-> nutrient-target? (listof nutrient-value-pair/c))] + [get-nutrient-target-value (-> nutrient-target? nutrient? number?)] + [get-latest-nutrient-target-value (-> nutrient? (or/c number? #f))] + [get-latest-nutrient-target-hash (-> (hash/c nutrient? number?))] + [delete-nutrient-target! (-> nutrient-target? void?)])) (require racket/contract db @@ -29,7 +24,6 @@ "../db/conn.rkt" "nutrient.rkt") -;; Instances of this struct are persisted in the nutrient_targets table. (struct nutrient-target (id effective-on nutrient-values) #:transparent #:property prop:custom-write @@ -143,14 +137,14 @@ n.formula nv.value_ppm #:from (TableExpr:AST ,joined) - #:where (= nm.id ,(nutrient-target-id nutrient-target))))]) + #:where (= nt.id ,(nutrient-target-id nutrient-target))))]) (cons (nutrient nutrient-id name formula) value_ppm))) (define (get-nutrient-target-value nutrient-target nutrient) (query-maybe-value (current-conn) (select value_ppm #:from (TableExpr:AST ,joined) - #:where (and (= nm.id ,(nutrient-target-id nutrient-target)) + #:where (and (= nt.id ,(nutrient-target-id nutrient-target)) (= nv.nutrient_id ,(nutrient-id nutrient)))))) (define (get-latest-nutrient-target-value nutrient) diff --git a/models/nutrient.rkt b/models/nutrient.rkt index 49921d7..91be68f 100644 --- a/models/nutrient.rkt +++ b/models/nutrient.rkt @@ -1,14 +1,11 @@ #lang racket -;; Model struct (provide nutrient nutrient? nutrient-id nutrient-name nutrient-formula - ;; Contracts nutrient-value-pair/c - ;; SQL CRUD (contract-out [create-nutrient! (-> string? string? nutrient?)] [get-nutrients (-> (listof nutrient?))] [get-nutrient diff --git a/models/user.rkt b/models/user.rkt index 45ca154..526ea20 100644 --- a/models/user.rkt +++ b/models/user.rkt @@ -1,13 +1,11 @@ #lang racket -;; Model struct (provide user user? user-id user-name user-role - ;; SQL CRUD - (contract-out [get-current-user (-> (or/c user? #f))] #;[delete-user! (-> user? void?)])) + (contract-out [get-current-user (-> (or/c user? #f))])) (require racket/contract db @@ -116,22 +116,24 @@ (define latest-measurement (get-latest-nutrient-measurement-value n)) (define delta-percentage (cond - [(false? latest-target) - #f] - [(zero? latest-target) - -100] - [(zero? latest-measurement) - 100] + [(false? latest-target) #f] + [(zero? latest-target) -100] + [(zero? latest-measurement) 100] [(number? latest-target) - (* 100 - (/ (- latest-target latest-measurement) - latest-measurement))])) + (* 100 (/ (- latest-target latest-measurement) latest-measurement))])) `(tr (td ,(nutrient-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) "—")) - (td ([class "text-end font-monospace"]) ,(if delta-percentage (round 1 delta-percentage) "—"))))) - - + (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) + "—")) + (td ((class "text-end font-monospace")) + ,(if delta-percentage + (round 1 delta-percentage) + "—"))))) ;;;;;;;;;; ;; Relevés ;;;;;;;;;; |