Update views to reflect model evolution.

1 files changed, 73 insertions, 44 deletions

diff --git a/views.rkt b/views.rkt
index 1d13049..177770e 100644
--- a/views.rkt
+++ b/views.rkt
@@ -6,10 +6,10 @@
          ferti-recipe-page
          ferti-fertilizers-page
          new-measurement-page
-         new-target-page
+         new-rotation-page
          new-fertilizer-page
          show-measurement-page
-         show-target-page
+         show-rotation-page
          show-fertilizer-page
          fallback-page)
 
@@ -19,8 +19,8 @@
          "models/user.rkt"
          "models/nutrient.rkt"
          "models/nutrient-measurement.rkt"
-         "models/nutrient-target.rkt"
          "models/crop-rotation.rkt"
+         "models/crop-requirement.rkt"
          "models/fertilizer-product.rkt")
 
 (define (page-template title body-xexpr)
@@ -73,6 +73,9 @@
 (define (round n number)
   (~r number #:precision `(= ,n)))
 
+(define (normal-date date-string)
+  (~t (iso8601->date date-string) "dd/MM/yyyy"))
+
 ;; Pages
 
 (define (ferti-template body-xexpr)
@@ -84,7 +87,7 @@
            (a ((class "nav-link") (aria-current "page") (href "/ferti/index")) "Accueil"))
        (li ((class "nav-item"))
            (a ((class "nav-link") (aria-current "page") (href "/ferti/measurements-and-rotations"))
-              "Relevés & Cibles"))
+              "Relevés & Assolements"))
        (li ((class "nav-item"))
            (a ((class "nav-link") (aria-current "page") (href "/ferti/fertilizers")) "Intrants"))
        #;(li ((class "nav-item"))
@@ -95,13 +98,13 @@
    `((p "La recette Ferti© est calculée en fonction d'un relevé de nutriments et d'une cible.")
      (div ((class "btn-group-vertical"))
           (a ((class "btn btn-outline-primary") [href "/ferti/measurement/new"]) "Ajouter un relevé")
-          (a ((class "btn btn-outline-primary") [href "/ferti/target/new"]) "Créer une cible")
+          (a ((class "btn btn-outline-primary") [href "/ferti/rotation/new"]) "Ajouter un assolement")
           (a ((class "btn btn-outline-primary") [href "/ferti/fertilizer/new"])
              "Ajouter un intrant")))))
 
 (define (ferti-measurements-and-rotations-page nutrients measurements rotations)
   (define (maybe-rotation-for-measurement m)
-    (findf (λ (r) (= (crop-rotation-measurement-id r) (nutrient-measurement-id m))) rotations))
+    (findf (λ (r) (equal? (crop-rotation-date r) (nutrient-measurement-date m))) rotations))
   (define table
     `(table
       ((class "table"))
@@ -109,8 +112,7 @@
       (tbody
        ,@(for/list ([m measurements])
            (define maybe-rotation (maybe-rotation-for-measurement m))
-           `(tr (td ((class "font-monospace"))
-                    ,(~t (iso8601->date (nutrient-measurement-date m)) "dd/MM/yyyy"))
+           `(tr (td ((class "font-monospace")) ,(normal-date (nutrient-measurement-date m)))
                 (td (a ((class "btn btn-outline-secondary btn-sm")
                         (href ,(format "/ferti/measurement/~a" (nutrient-measurement-id m))))
                        "Modifier"))
@@ -118,7 +120,8 @@
                          `(a ((class "btn btn-outline-secondary btn-sm")
                               (href ,(format "/ferti/rotation/~a" (crop-rotation-id maybe-rotation))))
                              "Modifier")
-                         `(a ((class "btn btn-outline-primary btn-sm") (href "/ferti/rotation/new"))
+                         `(a ((class "btn btn-outline-primary btn-sm")
+                              (href ,(format "/ferti/rotation/new/~a" (nutrient-measurement-date m))))
                              "Ajouter")))
                 (td ,(if maybe-rotation
                          `(a ((class "btn btn-outline-secondary btn-sm")
@@ -126,10 +129,9 @@
                              "Consulter")
                          "—")))))))
   (ferti-template
-   `((h2 () "Relevés")
+   `((h2 () "Relevés & Assolements")
      (div ((class "btn-group mb-3"))
           (a ((class "btn btn-primary") [href "/ferti/measurement/new"]) "Ajouter un relevé")
-          #;(a ((class "btn btn-secondary") [href "/ferti/target/new"]) "Créer une cible"))
      ,table)))
 
 #;
@@ -155,37 +157,32 @@
                     (a ((class "btn btn-primary mb-3") [href "/ferti/target/new"]) "Créer une cible")
                     ,table)))
 
-(define (ferti-recipe-page fertilizer-recipe)
+(define (ferti-recipe-page recipe-date fertilizer-recipe)
   (define table
     `(table ((class "table"))
-            (thead (tr (th "Intrant") (th ((class "text-end")) "Quantité (g/L)")))
-            (tbody ,@(for/list ([fertilizer-amount fertilizer-recipe]
-                                #:when (not (zero? (cdr fertilizer-amount))))
-                       (match-define (cons fertilizer amount) fertilizer-amount)
+            (thead (tr (th "Intrant") (th ((class "text-end")) "Quantité (g)")))
+            (tbody ,@(for/list ([(fertilizer quantity) (in-hash fertilizer-recipe)]
+                                #:when (not (zero? quantity)))
                        `(tr (td ()
-                                ,(let ([canonical-name (fertilizer-name fertilizer)]
+                                ,(let ([canonical-name (fertilizer-product-name fertilizer)]
                                        [brand-name (fertilizer-brand-name fertilizer)])
                                    (if brand-name
                                        (format "~a (~a)" brand-name canonical-name)
                                        canonical-name)))
-                            (td ((class "text-end font-monospace")) ,(round 2 amount)))))))
-  (ferti-template `((h2 () "Recette")
-                    ,(if (ormap (λ (pair) (not (zero? (cdr pair)))) fertilizer-recipe)
-                         table
-                         `(p "La recette Ferti requiert au moins un relevé et une cible.")))))
+                            (td ((class "text-end font-monospace")) ,(round 2 (* 100 quantity))))))))
+  (ferti-template `((h2 () ,(format "Recette du ~a" (normal-date recipe-date)))
+                    (p "Quantités calculées pour 100'000 L.")
+                    ,table)))
 
 (define (ferti-fertilizers-page fertilizers)
-  (define (delete-button-for fp)
-    `(a ((class "btn btn-outline-danger btn-sm")
-         [href ,(format "/ferti/fertilizer/destroy/~a" (fertilizer-product-id fp))])
-        "Supprimer"))
   (define table
     `(table ((class "table table-striped"))
-            (tr (th () "Nom de référence") (th () "Nom de marque") (th () "Actions"))
-            ,@(for/list ([fertilizer fertilizers])
-                `(tr (td ,(fertilizer-name fertilizer))
-                     (td ,(or (fertilizer-brand-name fertilizer) "—"))
-                     (td ,(delete-button-for fertilizer))))))
+            (tr (th () "Nom de référence") (th () "Nom de marque"))
+            ,@
+            (for/list ([fertilizer fertilizers])
+              `(tr (td (a ([href ,(format "/ferti/fertilizer/~a" (fertilizer-product-id fertilizer))])
+                          ,(fertilizer-product-name fertilizer)))
+                   (td ,(or (fertilizer-brand-name fertilizer) "—"))))))
   (ferti-template `((h2 () "Intrants") (a ((class "btn btn-primary mb-3") [href
                                                                            "/ferti/fertilizer/new"])
                                           "Ajouter un intrant")
@@ -198,12 +195,12 @@
                         (form ([action "/ferti/measurement/create"] [method "POST"])
                               ,@(formlet-display (measurements-formlet)))))))
 
-(define (new-target-page)
-  (page-template "Nouvelle cible"
-                 `((h1 ((class "display-1 mb-3")) "Nouvelle cible")
+(define (new-rotation-page #:date [date-string #f])
+  (page-template "Nouvel assolement"
+                 `((h1 ((class "display-1 mb-3")) "Nouvel assolement")
                    (div ((class "mb-3") [style "max-width: 30em"])
-                        (form ([action "/ferti/target/create"] [method "POST"])
-                              ,@(formlet-display (targets-formlet)))))))
+                        (form ([action "/ferti/rotation/create"] [method "POST"])
+                              ,@(formlet-display (rotation-formlet #:date date-string)))))))
 
 (define (new-fertilizer-page)
   (page-template "Nouvel intrant"
@@ -213,23 +210,55 @@
                               ,@(formlet-display (fertilizer-formlet)))))))
 
 (define (show-measurement-page nm)
-  (define title (format "Relevé du ~a" (nutrient-measurement-date nm)))
+  (define title (format "Relevé du ~a" (normal-date (nutrient-measurement-date nm))))
   (define table
     `(table ((class "table"))
-            (thead (tr (th "Nutriment") (th ((class "text-end")) "Valeur de ce relevé")))
+            (thead (tr (th "Nutriment") (th ((class "text-end")) "Valeur de ce relevé (mg/L)")))
             (tbody ,@(for/list ([n (get-nutrients)])
                        (define nutrient-value (hash-ref (nutrient-measurement-values nm) n 0))
                        `(tr (td ,(nutrient-french-name n))
                             (td ((class "text-end font-monospace")) ,(round 2 nutrient-value)))))))
-  (page-template title `((h1 ((class "display-1 mb-3")) ,title) ,table)))
+  (page-template title
+                 `((h1 ((class "display-1 mb-3")) ,title)
+                   (a ((class "btn btn-danger")
+                       [href ,(format "/ferti/measurement/destroy/~a" (nutrient-measurement-id nm))])
+                      "Supprimer relevé")
+                   ,table)))
 
-(define (show-target-page nt)
-  (page-template (format "Cible ~a" (nutrient-target-id nt))
-                 '((h1 ((class "display-1 mb-3")) "Cible"))))
+(define (show-rotation-page cr)
+  (define title (format "Assolement du ~a" (normal-date (crop-rotation-date cr))))
+  (define table
+    `(table ((class "table"))
+            (thead (tr (th "Type de culture") (th ((class "text-end")) "Proportion (%)")))
+            (tbody ,@(for/list ([requirement (get-crop-requirements)])
+                       (define requirement-proportion
+                         (hash-ref (crop-rotation-requirements cr) requirement 0))
+                       `(tr (td ,(crop-requirement-profile requirement))
+                            (td ((class "text-end font-monospace"))
+                                ,(round 2 requirement-proportion)))))))
+  (page-template
+   title
+   `((h1 ((class "display-1 mb-3")) ,title)
+     (a ((class "btn btn-danger") [href ,(format "/ferti/rotation/destroy/~a" (crop-rotation-id cr))])
+        "Supprimer assolement")
+     ,table)))
 
 (define (show-fertilizer-page fp)
-  (page-template (format "Intrant ~a" (fertilizer-product-id fp))
-                 '((h1 ((class "display-1 mb-3")) "Intrant"))))
+  (define title (fertilizer-product-name fp))
+  (define table
+    `(table ((class "table"))
+            (thead (tr (th "Nutriment") (th ((class "text-end")) "Apport (mg/L)")))
+            (tbody ,@(for/list ([n (get-nutrients)])
+                       (define nutrient-value (hash-ref (fertilizer-product-values fp) n 0))
+                       `(tr (td ,(nutrient-french-name n))
+                            (td ((class "text-end font-monospace")) ,(round 2 nutrient-value)))))))
+
+  (page-template title
+                 `((h1 ((class "display-1 mb-3")) ,title)
+                   (a ((class "btn btn-danger")
+                       [href ,(format "/ferti/fertilizer/destroy/~a" (fertilizer-product-id fp))])
+                      "Supprimer")
+                   ,table)))
 
 (define (index-page user)
   (page-template