diff options
| -rw-r--r-- | handlers.rkt | 6 | ||||
| -rw-r--r-- | models/fertilizer-product.rkt | 15 | ||||
| -rw-r--r-- | views.rkt | 64 |
3 files changed, 59 insertions, 26 deletions
diff --git a/handlers.rkt b/handlers.rkt index 0fe131f..5ff000e 100644 --- a/handlers.rkt +++ b/handlers.rkt @@ -9,7 +9,8 @@ "formlets.rkt" "models/nutrient-measurement.rkt" "models/nutrient-target.rkt" - "models/crop-requirement.rkt") + "models/crop-requirement.rkt" + "services/nnls.rkt") (define-values (app-dispatch _) (dispatch-rules @@ -26,9 +27,10 @@ (define (index _) (define measurements (get-nutrient-measurements)) + (define ferti-recipe (find-ferti-recipe)) (response/xexpr #:preamble #"<!DOCTYPE html>" - (index-page measurements))) + (index-page measurements ferti-recipe))) ;; Nutrient measurements diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt index b93f082..2322cc0 100644 --- a/models/fertilizer-product.rkt +++ b/models/fertilizer-product.rkt @@ -4,9 +4,11 @@ ;; Struct definitions fertilizer-product fertilizer-product? - fertilizer-product-id fertilizer-product-brand-name + fertilizer-product-id (rename-out - [fertilizer-product-nutrient-values fertilizer-product-values]) + [fertilizer-product-canonical-name fertilizer-name] + [fertilizer-product-nutrient-values fertilizer-product-values] + [fertilizer-product-brand-name fertilizer-brand-name]) ;; SQL CRUD (contract-out [create-fertilizer-product! (->* (string? @@ -167,11 +169,10 @@ (acc canonical-name brand-name (list nv-pair))))) - (and A - (fertilizer-product the-id - (acc-canonical-name A) - (reverse (acc-pairs A)) - (acc-brand-name A)))])) + (fertilizer-product the-id + (acc-canonical-name A) + (reverse (acc-pairs A)) + (acc-brand-name A))])) (define (get-fertilizer-product-values fertilizer-product) (for/list ([(nutrient-id name formula value_ppm) @@ -9,7 +9,8 @@ "formlets.rkt" "models/nutrient.rkt" "models/nutrient-measurement.rkt" - "models/nutrient-target.rkt") + "models/nutrient-target.rkt" + "models/fertilizer-product.rkt") (define (page-template title body-xexpr) @@ -67,15 +68,37 @@ ;; Page helpers (define (round n number) - (~r number #:precision n)) + (~r number #:precision `(= ,n))) ;; Pages -(define (index-page measurements) +(define (index-page measurements ferti-recipe) (page-template "Ferti" `((h1 ([class "display-1 mb-3"]) "Ferti") + + + ;;;;;;;; + ;; Ferti + ;;;;;;;; + + (h2 () "Recette") + (table ([class "table"]) + (tr (th () "Produit Fertilisant") + (th ([class "text-end"]) "Quantité")) + ,@(for/list ([fertilizer-amount ferti-recipe] + #:when (not (zero? (cdr fertilizer-amount)))) + (match-define (cons fertilizer amount) fertilizer-amount) + `(tr (td () ,(fertilizer-name fertilizer)) + (td ([class "text-end font-monospace"]) ,(round 2 amount))))) + + + ;;;;;;;;; + ;; Cibles + ;;;;;;;;; + + (h2 () "Dernière Cible") (a ([class "btn btn-primary mb-3"] [href "/target/new"]) "Créer une cible") (table ([class "table"]) (tr (th "Nutriment") @@ -85,22 +108,29 @@ ,@(for/list ([n (get-nutrients)]) (define latest-target (get-latest-nutrient-target-value n)) (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] - [(number? latest-target) - (* 100 - (/ (- latest-target latest-measurement) - latest-measurement))])) + (define delta-percentage + (cond + [(false? latest-target) + #f] + [(zero? latest-target) + -100] + [(zero? latest-measurement) + 100] + [(number? latest-target) + (* 100 + (/ (- latest-target latest-measurement) + latest-measurement))])) `(tr (td ,(nutrient-name n)) - (td ([class "text-end"]) ,(if latest-measurement (round 2 latest-measurement) "—")) - (td ([class "text-end"]) ,(if latest-target (round 2 latest-target) "—")) - (td ([class "text-end"]) ,(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 + ;;;;;;;;;; + (h2 () "Relevés") (a ([class "btn btn-primary mb-3"] [href "/measurement/new"]) "Ajouter un relevé") (table ([class "table table-striped"]) (tr (th "Date") |