[Racket] Ferti hydroponic nutrient solver, redux.

Absorb existing domain data.

Commit
3008eb25f79ef1ed54fcc2b3f5b6635b34394680
Author
Marius Peter <dev@marius-peter.com>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
.gitignore
index 00000000..55cf0fd8 000000..100644
@@ -0,0 +1,6 @@
1 Added: # Compilation artifacts
2 Added: compiled/
3 Added: # Backup files
4 Added: *~
5 Added: # SQLite3 database
6 Added: *.sqlite
db/conn.rkt
index 00000000..e083d940 000000..100644
@@ -0,0 +1,41 @@
1 Added: #lang racket
2 Added:
3 Added: (require db)
4 Added:
5 Added: (provide current-conn
6 Added: connect!
7 Added: disconnect!
8 Added: with-db
9 Added: with-tx)
10 Added:
11 Added: (define current-conn (make-parameter #f))
12 Added:
13 Added: (define (connect! #:path [path 'memory])
14 Added: (cond
15 Added: [(connection? (current-conn))
16 Added: (printf "Database connection already exists: ~e\n" (current-conn))]
17 Added: [else
18 Added: (current-conn (sqlite3-connect #:database path
19 Added: #:mode 'create))
20 Added: (printf "Created database connection at path: ~a\n" path)]))
21 Added:
22 Added: (define (disconnect!)
23 Added: (disconnect (current-conn))
24 Added: (printf "Closing database connection: ~e\n" (current-conn))
25 Added: (current-conn #f))
26 Added:
27 Added: (define-syntax-rule (with-db body ...)
28 Added: (begin (connect!) body ...))
29 Added:
30 Added: (define-syntax-rule (with-tx body ...)
31 Added: (call-with-transaction (current-conn) (λ () body ...)))
32 Added:
33 Added: (module+ test
34 Added: (require rackunit)
35 Added: (check-equal? (current-conn) #f)
36 Added: (connect!)
37 Added: (check-true (connection? (current-conn)))
38 Added: (disconnect!)
39 Added: (check-equal? (current-conn) #f)
40 Added: (with-db
41 Added: (check-true (connection? (current-conn)))))
db/data/dolibarr_crop_requirements_ppm.csv
index 00000000..e9bf8fdc 000000..100644
@@ -0,0 +1,9 @@
1 Added: Plante,Profil,NNO3,P,K,Ca,Mg,S,Na,Cl,Si,Fe,Zn,B,Mn,Cu,Mo,NNH4
2 Added: ,générique croissance,160,30,230,100,30,60,0,0,0,5,0.15,0.3,0.5,0.15,0.05,0
3 Added: ,générique floraison,130,60,300,100,30,60,0,0,0,2,0.1,0.5,0.5,0.05,0.05,0
4 Added: Laitue,générique,190,50,210,200,50,66,0,0,0,5,0.15,0.3,0.5,0.15,0.05,0
5 Added: Tomate,cycle entier,140,50,352,180,50,168,0,0,0,5,0.1,0.3,0.8,0.07,0.03,0
6 Added: Tomate,10-14 jours,100,40,200,100,20,53,0,0,0,3,0.1,0.3,0.8,0.07,0.03,0
7 Added: Tomate,1ère grappe,130,55,300,150,33,109,0,0,0,3,0.1,0.3,0.8,0.07,0.03,0
8 Added: Tomate,à maturité,180,65,400,400,45,144,0,0,0,3,0.1,0.3,0.8,0.07,0.03,0
9 Added: Framboise,tous stades,70,12,88,90,24,48,0,0,50,0.56,0.325,0.11,0.11,0.032,0.01,0
db/data/dolibarr_fertilizer_compositions_percentage.csv
index 00000000..f58042ce 000000..100644
@@ -0,0 +1,18 @@
1 Added: Ref,Libellé,Nom commercial,NNO3,P,K,Ca,Mg,S,Na,Cl,Fe,Zn,B,Mn,Cu,Mo,NNH4
2 Added: Nitrate_de_Potassium,Nitrate de potassium,Multi K Reci,13.50,0,38.60,0,0,0,0.015,0,0,0,0,0,0,0,0
3 Added: Acide_nitrique_53%,Acide nitrique 53%,,11.70,0,0,0,0,0,0,0,0,0,0,0,0,0,0
4 Added: Bicarbonate_de_potassium,Bicarbonate de potassium,,0,0,0,39.05,0,0,0,0,0,0,0,0,0,0,0
5 Added: Boronia_LS,Bore-Molybdène,,0,0,0,0,0,0,0,0,0,13.50,0,0,0,0.028,0
6 Added: Phosphate_de_diammonium,Phosphate de diammonium,DAP 18/46/00,21.00,53.00,0,0,0,0,0,0,0,0,0,0,0,0,0
7 Added: Ferexel_D12,Fer chélaté DTPA,,0,0,0,0,0,0,0,0,0,11.80,0,0,0,0,0
8 Added: Nitrate_de_calcium,Nitrate de calcium,Multi-Cal Haïfa,15.50,0,0,18.94,0,0,0,0,0,0,0,0,0,0,0
9 Added: Sulfate_de_Potassium,Sulfate de potassium,Patenkali,0,22.66,0,0.44,6.16,17.77,2.16,3.34,0,0,0,0,0,0,0
10 Added: Sulfate_de_Manganese,Sulfate de Manganèse,Fixa Mn,0,0,0,0,0,7.17,0,0,0,0,12.00,0,0,0,0
11 Added: Sulfate_de_Magnesium,Sulfate de Magnésium,Eso Top,0,0,0,9.648,13.016,0,0,0,0,0,0,0,0,0,0
12 Added: Nitrate_d_ammonium,Nitrate d’ammonium,,27.00,0,0,0,0,0,0,0,0,0,0,0,0,0,0
13 Added: Carbonate_de_Calcium,Carbonate de Calcium,,0,0,0,38.00,0,0,0,0,0,0,0,0,0,0,0
14 Added: Nitrate_d_ammonium_27kg,Nitrate d’ammonium 27 en 25 kg,Ammonitrate 27,13.50,0,0,0,0,0,0,0,0,0,0,0,0,0,13.5
15 Added: Fixa_Zinc,Fixa Zinc,,0,0,0,0,0,0,0,0,0,0,5.00,0,12.00,0,0
16 Added: HelioCuivre,HelioCuivre,,0,0,0,0,0,0,0,0,0,0,0,40.00,0,0,0
17 Added: Boronia_Molybdène_-_Boronia,Boronia MO12 10L,,0,0,0,0,0,0,0,0,0,0,8.90,0.089,0,0.89,0
18 Added: Molybdate_de_sodium,Molybdate de sodium,,0,0,0,0,0,0,39.50,0,0,0,0,0,0,0,0
db/data/dolibarr_nutrient_measurements_ppm.csv
index 00000000..c5d12e62 000000..100644
@@ -0,0 +1,44 @@
1 Added: date,NNO3,P,K,Ca,Mg,S,Na,Cl,Si,Fe,Zn,B,Mn,Cu,Mo,NNH4
2 Added: 08/05/2021,1.87,0.0031936,0.91,100.79,8.37,1.08666558,6.73,12.28,5.42,0.01,0.01,0.01,0.01,0.01,0.01,0.02
3 Added: 02/07/2021,66.3,0.0095808,110.91,93.09,17.95,32.84663382,10.27,18.53,5.02,4.37,0.03,0.18,0.15,0,0,0.63
4 Added: 12/07/2021,61.66,2.011968,122.53,73.5,17.44,47.64328569,0.45,0.82,0.36,1.76,0.05,0.13,0.32,0,0,0
5 Added: 12/08/2021,67.27,0.351296,94.45,89.48,16.25,9.11665755,10.76,16.51,4.95,3.2,0.03,0.14,0.07,0,0,0.06
6 Added: 06/09/2021,77.8,7.1153408,96.29,86.31,14.21,23.90664276,9.32,14.92,4.61,2.45,0.08,0.12,0.05,0.03,0,0.02
7 Added: 21/09/2021,87.88,11.33728,117.24,90.64,17.25,29.90663676,9.92,15.96,4.68,2.4,0.08,0.27,0.12,0.04,0.01,0.02
8 Added: 19/10/2021,77.84,13.4195072,121.91,94.71,18.3,33.19663347,12.36,15.28,4.47,2.72,0.11,0.74,0.04,0.04,0.02,0.03
9 Added: 01/12/2021,57.09,6.6842048,81.46,61.45,10.52,17.72331561,17.36,23.05,2.11,1.27,0.17,0.32,0.01,0.03,0.02,0.07
10 Added: 04/02/2022,43.56,6.5979776,63.1,63.72,9.92,17.3999826,17.08,21.15,1.44,1.6,0.22,0.34,0.01,0.04,0.01,0.03
11 Added: 12/04/2022,38.36,6.5021696,83.48,49.75,6.42,14.14331919,29.8,38.85,0.23,0.3,0.2,0,0.02,0.01,0.4,0.07
12 Added: 16/05/2022,24.63,0.542912,30.22,39.79,6.75,0.0666666,25.98,25.89,0.14,1.13,0.3,0.23,0.01,0.02,0.005,0.12
13 Added: 15/06/2022,2.45,0.0606784,0.69,24.58,4.14,1.24999875,19.59,11.33,0.32,0.79,0.25,0.13,0.01,0.02,0.01,0.1
14 Added: 04/07/2022,24.3,3.081824,42.34,39.79,8.09,0.41333292,19.79,11.32,1.24,0.7,0.18,0.07,0.02,0.01,0.005,0.68
15 Added: 01/08/2022,4.88,0.2299392,27.77,22.48,6.71,18.68331465,23,5,0.64,0.97,0.17,0.04,0.005,0.005,0.005,0.07
16 Added: 07/09/2022,29.28,2.07584,79.65,36.05,13.82,31.17663549,33.41,12.32,0.83,0.84,0.13,0.07,0.01,0.005,0.005,0.8
17 Added: 24/10/2022,41.61,1.2646656,68.38,47.44,11.54,21.55664511,28.22,18.73,0.81,0.41,0.1,0.05,0.005,0.005,0.005,0.09
18 Added: 21/11/2022,40.34,3.1105664,53.6,51.09,9.69,17.97331536,25.5,18.85,0.97,0.58,0.11,0.07,0.005,0.005,0.005,0.04
19 Added: 09/01/2023,48.71,6.6171392,63.08,71.45,11.58,6.55666011,23.81,21.32,1.46,1.04,0.13,0.13,0.01,0.01,0.01,0.03
20 Added: 21/02/2023,56.03,7.5273152,53.3,81.75,12.11,19.31998068,23.16,27.27,1.86,0.95,0.18,0.19,0.01,0.005,0.02,0.13
21 Added: 20/04/2023,50.67,7.0546624,76.45,76.63,10.57,15.54331779,22.25,26.97,0.95,0.96,0.19,0.12,0.005,0.005,0.005,0.21
22 Added: 07/06/2023,48.82,7.3005696,90.04,64.58,9.96,16.92664974,22.39,25.93,0.78,0.42,0.2,0.11,0.005,0.005,0.005,0.16
23 Added: 13/07/2023,21.79,1.5712512,77.61,40.41,9.74,20.82331251,26.23,22.49,0.6,1.16,0.22,0.31,0,0,0.02,0.14
24 Added: 17/07/2023,21.79,4.9213376,77.61,40.41,9.74,20.82331251,26.23,22.49,0.6,1.16,0.22,0.31,0.01,0.01,0.02,0.14
25 Added: 23/08/2023,23.88,2.778432,97.75,49.74,26.25,31.24996875,31.11,16.43,1.33,0.8,0.18,0.14,0,0,0.01,1.01
26 Added: 02/09/2023,23.88,2.778432,97.75,49.74,16.15,31.24996875,31.11,16.43,1.33,0.8,0.18,0.14,0,0,0.01,1.01
27 Added: 13/10/2023,71.9,5.0905984,106.35,91.03,18.11,34.90663176,32.36,14.59,1.43,0.97,0.17,0.05,0,0,0,0.24
28 Added: 28/12/2023,70.58,9.1368896,141.05,68.18,11.96,24.18664248,27.95,21.57,1.31,0.88,0.16,0.15,0,0,0.02,0.06
29 Added: 16/01/2024,77.26,11.433088,149.17,68.71,12.14,23.24331009,29.88,27.04,1.15,1.14,0.26,0.14,0,0,0,0.09
30 Added: 04/03/2024,84.65,13.4418624,185.21,66.05,15.61,30.69330264,40.12,36.82,0.66,0.93,0.39,0.35,0,0,0.03,0.16
31 Added: 23/04/2024,69.17,11.2350848,116.41,52.96,14.07,28.95330438,80.73,37.54,0.57,0.79,0.42,0.38,0.01,0,0.03,0.16
32 Added: 30/05/2024,46.74,7.520928,81.84,38.61,10.48,26.52997347,79.96,40.47,0.34,0.87,0.45,0.37,0,0.03,0.03,0.12
33 Added: 05/07/2024,27.51,3.960064,75.58,27.78,8.29,25.99330734,92.2,44.74,0.32,0.59,0.45,0.37,0,0.03,0.03,0.15
34 Added: 23/07/2024,16.55,2.4143616,83.62,16.52,4.9,20.45997954,79.04,40.51,0.32,0.77,0.43,0.26,0,0.03,0.02,0.43
35 Added: 06/08/2024,0,0.3001984,74.41,6.82,2.56,17.28664938,78.79,35.04,0.42,0.9,0.37,0.29,0,0.03,0.02,0.13
36 Added: 09/09/2024,18.3,2.87424,85.3,8.7,1.7,10.5666561,53.7,22.7,2.5,0.7,0.2,0.1,0,0,0,0
37 Added: 01/10/2024,22.94,4.1740352,112.46,9.44,2,13.51998648,58.57,28.76,0.27,0.6,0.26,0.17,0,0.02,0,0.2
38 Added: 22/11/2024,66,2.87424,127,33,9,7.333326,63,40,2.8,0.73,0.37,0.16,0.01,0.01,0.01,0
39 Added: 20/01/2025,94.26,15.664608,146.27,76.06,14.24,32.05663461,64.29,46.99,0.45,0.37,0.48,0.16,0.08,0.03,0.01,0.11
40 Added: 06/03/2025,95.82,20.007904,171.83,92.24,15.75,35.2332981,82.27,54.5,0.45,0.17,0.49,0.16,0.03,0.02,0,0.06
41 Added: 04/04/2025,85.49,17.2646016,109.91,88.54,13.47,31.08663558,65.02,53.96,0.28,0.65,0.51,0.13,0.01,0.01,0,0
42 Added: 22/05/2025,49.8,9.9927744,92.41,61.42,8.47,22.42331091,52.95,38.25,0.32,0.86,0.48,0.23,0.03,0,0.02,0.13
43 Added: 11/06/2025,30.28,5.700576,50.2,48.96,5.73,22.10664456,51.34,33.41,0,0.96,0.51,0.26,0,0,0,0
44 Added: 01/08/2025,1.34,0.4854272,77.64,16.45,5.52,22.93997706,58.45,25.83,0.5,0.48,0.44,0.17,0,0,0,0
db/migrations.rkt
index 00000000..95164e49 000000..100644
@@ -0,0 +1,167 @@
1 Added: #lang racket
2 Added:
3 Added: (provide migrate-all!)
4 Added:
5 Added: (require db
6 Added: sql
7 Added: "conn.rkt")
8 Added:
9 Added: (define migrations-box (box '()))
10 Added:
11 Added: (define (migrate-all!)
12 Added: (printf "Applying migrations on connection ~a...\n"
13 Added: (dbsystem-name (connection-dbsystem (current-conn))))
14 Added: (for ([pair (in-list (unbox migrations-box))])
15 Added: (match pair
16 Added: [(cons migration-name stmts)
17 Added: (with-tx
18 Added: (for ([stmt (in-list stmts)])
19 Added: (query-exec (current-conn) stmt)))
20 Added: (printf "Applied migration: ~a\n" migration-name)])))
21 Added:
22 Added: (define-syntax-rule (define-migration migration-name sql)
23 Added: (let ((migrations (unbox migrations-box))
24 Added: (name-symbol (string->symbol migration-name)))
25 Added: (if (assoc name-symbol migrations)
26 Added: (error 'define-migration "migration '~a' declared more than once" migration-name)
27 Added: (set-box! migrations-box (append migrations (list (cons name-symbol sql)))))))
28 Added:
29 Added:
30 Added: ;;;;;;;;;;;;
31 Added: ;; NUTRIENTS
32 Added: ;;;;;;;;;;;;
33 Added:
34 Added: (define-migration "create table nutrients"
35 Added: (list
36 Added: (create-table #:if-not-exists
37 Added: nutrients
38 Added: #:columns
39 Added: [id integer #:not-null]
40 Added: [canonical_name text #:not-null]
41 Added: [formula text #:not-null]
42 Added: #:constraints
43 Added: (primary-key id)
44 Added: (unique canonical_name)
45 Added: (unique formula))))
46 Added:
47 Added: (define-migration "create table nutrient_value_sets"
48 Added: (list
49 Added: (create-table #:if-not-exists
50 Added: nutrient_value_sets
51 Added: #:columns
52 Added: [id integer #:not-null]
53 Added: [nutrient_measurement_id integer]
54 Added: [nutrient_target_id integer]
55 Added: [crop_requirement_id integer]
56 Added: [fertilizer_product_id integer]
57 Added: #:constraints
58 Added: (primary-key id)
59 Added: (foreign-key nutrient_measurement_id
60 Added: #:references (nutrient_measurement id)
61 Added: #:on-delete #:cascade)
62 Added: (foreign-key nutrient_target_id
63 Added: #:references (nutrient_target id)
64 Added: #:on-delete #:cascade)
65 Added: (foreign-key crop_requirement_id
66 Added: #:references (crop_requirements id)
67 Added: #:on-delete #:cascade)
68 Added: (foreign-key fertilizer_product_id
69 Added: #:references (fertilizer_products id)
70 Added: #:on-delete #:cascade))
71 Added: "CREATE INDEX IF NOT EXISTS idx_nvs_meas ON nutrient_value_sets(nutrient_measurement_id)"
72 Added: "CREATE INDEX IF NOT EXISTS idx_nvs_targ ON nutrient_value_sets(nutrient_target_id)"
73 Added: "CREATE INDEX IF NOT EXISTS idx_nvs_crop ON nutrient_value_sets(crop_requirement_id)"
74 Added: "CREATE INDEX IF NOT EXISTS idx_nvs_prod ON nutrient_value_sets(fertilizer_product_id)"))
75 Added:
76 Added: (define-migration "create table nutrient_values"
77 Added: (list
78 Added: (create-table #:if-not-exists
79 Added: nutrient_values
80 Added: #:columns
81 Added: [value_set_id integer #:not-null]
82 Added: [nutrient_id integer #:not-null]
83 Added: [value_ppm real #:not-null]
84 Added: #:constraints
85 Added: (primary-key value_set_id nutrient_id)
86 Added: (foreign-key value_set_id
87 Added: #:references (nutrient_value_sets id)
88 Added: #:on-delete #:cascade)
89 Added: (foreign-key nutrient_id
90 Added: #:references (nutrients id)
91 Added: #:on-delete #:cascade))
92 Added: "CREATE INDEX IF NOT EXISTS idx_nv_set_nutrient ON nutrient_values(value_set_id, nutrient_id)"))
93 Added:
94 Added: (define-migration "create table nutrient_measurements"
95 Added: (list
96 Added: (create-table #:if-not-exists
97 Added: nutrient_measurements
98 Added: #:columns
99 Added: [id integer #:not-null]
100 Added: ;; ISO8601 date
101 Added: [measured_on text #:not-null]
102 Added: #:constraints
103 Added: (primary-key id)
104 Added: (unique measured_on))))
105 Added:
106 Added: (define-migration "create table nutrient_targets"
107 Added: (list
108 Added: (create-table #:if-not-exists
109 Added: nutrient_targets
110 Added: #:columns
111 Added: [id integer #:not-null]
112 Added: ;; ISO8601 date
113 Added: [effective_on text #:not-null]
114 Added: #:constraints
115 Added: (primary-key id)
116 Added: (unique effective_on))))
117 Added:
118 Added:
119 Added: ;;;;;;;;
120 Added: ;; CROPS
121 Added: ;;;;;;;;
122 Added:
123 Added: (define-migration "create table crops"
124 Added: (list
125 Added: (create-table #:if-not-exists
126 Added: crops
127 Added: #:columns
128 Added: [id integer #:not-null]
129 Added: [canonical_name integer #:not-null]
130 Added: #:constraints
131 Added: (primary-key id)
132 Added: (unique canonical_name))))
133 Added:
134 Added: (define-migration "create table crop_requirements"
135 Added: (list
136 Added: (create-table #:if-not-exists
137 Added: crop_requirements
138 Added: #:columns
139 Added: [id integer #:not-null]
140 Added: [crop_id integer]
141 Added: [profile text #:not-null]
142 Added: #:constraints
143 Added: (primary-key id)
144 Added: (foreign-key crop_id
145 Added: #:references (crops id)
146 Added: #:on-delete #:cascade))))
147 Added:
148 Added:
149 Added: ;;;;;;;;;;;;;;
150 Added: ;; FERTILIZERS
151 Added: ;;;;;;;;;;;;;;
152 Added:
153 Added: (define-migration "create table fertilizer_products"
154 Added: (list
155 Added: (create-table #:if-not-exists
156 Added: fertilizer_products
157 Added: #:columns
158 Added: [id integer #:not-null]
159 Added: [canonical_name text #:not-null]
160 Added: [brand_name text]
161 Added: #:constraints
162 Added: (primary-key id)
163 Added: (unique canonical_name))))
164 Added:
165 Added: (module+ test
166 Added: (connect!)
167 Added: (migrate-all!))
db/seed.rkt
index 00000000..6b253a66 000000..100644
@@ -0,0 +1,137 @@
1 Added: #lang racket
2 Added:
3 Added: ;; Seed the database with default values.
4 Added:
5 Added: (provide seed-database!)
6 Added:
7 Added: (require csv-reading
8 Added: "conn.rkt"
9 Added: "../models/nutrient.rkt"
10 Added: "../models/nutrient-measurement.rkt"
11 Added: "../models/crop.rkt"
12 Added: "../models/crop-requirement.rkt"
13 Added: "../models/fertilizer-product.rkt")
14 Added:
15 Added: (define (seed-database!)
16 Added: (seed-nutrients!)
17 Added: (seeded "nutrients")
18 Added: (seed-historical-nutrient-measurements!)
19 Added: (seeded "historical nutrient measurements")
20 Added: (seed-crops!)
21 Added: (seeded "crops")
22 Added: (seed-crop-requirements!)
23 Added: (seeded "crop requirements")
24 Added: (seed-existing-fertilizer-products!)
25 Added: (seeded "existing fertilizer products"))
26 Added:
27 Added: (define (seeded entity)
28 Added: (displayln (format "Seeded entity: ~a" entity)))
29 Added:
30 Added: (define (seed-nutrients!)
31 Added: (define nutrient-names (map nutrient-name (get-nutrients)))
32 Added: (define default-nutrients
33 Added: '(("Nitrate Nitrogen" "NNO3")
34 Added: ("Phosphorus" "P")
35 Added: ("Potassium" "K")
36 Added: ("Calcium" "Ca")
37 Added: ("Magnesium" "Mg")
38 Added: ("Sulfur" "S")
39 Added: ("Sodium" "Na")
40 Added: ("Chloride" "Cl")
41 Added: ("Silicon" "Si")
42 Added: ("Iron" "Fe")
43 Added: ("Zinc" "Zn")
44 Added: ("Boron" "B")
45 Added: ("Manganese" "Mn")
46 Added: ("Copper" "Cu")
47 Added: ("Molybdenum" "Mo")
48 Added: ("Ammonium Nitrogen" "NNH4")))
49 Added: (with-tx
50 Added: (for ([pair (in-list default-nutrients)])
51 Added: (define name (first pair))
52 Added: (define formula (second pair))
53 Added: ;; Ensure idempotence
54 Added: (unless (member name nutrient-names)
55 Added: (create-nutrient! name formula)))))
56 Added:
57 Added: (define (seed-historical-nutrient-measurements!)
58 Added: (define input-csv "/home/blendux/git/ferti-v2/db/data/dolibarr_nutrient_measurements_ppm.csv")
59 Added: (define next-row (make-csv-reader (open-input-file input-csv)))
60 Added: (define header (next-row))
61 Added: (define (row->seed! row)
62 Added: (define row-alist (map cons header row))
63 Added: (define measured-on (cdar row-alist))
64 Added: (define nutrient-values
65 Added: (for/list ([nm (in-list (cdr row-alist))])
66 Added: (define formula (car nm))
67 Added: (define n (get-nutrient #:formula formula))
68 Added: (define v (string->number (cdr nm)))
69 Added: (cons n v)))
70 Added: (create-nutrient-measurement! measured-on nutrient-values))
71 Added: (with-tx
72 Added: (csv-for-each row->seed! next-row)))
73 Added:
74 Added: (define (seed-crops!)
75 Added: (define crop-names (map crop-name (get-crops)))
76 Added: (define default-crops
77 Added: '("salade"
78 Added: "laitue"
79 Added: "tomate"
80 Added: "framboise"))
81 Added: (with-tx
82 Added: (for ([name (in-list default-crops)])
83 Added: ;; Ensure idempotence
84 Added: (unless (member name crop-names)
85 Added: (create-crop! name)))))
86 Added:
87 Added: (define (seed-crop-requirements!)
88 Added: (define input-csv "/home/blendux/git/ferti-v2/db/data/dolibarr_crop_requirements_ppm.csv")
89 Added: (define next-row (make-csv-reader (open-input-file input-csv)))
90 Added: (define header (next-row))
91 Added: (define (row->seed! row)
92 Added: (define row-alist (map cons header row))
93 Added: (define crop-name (string-downcase (cdr (assoc "Plante" row-alist))))
94 Added: (define profile (cdr (assoc "Profil" row-alist)))
95 Added: (define nutrient-values
96 Added: (for/list ([crop-requirement (in-list (list-tail row-alist 2))])
97 Added: (define formula (car crop-requirement))
98 Added: (define n (get-nutrient #:formula formula))
99 Added: (define v (string->number (cdr crop-requirement)))
100 Added: (cons n v)))
101 Added: (cond
102 Added: [(non-empty-string? crop-name)
103 Added: (define crop (get-crop #:name crop-name))
104 Added: (create-crop-requirement! profile nutrient-values crop)]
105 Added: [else
106 Added: (create-crop-requirement! profile nutrient-values)]))
107 Added: (with-tx
108 Added: (csv-for-each row->seed! next-row)))
109 Added:
110 Added: (define (seed-existing-fertilizer-products!)
111 Added: (define input-csv "/home/blendux/git/ferti-v2/db/data/dolibarr_fertilizer_compositions_percentage.csv")
112 Added: (define next-row (make-csv-reader (open-input-file input-csv)))
113 Added: (define header (next-row))
114 Added: (define (row->seed! row)
115 Added: (define row-alist (map cons header row))
116 Added: (define canonical-name (cdr (assoc "Libellé" row-alist)))
117 Added: (define brand-name (cdr (assoc "Nom commercial" row-alist)))
118 Added: (define nutrient-values
119 Added: (for/list ([fertilizer-component (in-list (list-tail row-alist 3))])
120 Added: (define formula (car fertilizer-component))
121 Added: (define n (get-nutrient #:formula formula))
122 Added: (define v (string->number (cdr fertilizer-component)))
123 Added: (cons n v)))
124 Added: (cond
125 Added: [(non-empty-string? brand-name)
126 Added: (create-fertilizer-product! canonical-name nutrient-values brand-name)]
127 Added: [else
128 Added: (create-fertilizer-product! canonical-name nutrient-values)]))
129 Added: (with-tx
130 Added: (csv-for-each row->seed! next-row)))
131 Added:
132 Added: (module+ test
133 Added: (require "migrations.rkt")
134 Added: (connect! #:path "test.sqlite3"
135 Added: )
136 Added: (migrate-all!)
137 Added: (seed-database!))
formlets.rkt
index 00000000..406a54a2 000000..100644
@@ -0,0 +1,53 @@
1 Added: #lang racket
2 Added:
3 Added: (provide measurements-formlet)
4 Added:
5 Added: (require gregor
6 Added: web-server/http
7 Added: web-server/formlets
8 Added: "models/nutrient.rkt")
9 Added:
10 Added:
11 Added: (define date-formlet
12 Added: (formlet
13 Added: ,{=> (to-string
14 Added: (required
15 Added: (input #:type "date"
16 Added: #:value (date->iso8601 (today))
17 Added: #:attributes '([class "form-control"] [required "required"]))))
18 Added: date-b}
19 Added: date-b))
20 Added:
21 Added: (define (measurement-formlet nutrient)
22 Added: (define id (nutrient-id nutrient))
23 Added: (define number-input
24 Added: (input #:type "number"
25 Added: #:attributes `([class "form-control"]
26 Added: [id ,(number->string id)]
27 Added: [step "0.1"]
28 Added: [placeholder ,(nutrient-name nutrient)])))
29 Added: (define input-label `(label ((for ,(number->string id))) ,(nutrient-name nutrient)))
30 Added: (formlet
31 Added: (#%#
32 Added: (div ([class "form-floating mb-3"])
33 Added: ,{=> number-input nutrient-value-b}
34 Added: ,input-label))
35 Added: (let ([nutrient-value (string->number
36 Added: (bytes->string/utf-8
37 Added: (binding:form-value nutrient-value-b)))])
38 Added: (and nutrient-value (cons id nutrient-value)))))
39 Added:
40 Added: (define (measurements-formlet)
41 Added: (formlet*
42 Added: (#%#
43 Added: `(div ([class "mb-3"])
44 Added: (h5 "Date du relevé")
45 Added: ,{=>* date-formlet measured-on*})
46 Added: `(div ([class "mb-3"])
47 Added: (h5 "Valeurs du relevé")
48 Added: ,@(for/list ([nutrient (get-nutrients)])
49 Added: {=>* (measurement-formlet nutrient) measurements*}))
50 Added: {=>* (submit "Enregistrer le relevé" #:attributes '([class "btn btn-primary"])) _})
51 Added: (let ([measured-on (first measured-on*)]
52 Added: [measurements (filter pair? measurements*)]) ; drop #f’s from empty values
53 Added: (values measured-on measurements))))
handlers.rkt
index 00000000..42e4a765 000000..100644
@@ -0,0 +1,48 @@
1 Added: #lang racket
2 Added:
3 Added: (provide app-dispatch)
4 Added:
5 Added: (require web-server/dispatch
6 Added: web-server/http
7 Added: web-server/formlets
8 Added: "views.rkt"
9 Added: "formlets.rkt"
10 Added: "models/nutrient.rkt"
11 Added: "models/nutrient-measurement.rkt")
12 Added:
13 Added:
14 Added: (define (index _)
15 Added: (define measurements (get-nutrient-measurements))
16 Added: (response/xexpr
17 Added: #:preamble #"<!DOCTYPE html>"
18 Added: (index-page measurements)))
19 Added:
20 Added: (define (new-measurement _)
21 Added: (response/xexpr
22 Added: #:preamble #"<!DOCTYPE html>"
23 Added: (new-measurement-page)))
24 Added:
25 Added: (define (create-measurement req)
26 Added: (define-values (measured-on measurements)
27 Added: (formlet-process (measurements-formlet) req))
28 Added: (create-nutrient-measurement! measured-on measurements)
29 Added: (redirect-to "/"))
30 Added:
31 Added: (define (destroy-measurement req)
32 Added: (define-values (measured-on measurements)
33 Added: (formlet-process (measurements-formlet) req))
34 Added: (create-nutrient-measurement! measured-on measurements)
35 Added: (redirect-to "/"))
36 Added:
37 Added: (define (fallback req)
38 Added: (response/xexpr
39 Added: #:preamble #"<!DOCTYPE html>"
40 Added: (fallback-page 404)))
41 Added:
42 Added: (define-values (app-dispatch app-url)
43 Added: (dispatch-rules
44 Added: [("measurement" "new") #:method "get" new-measurement]
45 Added: [("measurement" "create") #:method "post" create-measurement]
46 Added: [("measurement" "destroy") #:method "post" destroy-measurement]
47 Added: [("") #:method "get" index]
48 Added: [else fallback]))
main.rkt
index 00000000..7b6c25e7 000000..100644
@@ -0,0 +1,14 @@
1 Added: #lang racket
2 Added:
3 Added: (require web-server/dispatch
4 Added: "handlers.rkt"
5 Added: "db/conn.rkt"
6 Added: "db/migrations.rkt"
7 Added: "db/seed.rkt")
8 Added:
9 Added: (module+ main
10 Added: (connect! #:path "storage/development.sqlite3")
11 Added: (migrate-all!)
12 Added: (seed-database!)
13 Added: (serve/dispatch
14 Added: app-dispatch))
models/crop-requirement.rkt
index 00000000..f2134411 000000..100644
@@ -0,0 +1,180 @@
1 Added: #lang racket
2 Added:
3 Added: (provide
4 Added: ;; Struct definitions
5 Added: crop-requirement
6 Added: crop-requirement?
7 Added: crop-requirement-id crop-requirement-profile
8 Added: ;; SQL CRUD
9 Added: (contract-out
10 Added: [create-crop-requirement! (->* (string?
11 Added: (listof (cons/c
12 Added: nutrient?
13 Added: number?)))
14 Added: ((or/c #f crop?))
15 Added: crop-requirement?)]
16 Added: [get-crop-requirements (->* ()
17 Added: (#:id
18 Added: (or/c #f exact-nonnegative-integer?)
19 Added: #:profile
20 Added: (or/c #f string?))
21 Added: (listof crop-requirement?))]
22 Added: [get-crop-requirement (->* ()
23 Added: (#:id
24 Added: (or/c #f exact-nonnegative-integer?)
25 Added: #:profile
26 Added: (or/c #f string?))
27 Added: (or/c crop-requirement? #f))]
28 Added: [get-crop-requirement-values (-> crop-requirement?
29 Added: (listof (cons/c
30 Added: nutrient?
31 Added: number?)))]
32 Added: [get-crop-requirement-value (-> crop-requirement?
33 Added: nutrient?
34 Added: number?)]
35 Added: [get-latest-crop-requirement-value (-> nutrient? number?)]
36 Added: #; [update-crop-requirement! (->* (crop-requirement?)
37 Added: (#:profile (or/c #f string?)
38 Added: #:nutrient-values (or/c #f (listof (cons/c
39 Added: nutrient?
40 Added: number?))))
41 Added: (or/c crop-requirement? #f))]
42 Added: [delete-crop-requirement! (-> crop-requirement?
43 Added: void?)]))
44 Added:
45 Added: (require racket/contract
46 Added: db
47 Added: sql
48 Added: "../db/conn.rkt"
49 Added: "nutrient.rkt"
50 Added: "crop.rkt")
51 Added:
52 Added: ;; Instances of this struct are persisted in the crop_requirements table.
53 Added: (struct crop-requirement (id profile) #:transparent)
54 Added:
55 Added:
56 Added: ;; CREATE
57 Added:
58 Added:
59 Added: (define (create-crop-requirement! profile nutrient-values [crop #f])
60 Added: (define existing-crop-requirement (get-crop-requirement #:profile profile))
61 Added: (define (new-crop-requirement)
62 Added: (with-tx
63 Added: (query-exec (current-conn)
64 Added: (if crop
65 Added: (insert #:into crop_requirements
66 Added: #:set [crop_id ,(crop-id crop)] [profile ,profile])
67 Added: (insert #:into crop_requirements
68 Added: #:set [profile ,profile])))
69 Added: (define cr-id (crop-requirement-id (get-crop-requirement #:profile profile)))
70 Added: (query-exec (current-conn)
71 Added: (insert #:into nutrient_value_sets
72 Added: #:set [crop_requirement_id ,cr-id]))
73 Added: (define nvs-id (query-value (current-conn)
74 Added: (select id
75 Added: #:from nutrient_value_sets
76 Added: #:where (= crop_requirement_id ,cr-id))))
77 Added: (for ([nv nutrient-values])
78 Added: (match nv
79 Added: [(cons n v)
80 Added: (query-exec (current-conn)
81 Added: (insert #:into nutrient_values
82 Added: #:set
83 Added: [value_set_id ,nvs-id]
84 Added: [nutrient_id ,(nutrient-id n)]
85 Added: [value_ppm ,v]))])))
86 Added: (get-crop-requirement #:profile profile))
87 Added: (or existing-crop-requirement
88 Added: (new-crop-requirement)))
89 Added:
90 Added:
91 Added: ;; READ
92 Added:
93 Added: (define (get-crop-requirements #:id [id #f]
94 Added: #:profile [profile #f])
95 Added: (define (where-expr)
96 Added: (define clauses
97 Added: (filter values
98 Added: (list (and id (format "id = ~e" id))
99 Added: (and profile (format "profile = ~e" profile)))))
100 Added: (cond
101 Added: [(null? clauses) ""]
102 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
103 Added: (define query (string-join
104 Added: `("SELECT id, profile"
105 Added: "FROM crop_requirements"
106 Added: ,(where-expr)
107 Added: "ORDER BY id ASC")))
108 Added: (for/list ([(id* profile*)
109 Added: (in-query (current-conn) query)])
110 Added: (crop-requirement id* profile*)))
111 Added:
112 Added: (define (get-crop-requirement #:id [id #f]
113 Added: #:profile [profile #f])
114 Added: (define (where-expr)
115 Added: (define clauses
116 Added: (filter values
117 Added: (list
118 Added: (and id (format "id = ~e" id))
119 Added: (and profile (format "profile = ~e" profile)))))
120 Added: (cond
121 Added: [(null? clauses) ""]
122 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
123 Added: (define query (string-join
124 Added: `("SELECT id, profile"
125 Added: "FROM crop_requirements"
126 Added: ,(where-expr)
127 Added: "ORDER BY id ASC"
128 Added: "LIMIT 1")))
129 Added: (match (query-maybe-row (current-conn) query)
130 Added: [(vector id* profile*)
131 Added: (crop-requirement id* profile*)]
132 Added: [#f #f]))
133 Added:
134 Added: (define (get-crop-requirement-values crop-requirement)
135 Added: (for/list ([(nutrient-id name formula value_ppm)
136 Added: (in-query (current-conn)
137 Added: (string-join
138 Added: '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
139 Added: "FROM nutrient_values nv"
140 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
141 Added: "JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id"
142 Added: "JOIN nutrients n ON n.id = nv.nutrient_id"
143 Added: "WHERE cr.id = $1"))
144 Added: (crop-requirement-id crop-requirement))])
145 Added: (cons (nutrient nutrient-id name formula) value_ppm)))
146 Added:
147 Added: (define (get-crop-requirement-value crop-requirement nutrient)
148 Added: (query-maybe-value (current-conn)
149 Added: (string-join
150 Added: '("SELECT value_ppm"
151 Added: "FROM nutrient_values nv"
152 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
153 Added: "JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id"
154 Added: "WHERE cr.id = $1 AND nv.nutrient_id = $2"))
155 Added: (crop-requirement-id crop-requirement)
156 Added: (nutrient-id nutrient)))
157 Added:
158 Added: (define (get-latest-crop-requirement-value nutrient)
159 Added: (query-maybe-value (current-conn)
160 Added: (string-join
161 Added: '("SELECT value_ppm"
162 Added: "FROM nutrient_values nv"
163 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
164 Added: "JOIN crop_requirements cr ON cr.id = nvs.crop_requirement_id"
165 Added: "WHERE nv.nutrient_id = $1"
166 Added: "ORDER BY cr.profile DESC"
167 Added: "LIMIT 1"))
168 Added: (nutrient-id nutrient)))
169 Added:
170 Added:
171 Added: ;; UPDATE
172 Added:
173 Added:
174 Added: ;; DELETE
175 Added:
176 Added: (define (delete-crop-requirement! crop-requirement)
177 Added: (define id (crop-requirement-id crop-requirement))
178 Added: (query-exec (current-conn)
179 Added: (delete #:from crop_requirements
180 Added: #:where (= id ,id))))
models/crop.rkt
index 00000000..7163cbd2 000000..100644
@@ -0,0 +1,103 @@
1 Added: #lang racket
2 Added:
3 Added: (provide
4 Added: ;; Struct definitions
5 Added: crop
6 Added: crop?
7 Added: crop-id crop-name
8 Added: ;; SQL CRUD
9 Added: (contract-out
10 Added: [create-crop! (-> string? void?)]
11 Added: [get-crops (->* ()
12 Added: (#:id (or/c #f exact-nonnegative-integer?)
13 Added: #:name (or/c #f string?))
14 Added: (listof crop?))]
15 Added: [get-crop (->* ()
16 Added: (#:id (or/c #f exact-nonnegative-integer?)
17 Added: #:name (or/c #f string?))
18 Added: (or/c crop? #f))]
19 Added: [update-crop! (->* (exact-nonnegative-integer?)
20 Added: (#:name (or/c #f string?))
21 Added: (or/c crop? #f))]
22 Added: [delete-crop! (-> exact-nonnegative-integer? void?)]))
23 Added:
24 Added: (require racket/contract
25 Added: db
26 Added: sql
27 Added: "../db/conn.rkt")
28 Added:
29 Added: (struct crop (id name) #:transparent)
30 Added:
31 Added:
32 Added: ;; CREATE
33 Added:
34 Added: (define (create-crop! name)
35 Added: (query-exec (current-conn)
36 Added: (insert #:into crops
37 Added: #:set [canonical_name ,name])))
38 Added:
39 Added:
40 Added: ;; READ
41 Added:
42 Added: (define (get-crops #:id [id #f]
43 Added: #:name [name #f])
44 Added: (define (where-expr)
45 Added: (define clauses
46 Added: (filter values
47 Added: (list
48 Added: (and id (format "id = ~e" id))
49 Added: (and name (format "canonical_name = ~e" name)))))
50 Added: (cond
51 Added: [(null? clauses) ""]
52 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
53 Added: (define query (string-join
54 Added: `("SELECT id, canonical_name"
55 Added: "FROM crops"
56 Added: ,(where-expr)
57 Added: "ORDER BY id ASC")))
58 Added: (for/list ([(id* name*)
59 Added: (in-query (current-conn) query)])
60 Added: (crop id* name*)))
61 Added:
62 Added: (define (get-crop #:id [id #f]
63 Added: #:name [name #f])
64 Added: (define (where-expr)
65 Added: (define clauses
66 Added: (filter values
67 Added: (list (and id (format "id = ~e" id))
68 Added: (and name (format "canonical_name = ~e" name)))))
69 Added: (cond
70 Added: [(null? clauses) ""]
71 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
72 Added: (define query (string-join
73 Added: `("SELECT id, canonical_name"
74 Added: "FROM crops"
75 Added: ,(where-expr)
76 Added: "ORDER BY id ASC"
77 Added: "LIMIT 1")))
78 Added: (match (query-maybe-row (current-conn) query)
79 Added: [(vector id* name*)
80 Added: (crop id* name*)]
81 Added: [#f #f]))
82 Added:
83 Added:
84 Added: ;; UPDATE
85 Added:
86 Added: (define (update-crop! id
87 Added: #:name [name #f])
88 Added: (cond
89 Added: [name
90 Added: (query-exec (current-conn)
91 Added: (update crops
92 Added: #:set [canonical_name ,name]
93 Added: #:where (= id ,id)))]
94 Added: [else (void)])
95 Added: (or (get-crop #:id id)
96 Added: (error 'update-crop! "No crop with id ~a" id)))
97 Added:
98 Added:
99 Added: ;; DELETE
100 Added:
101 Added: (define (delete-crop! id)
102 Added: (query-exec (current-conn)
103 Added: (delete #:from crops #:where (= id ,id))))
models/fertilizer-product.rkt
index 00000000..254ce35a 000000..100644
@@ -0,0 +1,177 @@
1 Added: #lang racket
2 Added:
3 Added: (provide
4 Added: ;; Struct definitions
5 Added: fertilizer-product
6 Added: fertilizer-product?
7 Added: fertilizer-product-id fertilizer-product-brand-name
8 Added: ;; SQL CRUD
9 Added: (contract-out
10 Added: [create-fertilizer-product! (->* (string?
11 Added: (listof (cons/c
12 Added: nutrient?
13 Added: number?)))
14 Added: (string?)
15 Added: fertilizer-product?)]
16 Added: [get-fertilizer-products (->* ()
17 Added: (#:id
18 Added: (or/c #f exact-nonnegative-integer?)
19 Added: #:brand-name
20 Added: (or/c #f string?))
21 Added: (listof fertilizer-product?))]
22 Added: [get-fertilizer-product (->* ()
23 Added: (#:id
24 Added: (or/c #f exact-nonnegative-integer?)
25 Added: #:brand-name
26 Added: (or/c #f string?))
27 Added: (or/c fertilizer-product? #f))]
28 Added: [get-fertilizer-product-values (-> fertilizer-product?
29 Added: (listof (cons/c
30 Added: nutrient?
31 Added: number?)))]
32 Added: [get-fertilizer-product-value (-> fertilizer-product?
33 Added: nutrient?
34 Added: number?)]
35 Added: [get-latest-fertilizer-product-value (-> nutrient? number?)]
36 Added: [delete-fertilizer-product! (-> fertilizer-product?
37 Added: void?)]))
38 Added:
39 Added: (require racket/contract
40 Added: db
41 Added: sql
42 Added: "../db/conn.rkt"
43 Added: "nutrient.rkt")
44 Added:
45 Added: ;; Instances of this struct are persisted in the fertilizer_products table.
46 Added: (struct fertilizer-product (id canonical-name brand-name) #:transparent)
47 Added:
48 Added:
49 Added: ;; CREATE
50 Added:
51 Added:
52 Added: (define (create-fertilizer-product! canonical-name nutrient-values [brand-name #f])
53 Added: (define existing-fertilizer-product (get-fertilizer-product #:canonical-name canonical-name))
54 Added: (define (new-fertilizer-product)
55 Added: (with-tx
56 Added: (query-exec (current-conn)
57 Added: (cond
58 Added: [brand-name
59 Added: (insert #:into fertilizer_products
60 Added: #:set [canonical_name ,canonical-name] [brand_name ,brand-name])]
61 Added: [else
62 Added: (insert #:into fertilizer_products
63 Added: #:set [canonical_name ,canonical-name])]))
64 Added: (define nm-id (fertilizer-product-id (get-fertilizer-product #:canonical-name canonical-name)))
65 Added: (query-exec (current-conn)
66 Added: (insert #:into nutrient_value_sets
67 Added: #:set [fertilizer_product_id ,nm-id]))
68 Added: (define nvs-id (query-value (current-conn)
69 Added: (select id
70 Added: #:from nutrient_value_sets
71 Added: #:where (= fertilizer_product_id ,nm-id))))
72 Added: (for ([nv nutrient-values])
73 Added: (match nv
74 Added: [(cons n v)
75 Added: (query-exec (current-conn)
76 Added: (insert #:into nutrient_values
77 Added: #:set
78 Added: [value_set_id ,nvs-id]
79 Added: [nutrient_id ,(nutrient-id n)]
80 Added: [value_ppm ,v]))])))
81 Added: (get-fertilizer-product #:canonical-name canonical-name))
82 Added: (or existing-fertilizer-product
83 Added: (new-fertilizer-product)))
84 Added:
85 Added:
86 Added: ;; READ
87 Added:
88 Added: (define (get-fertilizer-products #:id [id #f]
89 Added: #:brand-name [brand-name #f])
90 Added: (define (where-expr)
91 Added: (define clauses
92 Added: (filter values
93 Added: (list (and id (format "id = ~e" id))
94 Added: (and brand-name (format "brand_name = ~e" brand-name)))))
95 Added: (cond
96 Added: [(null? clauses) ""]
97 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
98 Added: (define query (string-join
99 Added: `("SELECT id, brand_name"
100 Added: "FROM fertilizer_products"
101 Added: ,(where-expr)
102 Added: "ORDER BY id ASC")))
103 Added: (for/list ([(id* brand-name*)
104 Added: (in-query (current-conn) query)])
105 Added: (fertilizer-product id* brand-name*)))
106 Added:
107 Added: (define (get-fertilizer-product #:id [id #f]
108 Added: #:canonical-name [canonical-name #f]
109 Added: #:brand-name [brand-name #f])
110 Added: (define (where-expr)
111 Added: (define clauses
112 Added: (filter values
113 Added: (list
114 Added: (and id (format "id = ~e" id))
115 Added: (and canonical-name (format "canonical_name = ~e" canonical-name))
116 Added: (and brand-name (format "brand_name = ~e" brand-name)))))
117 Added: (cond
118 Added: [(null? clauses) ""]
119 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
120 Added: (match (query-maybe-row (current-conn)
121 Added: (string-join
122 Added: `("SELECT id, canonical_name, brand_name"
123 Added: "FROM fertilizer_products"
124 Added: ,(where-expr)
125 Added: "ORDER BY id ASC"
126 Added: "LIMIT 1")))
127 Added: [(vector id* canonical-name* brand-name*)
128 Added: (fertilizer-product id* canonical-name* brand-name*)]
129 Added: [#f #f]))
130 Added:
131 Added: (define (get-fertilizer-product-values fertilizer-product)
132 Added: (for/list ([(nutrient-id name formula value_ppm)
133 Added: (in-query (current-conn)
134 Added: (string-join
135 Added: '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
136 Added: "FROM nutrient_values nv"
137 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
138 Added: "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
139 Added: "JOIN nutrients n ON n.id = nv.nutrient_id"
140 Added: "WHERE nm.id = $1"))
141 Added: (fertilizer-product-id fertilizer-product))])
142 Added: (cons (nutrient nutrient-id name formula) value_ppm)))
143 Added:
144 Added: (define (get-fertilizer-product-value fertilizer-product nutrient)
145 Added: (query-maybe-value (current-conn)
146 Added: (string-join
147 Added: '("SELECT value_ppm"
148 Added: "FROM nutrient_values nv"
149 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
150 Added: "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
151 Added: "WHERE nm.id = $1 AND nv.nutrient_id = $2"))
152 Added: (fertilizer-product-id fertilizer-product)
153 Added: (nutrient-id nutrient)))
154 Added:
155 Added: (define (get-latest-fertilizer-product-value nutrient)
156 Added: (query-maybe-value (current-conn)
157 Added: (string-join
158 Added: '("SELECT value_ppm"
159 Added: "FROM nutrient_values nv"
160 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
161 Added: "JOIN fertilizer_products nm ON nm.id = nvs.fertilizer_product_id"
162 Added: "WHERE nv.nutrient_id = $1"
163 Added: "ORDER BY nm.brand_name DESC"
164 Added: "LIMIT 1"))
165 Added: (nutrient-id nutrient)))
166 Added:
167 Added:
168 Added: ;; UPDATE
169 Added:
170 Added:
171 Added: ;; DELETE
172 Added:
173 Added: (define (delete-fertilizer-product! fertilizer-product)
174 Added: (define id (fertilizer-product-id fertilizer-product))
175 Added: (query-exec (current-conn)
176 Added: (delete #:from fertilizer_products
177 Added: #:where (= id ,id))))
models/nutrient-measurement.rkt
index 00000000..8364aa7f 000000..100644
@@ -0,0 +1,212 @@
1 Added: #lang racket
2 Added:
3 Added: (provide
4 Added: ;; Struct definitions
5 Added: nutrient-measurement
6 Added: nutrient-measurement?
7 Added: nutrient-measurement-id nutrient-measurement-measured-on
8 Added: ;; SQL CRUD
9 Added: (contract-out
10 Added: [create-nutrient-measurement! (-> string?
11 Added: (listof (cons/c
12 Added: nutrient?
13 Added: number?))
14 Added: nutrient-measurement?)]
15 Added: [get-nutrient-measurements (->* ()
16 Added: (#:id (or/c #f exact-nonnegative-integer?)
17 Added: #:measured-on (or/c #f string?))
18 Added: (listof nutrient-measurement?))]
19 Added: [get-nutrient-measurement (->* ()
20 Added: (#:id (or/c #f exact-nonnegative-integer?)
21 Added: #:measured-on (or/c #f string?))
22 Added: (or/c nutrient-measurement? #f))]
23 Added: [get-nutrient-measurement-values (-> nutrient-measurement?
24 Added: (listof (cons/c
25 Added: nutrient?
26 Added: number?)))]
27 Added: [get-nutrient-measurement-value (-> nutrient-measurement?
28 Added: nutrient?
29 Added: number?)]
30 Added: [get-latest-nutrient-measurement-value (-> nutrient? number?)]
31 Added: #; [update-nutrient-measurement! (->* (nutrient-measurement?)
32 Added: (#:measured-on (or/c #f string?)
33 Added: #:nutrient-values (or/c #f (listof (cons/c
34 Added: nutrient?
35 Added: number?))))
36 Added: (or/c nutrient-measurement? #f))]
37 Added: [delete-nutrient-measurement! (-> nutrient-measurement?
38 Added: void?)]))
39 Added:
40 Added: (require racket/contract
41 Added: db
42 Added: sql
43 Added: "../db/conn.rkt"
44 Added: "nutrient.rkt")
45 Added:
46 Added: ;; Instances of this struct are persisted in the nutrient_measurements table.
47 Added: (struct nutrient-measurement (id measured-on) #:transparent)
48 Added:
49 Added:
50 Added: ;; CREATE
51 Added:
52 Added: (define (create-nutrient-measurement! measured-on nutrient-values)
53 Added: (define existing-nutrient-measurement (get-nutrient-measurement #:measured-on measured-on))
54 Added: (define (new-nutrient-measurement)
55 Added: (with-tx
56 Added: (query-exec (current-conn)
57 Added: (insert #:into nutrient_measurements
58 Added: #:set [measured_on ,measured-on]))
59 Added: (define nm-id (nutrient-measurement-id (get-nutrient-measurement #:measured-on measured-on)))
60 Added: (query-exec (current-conn)
61 Added: (insert #:into nutrient_value_sets
62 Added: #:set [nutrient_measurement_id ,nm-id]))
63 Added: (define nvs-id (query-value (current-conn)
64 Added: (select id
65 Added: #:from nutrient_value_sets
66 Added: #:where (= nutrient_measurement_id ,nm-id))))
67 Added: (for ([nv nutrient-values])
68 Added: (match nv
69 Added: [(cons n v)
70 Added: (query-exec (current-conn)
71 Added: (insert #:into nutrient_values
72 Added: #:set
73 Added: [value_set_id ,nvs-id]
74 Added: [nutrient_id ,(nutrient-id n)]
75 Added: [value_ppm ,v]))])))
76 Added: (get-nutrient-measurement #:measured-on measured-on))
77 Added: (or existing-nutrient-measurement
78 Added: (new-nutrient-measurement)))
79 Added:
80 Added:
81 Added: ;; READ
82 Added:
83 Added: (define (get-nutrient-measurements #:id [id #f]
84 Added: #:measured-on [measured-on #f])
85 Added: (define (where-expr)
86 Added: (define clauses
87 Added: (filter values
88 Added: (list (and id (format "id = ~e" id))
89 Added: (and measured-on (format "measured_on = ~e" measured-on)))))
90 Added: (cond
91 Added: [(null? clauses) ""]
92 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
93 Added: (define query (string-join
94 Added: `("SELECT id, measured_on"
95 Added: "FROM nutrient_measurements"
96 Added: ,(where-expr)
97 Added: "ORDER BY id ASC")))
98 Added: (for/list ([(id* measured-on*)
99 Added: (in-query (current-conn) query)])
100 Added: (nutrient-measurement id* measured-on*)))
101 Added:
102 Added: (define (get-nutrient-measurement #:id [id #f]
103 Added: #:measured-on [measured-on #f])
104 Added: (define (where-expr)
105 Added: (define clauses
106 Added: (filter values
107 Added: (list
108 Added: (and id (format "id = ~e" id))
109 Added: (and measured-on (format "measured_on = ~e" measured-on)))))
110 Added: (cond
111 Added: [(null? clauses) ""]
112 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
113 Added: (define query (string-join
114 Added: `("SELECT id, measured_on"
115 Added: "FROM nutrient_measurements"
116 Added: ,(where-expr)
117 Added: "ORDER BY id ASC"
118 Added: "LIMIT 1")))
119 Added: (match (query-maybe-row (current-conn) query)
120 Added: [(vector id* measured-on*)
121 Added: (nutrient-measurement id* measured-on*)]
122 Added: [#f #f]))
123 Added:
124 Added: (define (get-nutrient-measurement-values nutrient-measurement)
125 Added: (for/list ([(nutrient-id name formula value_ppm)
126 Added: (in-query (current-conn)
127 Added: (string-join
128 Added: '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
129 Added: "FROM nutrient_values nv"
130 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
131 Added: "JOIN nutrient_measurements nm ON nm.id = nvs.nutrient_measurement_id"
132 Added: "JOIN nutrients n ON n.id = nv.nutrient_id"
133 Added: "WHERE nm.id = $1"))
134 Added: (nutrient-measurement-id nutrient-measurement))])
135 Added: (cons (nutrient nutrient-id name formula) value_ppm)))
136 Added:
137 Added: (define (get-nutrient-measurement-value nutrient-measurement nutrient)
138 Added: (query-maybe-value (current-conn)
139 Added: (string-join
140 Added: '("SELECT value_ppm"
141 Added: "FROM nutrient_values nv"
142 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
143 Added: "JOIN nutrient_measurements nm ON nm.id = nvs.nutrient_measurement_id"
144 Added: "WHERE nm.id = $1 AND nv.nutrient_id = $2"))
145 Added: (nutrient-measurement-id nutrient-measurement)
146 Added: (nutrient-id nutrient)))
147 Added:
148 Added: (define (get-latest-nutrient-measurement-value nutrient)
149 Added: (query-maybe-value (current-conn)
150 Added: (string-join
151 Added: '("SELECT value_ppm"
152 Added: "FROM nutrient_values nv"
153 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
154 Added: "JOIN nutrient_measurements nm ON nm.id = nvs.nutrient_measurement_id"
155 Added: "WHERE nv.nutrient_id = $1"
156 Added: "ORDER BY nm.measured_on DESC"
157 Added: "LIMIT 1"))
158 Added: (nutrient-id nutrient)))
159 Added:
160 Added:
161 Added: ;; UPDATE
162 Added:
163 Added: #; (define (update-nutrient-measurement! nutrient-measurement
164 Added: #:measured-on [measured-on #f]
165 Added: #:nutrient-values [nutrient-values '()])
166 Added: (define nm-id (nutrient-measurement-id nutrient-measurement))
167 Added: (define (nvs-id nm-id)
168 Added: (query-maybe-row (current-conn)
169 Added: (select id
170 Added: #:from nutrient_value_sets
171 Added: #:where (= nutrient_measurement_id ,nm-id))))
172 Added: (with-tx
173 Added: (when measured-on
174 Added: (query-exec (current-conn)
175 Added: (update nutrient_measurements
176 Added: #:set [measured_on ,measured-on]
177 Added: #:where (= id ,id))))
178 Added: (unless (null? nutrient-values)
179 Added: (upsert-nutrient-values nm-id))
180 Added: (get-nutrient-measurement #:id id)))
181 Added:
182 Added: #; (define (upsert-nutrient-values nutrient-measurement-id)
183 Added: (define maybe-nvs-id (nvs-id nm-id))
184 Added: (case maybe-nvs-id
185 Added: [(#f)
186 Added: (query-exec (current-conn)
187 Added: (insert #:into nutrient_values_sets
188 Added: #:set
189 Added: [nutrient_measurement_id ,id]))
190 Added: (define new-nvs-id (nvs-id nm-id))
191 Added: (query-exec (current-conn)
192 Added: (string-join
193 Added: '("INSERT INTO nutrient_values"
194 Added: "VALUES $1 $2 $3"
195 Added: ""))
196 Added: new-nvs-id
197 Added: )]
198 Added: [else
199 Added: (query-exec (current-conn)
200 Added: (update nutrient_measurement_values
201 Added: #:set [value ,value]
202 Added: #:where (and (= measurement_id ,measurement-id)
203 Added: (= nutrient_id ,nutrient-id))))]))
204 Added:
205 Added:
206 Added: ;; DELETE
207 Added:
208 Added: (define (delete-nutrient-measurement! nutrient-measurement)
209 Added: (define id (nutrient-measurement-id nutrient-measurement))
210 Added: (query-exec (current-conn)
211 Added: (delete #:from nutrient_measurements
212 Added: #:where (= id ,id))))
models/nutrient-target.rkt
index 00000000..6483997a 000000..100644
@@ -0,0 +1,217 @@
1 Added: #lang racket
2 Added:
3 Added: (provide
4 Added: ;; Struct definitions
5 Added: nutrient-target
6 Added: nutrient-target?
7 Added: nutrient-target-id nutrient-target-effective-on
8 Added: ;; SQL CRUD
9 Added: (contract-out
10 Added: [create-nutrient-target! (-> string?
11 Added: (listof (cons/c
12 Added: nutrient?
13 Added: number?))
14 Added: nutrient-target?)]
15 Added: [get-nutrient-targets (->* ()
16 Added: (#:id
17 Added: (or/c #f exact-nonnegative-integer?)
18 Added: #:effective-on
19 Added: (or/c #f string?))
20 Added: (listof nutrient-target?))]
21 Added: [get-nutrient-target (->* ()
22 Added: (#:id
23 Added: (or/c #f exact-nonnegative-integer?)
24 Added: #:effective-on
25 Added: (or/c #f string?))
26 Added: (or/c nutrient-target? #f))]
27 Added: [get-nutrient-target-values (-> nutrient-target?
28 Added: (listof (cons/c
29 Added: nutrient?
30 Added: number?)))]
31 Added: [get-nutrient-target-value (-> nutrient-target?
32 Added: nutrient?
33 Added: number?)]
34 Added: [get-latest-nutrient-target-value (-> nutrient? number?)]
35 Added: #; [update-nutrient-target! (->* (nutrient-target?)
36 Added: (#:effective-on (or/c #f string?)
37 Added: #:nutrient-values (or/c #f (listof (cons/c
38 Added: nutrient?
39 Added: number?))))
40 Added: (or/c nutrient-target? #f))]
41 Added: [delete-nutrient-target! (-> nutrient-target?
42 Added: void?)]))
43 Added:
44 Added: (require racket/contract
45 Added: db
46 Added: sql
47 Added: "../db/conn.rkt"
48 Added: "nutrient.rkt")
49 Added:
50 Added: ;; Instances of this struct are persisted in the nutrient_targets table.
51 Added: (struct nutrient-target (id effective-on) #:transparent)
52 Added:
53 Added:
54 Added: ;; CREATE
55 Added:
56 Added:
57 Added: (define (create-nutrient-target! effective-on nutrient-values)
58 Added: (define existing-nutrient-target (get-nutrient-target #:effective-on effective-on))
59 Added: (define (new-nutrient-target)
60 Added: (with-tx
61 Added: (query-exec (current-conn)
62 Added: (insert #:into nutrient_targets
63 Added: #:set [effective_on ,effective-on]))
64 Added: (define nm-id (nutrient-target-id (get-nutrient-target #:effective-on effective-on)))
65 Added: (query-exec (current-conn)
66 Added: (insert #:into nutrient_value_sets
67 Added: #:set [nutrient_target_id ,nm-id]))
68 Added: (define nvs-id (query-value (current-conn)
69 Added: (select id
70 Added: #:from nutrient_value_sets
71 Added: #:where (= nutrient_target_id ,nm-id))))
72 Added: (for ([nv nutrient-values])
73 Added: (match nv
74 Added: [(cons n v)
75 Added: (query-exec (current-conn)
76 Added: (insert #:into nutrient_values
77 Added: #:set
78 Added: [value_set_id ,nvs-id]
79 Added: [nutrient_id ,(nutrient-id n)]
80 Added: [value_ppm ,v]))])))
81 Added: (get-nutrient-target #:effective-on effective-on))
82 Added: (or existing-nutrient-target
83 Added: (new-nutrient-target)))
84 Added:
85 Added:
86 Added: ;; READ
87 Added:
88 Added: (define (get-nutrient-targets #:id [id #f]
89 Added: #:effective-on [effective-on #f])
90 Added: (define (where-expr)
91 Added: (define clauses
92 Added: (filter values
93 Added: (list (and id (format "id = ~e" id))
94 Added: (and effective-on (format "effective_on = ~e" effective-on)))))
95 Added: (cond
96 Added: [(null? clauses) ""]
97 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
98 Added: (define query (string-join
99 Added: `("SELECT id, effective_on"
100 Added: "FROM nutrient_targets"
101 Added: ,(where-expr)
102 Added: "ORDER BY id ASC")))
103 Added: (for/list ([(id* effective-on*)
104 Added: (in-query (current-conn) query)])
105 Added: (nutrient-target id* effective-on*)))
106 Added:
107 Added: (define (get-nutrient-target #:id [id #f]
108 Added: #:effective-on [effective-on #f])
109 Added: (define (where-expr)
110 Added: (define clauses
111 Added: (filter values
112 Added: (list
113 Added: (and id (format "id = ~e" id))
114 Added: (and effective-on (format "effective_on = ~e" effective-on)))))
115 Added: (cond
116 Added: [(null? clauses) ""]
117 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
118 Added: (define query (string-join
119 Added: `("SELECT id, effective_on"
120 Added: "FROM nutrient_targets"
121 Added: ,(where-expr)
122 Added: "ORDER BY id ASC"
123 Added: "LIMIT 1")))
124 Added: (match (query-maybe-row (current-conn) query)
125 Added: [(vector id* effective-on*)
126 Added: (nutrient-target id* effective-on*)]
127 Added: [#f #f]))
128 Added:
129 Added: (define (get-nutrient-target-values nutrient-target)
130 Added: (for/list ([(nutrient-id name formula value_ppm)
131 Added: (in-query (current-conn)
132 Added: (string-join
133 Added: '("SELECT n.id, n.canonical_name, n.formula, nv.value_ppm"
134 Added: "FROM nutrient_values nv"
135 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
136 Added: "JOIN nutrient_targets nm ON nm.id = nvs.nutrient_target_id"
137 Added: "JOIN nutrients n ON n.id = nv.nutrient_id"
138 Added: "WHERE nm.id = $1"))
139 Added: (nutrient-target-id nutrient-target))])
140 Added: (cons (nutrient nutrient-id name formula) value_ppm)))
141 Added:
142 Added: (define (get-nutrient-target-value nutrient-target nutrient)
143 Added: (query-maybe-value (current-conn)
144 Added: (string-join
145 Added: '("SELECT value_ppm"
146 Added: "FROM nutrient_values nv"
147 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
148 Added: "JOIN nutrient_targets nm ON nm.id = nvs.nutrient_target_id"
149 Added: "WHERE nm.id = $1 AND nv.nutrient_id = $2"))
150 Added: (nutrient-target-id nutrient-target)
151 Added: (nutrient-id nutrient)))
152 Added:
153 Added: (define (get-latest-nutrient-target-value nutrient)
154 Added: (query-maybe-value (current-conn)
155 Added: (string-join
156 Added: '("SELECT value_ppm"
157 Added: "FROM nutrient_values nv"
158 Added: "JOIN nutrient_value_sets nvs ON nvs.id = nv.value_set_id"
159 Added: "JOIN nutrient_targets nm ON nm.id = nvs.nutrient_target_id"
160 Added: "WHERE nv.nutrient_id = $1"
161 Added: "ORDER BY nm.effective_on DESC"
162 Added: "LIMIT 1"))
163 Added: (nutrient-id nutrient)))
164 Added:
165 Added:
166 Added: ;; UPDATE
167 Added:
168 Added: #; (define (update-nutrient-target! nutrient-target
169 Added: #:effective-on [effective-on #f]
170 Added: #:nutrient-values [nutrient-values '()])
171 Added: (define nm-id (nutrient-target-id nutrient-target))
172 Added: (define (nvs-id nm-id)
173 Added: (query-maybe-row (current-conn)
174 Added: (select id
175 Added: #:from nutrient_value_sets
176 Added: #:where (= nutrient_target_id ,nm-id))))
177 Added: (with-tx
178 Added: (when effective-on
179 Added: (query-exec (current-conn)
180 Added: (update nutrient_targets
181 Added: #:set [effective_on ,effective-on]
182 Added: #:where (= id ,id))))
183 Added: (unless (null? nutrient-values)
184 Added: (upsert-nutrient-values nm-id))
185 Added: (get-nutrient-target #:id id)))
186 Added:
187 Added: #; (define (upsert-nutrient-values nutrient-target-id)
188 Added: (define maybe-nvs-id (nvs-id nm-id))
189 Added: (case maybe-nvs-id
190 Added: [(#f)
191 Added: (query-exec (current-conn)
192 Added: (insert #:into nutrient_values_sets
193 Added: #:set
194 Added: [nutrient_target_id ,id]))
195 Added: (define new-nvs-id (nvs-id nm-id))
196 Added: (query-exec (current-conn)
197 Added: (string-join
198 Added: '("INSERT INTO nutrient_values"
199 Added: "VALUES $1 $2 $3"
200 Added: ""))
201 Added: new-nvs-id
202 Added: )]
203 Added: [else
204 Added: (query-exec (current-conn)
205 Added: (update nutrient_target_values
206 Added: #:set [value ,value]
207 Added: #:where (and (= target_id ,target-id)
208 Added: (= nutrient_id ,nutrient-id))))]))
209 Added:
210 Added:
211 Added: ;; DELETE
212 Added:
213 Added: (define (delete-nutrient-target! nutrient-target)
214 Added: (define id (nutrient-target-id nutrient-target))
215 Added: (query-exec (current-conn)
216 Added: (delete #:from nutrient_targets
217 Added: #:where (= id ,id))))
models/nutrient-value-set.rkt
index 00000000..5f3759a0 000000..100644
@@ -0,0 +1,98 @@
1 Added: #lang racket
2 Added:
3 Added: (provide nutrient-value-set
4 Added: nutrient-value-set?
5 Added: nutrient-value-set-id
6 Added: ;; nutrient-value-set-nm-id
7 Added: ;; nutrient-value-set-nt-id
8 Added: ;; nutrient-value-set-cr-id
9 Added: ;; nutrient-value-set-fp-id
10 Added: ;; SQL CRUD
11 Added: (contract-out
12 Added: [create-nutrient-value-set! (-> symbol?
13 Added: exact-nonnegative-integer?
14 Added: (listof (cons/c
15 Added: nutrient?
16 Added: number?))
17 Added: void?)]
18 Added: [get-nutrient-value-set (->* ()
19 Added: (#:id exact-nonnegative-integer?
20 Added: #:nutrient-measurement-id exact-nonnegative-integer?
21 Added: #:nutrient-target-id exact-nonnegative-integer?
22 Added: #:crop-requirement-id exact-nonnegative-integer?
23 Added: #:fertilizer-product-id exact-nonnegative-integer?)
24 Added: (or/c nutrient-value-set? #f))]))
25 Added:
26 Added: (require racket/contract
27 Added: db
28 Added: sql
29 Added: "../db/conn.rkt"
30 Added: "nutrient.rkt")
31 Added:
32 Added: (struct nutrient-value-set (id nm-id nt-id cr-id fp-id) #:transparent)
33 Added:
34 Added:
35 Added: ;; CREATE
36 Added:
37 Added: (define (create-nutrient-value-set! type id nutrient-values)
38 Added: (define nvs (case type
39 Added: [(nutrient-measurement)
40 Added: (query-exec (current-conn)
41 Added: (insert #:into nutrient_value_sets
42 Added: #:set [nutrient_measurement_id ,id]))
43 Added: (get-nutrient-value-set #:nutrient-measurement-id id)]
44 Added: [(nutrient-target)
45 Added: (query-exec (current-conn)
46 Added: (insert #:into nutrient_value_sets
47 Added: #:set [nutrient_target_id ,id]))
48 Added: (get-nutrient-value-set #:nutrient-target-id id)]
49 Added: [(crop-requirement)
50 Added: (query-exec (current-conn)
51 Added: (insert #:into nutrient_value_sets
52 Added: #:set [crop_requirement_id ,id]))
53 Added: (get-nutrient-value-set #:crop-requirement-id id)]
54 Added: [(fertilizer-product)
55 Added: (query-exec (current-conn)
56 Added: (insert #:into nutrient_value_sets
57 Added: #:set [fertilizer_product_id ,id]))
58 Added: (get-nutrient-value-set #:fertilizer-product-id id)]))
59 Added: (for ([nv nutrient-values])
60 Added: (match nv
61 Added: [(cons n v)
62 Added: (query-exec (current-conn)
63 Added: (insert #:into nutrient_values
64 Added: #:set
65 Added: [value_set_id ,(nutrient-value-set-id nvs)]
66 Added: [nutrient_id ,(nutrient-id n)]
67 Added: [value_ppm ,v]))])))
68 Added:
69 Added:
70 Added: ;; READ
71 Added:
72 Added: (define (get-nutrient-value-set #:id [id #f]
73 Added: #:nutrient-measurement-id [nm #f]
74 Added: #:nutrient-target-id [nt #f]
75 Added: #:crop-requirement-id [cr #f]
76 Added: #:fertilizer-product-id [fp #f])
77 Added: (define (where-expr)
78 Added: (define clauses
79 Added: (filter values
80 Added: (list
81 Added: (and id (format "id = ~e" id))
82 Added: (and nm (format "nutrient_measurement_id = ~e" nm))
83 Added: (and nt (format "nutrient_target_id = ~e" nt))
84 Added: (and cr (format "crop_requirement = ~e" cr))
85 Added: (and fp (format "fertilizer_product = ~e" fp)))))
86 Added: (cond
87 Added: [(null? clauses) ""]
88 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
89 Added: (define query (string-join
90 Added: `("SELECT *"
91 Added: "FROM nutrient_value_sets"
92 Added: ,(where-expr)
93 Added: "ORDER BY id ASC"
94 Added: "LIMIT 1")))
95 Added: (match (query-maybe-row (current-conn) query)
96 Added: [(vector id* nm-id* nt-id* cr-id* fp-id*)
97 Added: (nutrient-value-set id* nm-id* nt-id* cr-id* fp-id*)]
98 Added: [#f #f]))
models/nutrient.rkt
index 00000000..5a32e70c 000000..100644
@@ -0,0 +1,123 @@
1 Added: #lang racket
2 Added:
3 Added: (provide
4 Added: ;; Struct definitions
5 Added: nutrient
6 Added: nutrient?
7 Added: nutrient-id nutrient-name nutrient-formula
8 Added: ;; SQL CRUD
9 Added: (contract-out
10 Added: [create-nutrient! (-> string? string? void?)]
11 Added: [get-nutrients (->* ()
12 Added: (#:id (or/c #f exact-nonnegative-integer?)
13 Added: #:name (or/c #f string?)
14 Added: #:formula (or/c #f string?))
15 Added: (listof nutrient?))]
16 Added: [get-nutrient (->* ()
17 Added: (#:id (or/c #f exact-nonnegative-integer?)
18 Added: #:name (or/c #f string?)
19 Added: #:formula (or/c #f string?))
20 Added: (or/c nutrient? #f))]
21 Added: [update-nutrient! (->* (nutrient?)
22 Added: (#:name (or/c #f string?)
23 Added: #:formula (or/c #f string?))
24 Added: (or/c nutrient? #f))]
25 Added: [delete-nutrient! (-> nutrient? void?)]))
26 Added:
27 Added: (require racket/contract
28 Added: db
29 Added: sql
30 Added: "../db/conn.rkt")
31 Added:
32 Added: (struct nutrient (id name formula) #:transparent)
33 Added:
34 Added:
35 Added: ;; CREATE
36 Added:
37 Added: (define (create-nutrient! name formula)
38 Added: (query-exec (current-conn)
39 Added: (insert #:into nutrients
40 Added: #:set [canonical_name ,name] [formula ,formula])))
41 Added:
42 Added:
43 Added: ;; READ
44 Added:
45 Added: (define (get-nutrients #:id [id #f]
46 Added: #:name [name #f]
47 Added: #:formula [formula #f])
48 Added: (define (where-expr)
49 Added: (define clauses
50 Added: (filter values
51 Added: (list
52 Added: (and id (format "id = ~e" id))
53 Added: (and name (format "canonical_name = ~e" name))
54 Added: (and formula (format "formula = ~e" formula)))))
55 Added: (cond
56 Added: [(null? clauses) ""]
57 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
58 Added: (for/list ([(id* name* formula*)
59 Added: (in-query (current-conn)
60 Added: (string-join
61 Added: `("SELECT id, canonical_name, formula"
62 Added: "FROM nutrients"
63 Added: ,(where-expr)
64 Added: "ORDER BY id ASC")))])
65 Added: (nutrient id* name* formula*)))
66 Added:
67 Added: (define (get-nutrient #:id [id #f]
68 Added: #:name [name #f]
69 Added: #:formula [formula #f])
70 Added: (define (where-expr)
71 Added: (define clauses
72 Added: (filter values
73 Added: (list (and id (format "id = ~e" id))
74 Added: (and name (format "canonical_name = ~e" name))
75 Added: (and formula (format "formula = ~e" formula)))))
76 Added: (cond
77 Added: [(null? clauses) ""]
78 Added: [else (format "WHERE ~a" (string-join clauses " AND "))]))
79 Added: (match (query-maybe-row (current-conn)
80 Added: (string-join
81 Added: `("SELECT id, canonical_name, formula"
82 Added: "FROM nutrients"
83 Added: ,(where-expr)
84 Added: "ORDER BY id ASC"
85 Added: "LIMIT 1")))
86 Added: [(vector id* name* formula*)
87 Added: (nutrient id* name* formula*)]
88 Added: [#f #f]))
89 Added:
90 Added:
91 Added: ;; UPDATE
92 Added:
93 Added: (define (update-nutrient! nutrient
94 Added: #:name [name #f]
95 Added: #:formula [formula #f])
96 Added: (define id(nutrient-id nutrient))
97 Added: (cond
98 Added: [(and name formula)
99 Added: (query-exec (current-conn)
100 Added: (update nutrients
101 Added: #:set [canonical_name ,name] [formula ,formula]
102 Added: #:where (= id ,id)))]
103 Added: [name
104 Added: (query-exec (current-conn)
105 Added: (update nutrients
106 Added: #:set [canonical_name ,name]
107 Added: #:where (= id ,id)))]
108 Added: [formula
109 Added: (query-exec (current-conn)
110 Added: (update nutrients
111 Added: #:set [formula ,formula]
112 Added: #:where (= id ,id)))]
113 Added: [else (void)])
114 Added: (or (get-nutrient #:id id)
115 Added: (error 'update-nutrient! "No nutrient with id ~a" id)))
116 Added:
117 Added:
118 Added: ;; DELETE
119 Added:
120 Added: (define (delete-nutrient! nutrient)
121 Added: (query-exec (current-conn)
122 Added: (delete #:from nutrients
123 Added: #:where (= id ,(nutrient-id nutrient)))))
storage/.gitignore
index 00000000..6e9bc0cd 000000..100644
@@ -0,0 +1,1 @@
1 Added: *.sqlite3
tests/nutrient-measurement-model.rkt
index 00000000..b0b053d3 000000..100644
@@ -0,0 +1,72 @@
1 Added: #lang racket
2 Added:
3 Added: (module+ test
4 Added: (require rackunit
5 Added: rackunit/text-ui
6 Added: "../db/conn.rkt"
7 Added: "../db/migrations.rkt"
8 Added: "../models/nutrient.rkt"
9 Added: "../models/nutrient-measurement.rkt")
10 Added:
11 Added: (define measured-on "2025-09-01")
12 Added:
13 Added: (run-tests
14 Added: (test-suite
15 Added: "Nutrient measurement model"
16 Added: #:before (λ ()
17 Added: (connect! #:path 'memory)
18 Added: ;; (connect! #:path "test.sqlite3")
19 Added: (migrate-all!)
20 Added: (create-nutrient! "Nitrogen" "N")
21 Added: (create-nutrient! "Phosphorus" "P")
22 Added: (create-nutrient! "Potassium" "K"))
23 Added: #:after (λ ()
24 Added: (disconnect!))
25 Added:
26 Added: (test-case "Create measurement with values"
27 Added: (define nitrogen (get-nutrient #:name "Nitrogen"))
28 Added: (define phosphorus (get-nutrient #:name "Phosphorus"))
29 Added: (create-nutrient-measurement! measured-on (list
30 Added: (cons nitrogen 12.3)
31 Added: (cons phosphorus 4.5)))
32 Added: (check-equal? (length (get-nutrient-measurements)) 1)
33 Added: (define nm (get-nutrient-measurement #:measured-on measured-on))
34 Added: (check-true (nutrient-measurement? nm))
35 Added: (check-equal? (nutrient-measurement-measured-on nm) measured-on)
36 Added: (define mvs (get-nutrient-measurement-values nm))
37 Added: (check-equal? (length mvs) 2)
38 Added: (check-equal? (cdr (assoc nitrogen mvs)) 12.3)
39 Added: (check-equal? (cdr (assoc phosphorus mvs)) 4.5)
40 Added: )
41 Added:
42 Added: #;(test-case "Update a single measurement value"
43 Added: (define nitrogen (get-nutrient #:name "Nitrogen"))
44 Added: (define nm (get-nutrient-measurement #:measured-on measured-on))
45 Added: (update-nutrient-measurement! nm #:nutrient-values (list (cons nitrogen 1.1)))
46 Added: (define mvs (get-nutrient-measurement-values nm))
47 Added: (check-equal? (length mvs) 2)
48 Added: (check-equal? (cdr (assoc nitrogen mvs)) 1.1))
49 Added:
50 Added: #;(test-case "Upsert measurement values"
51 Added: (define nitrogen (get-nutrient #:name "Nitrogen"))
52 Added: (define phosphorus (get-nutrient #:name "Phosphorus"))
53 Added: (define potassium (get-nutrient #:name "Potassium"))
54 Added: (define nm (get-nutrient-measurement #:measured-on measured-on))
55 Added: ;; Upsert: set K=8.8 and change N to 10.0, keep P as-is
56 Added: (update-nutrient-measurement! nm
57 Added: #:nutrient-values (list
58 Added: (cons nitrogen 10.0)
59 Added: (cons potassium 8.8)))
60 Added: (define mvs (get-nutrient-measurement-values nm))
61 Added: (check-equal? (length mvs) 3)
62 Added: (check-equal? (cdr (assoc nitrogen mvs)) 10.0)
63 Added: (check-equal? (cdr (assoc potassium mvs)) 8.8)
64 Added: ;; P should still be present at 4.5
65 Added: (check-equal? (cdr (assoc phosphorus mvs)) 4.5))
66 Added:
67 Added: (test-case "Delete measurement cascades its values"
68 Added: (define nm (get-nutrient-measurement #:measured-on measured-on))
69 Added: (delete-nutrient-measurement! nm)
70 Added: (check-false (get-nutrient-measurement #:id (nutrient-measurement-id nm)))
71 Added: (check-equal? (length (get-nutrient-measurements)) 0)
72 Added: (check-true (null? (get-nutrient-measurement-values nm)))))))
tests/nutrient-model.rkt
index 00000000..39a574c4 000000..100644
@@ -0,0 +1,76 @@
1 Added: #lang racket
2 Added:
3 Added: (module+ test
4 Added: (require rackunit
5 Added: rackunit/text-ui
6 Added: "../db/conn.rkt"
7 Added: "../db/migrations.rkt"
8 Added: "../models/nutrient.rkt")
9 Added:
10 Added: (run-tests
11 Added: (test-suite
12 Added: "Nutrient model"
13 Added: #:before (λ ()
14 Added: (connect! #:path 'memory)
15 Added: (migrate-all!))
16 Added: #:after (λ ()
17 Added: (disconnect!))
18 Added:
19 Added: (test-case "Create nutrients"
20 Added: (create-nutrient! "Examplium" "Ex")
21 Added: (check-equal? (length (get-nutrients)) 1)
22 Added: (create-nutrient! "Ignorium" "Ig")
23 Added: (check-equal? (length (get-nutrients)) 2))
24 Added:
25 Added: (test-case "Read nutrient"
26 Added: (define examplium (get-nutrient #:id 1))
27 Added: (check-true (nutrient? examplium))
28 Added: (check-equal? (nutrient-id examplium) 1))
29 Added:
30 Added: (test-case "Read nutrient by name"
31 Added: (define examplium (get-nutrient #:name "Examplium"))
32 Added: (check-true (nutrient? examplium))
33 Added: (check-equal? (nutrient-name examplium) "Examplium"))
34 Added:
35 Added: (test-case "Read nutrient by formula"
36 Added: (define examplium (get-nutrient #:formula "Ex"))
37 Added: (check-true (nutrient? examplium))
38 Added: (check-equal? (nutrient-formula examplium) "Ex"))
39 Added:
40 Added: (test-case "Read inexisting nutrient"
41 Added: (check-false (get-nutrient #:name "Inexistium")))
42 Added:
43 Added: (test-case "Update nutrient name"
44 Added: (define examplium (get-nutrient #:name "Examplium"))
45 Added: (define examplium-nitrate
46 Added: (update-nutrient! examplium #:name "Examplium Nitrate"))
47 Added: (check-equal? (length (get-nutrients)) 2)
48 Added: (check-equal? (nutrient-name examplium-nitrate) "Examplium Nitrate")
49 Added: (check-equal? (nutrient-formula examplium-nitrate) "Ex"))
50 Added:
51 Added: (test-case "Update nutrient formula"
52 Added: (define examplium-nitrate (get-nutrient #:name "Examplium Nitrate"))
53 Added: (define examplium-sulfate
54 Added: (update-nutrient! examplium-nitrate #:formula "ExSO4"))
55 Added: (check-equal? (length (get-nutrients)) 2)
56 Added: (check-equal? (nutrient-name examplium-sulfate) "Examplium Nitrate")
57 Added: (check-equal? (nutrient-formula examplium-sulfate) "ExSO4"))
58 Added:
59 Added: (test-case "Update nutrient name and formula"
60 Added: (define examplium-nitrate
61 Added: (get-nutrient #:name "Examplium Nitrate"))
62 Added: (define examplium-sulfate
63 Added: (update-nutrient! examplium-nitrate
64 Added: #:name "Examplium Sulfate"
65 Added: #:formula "ExNO3"))
66 Added: (check-equal? (length (get-nutrients)) 2)
67 Added: (check-equal? (nutrient-name examplium-sulfate) "Examplium Sulfate")
68 Added: (check-equal? (nutrient-formula examplium-sulfate) "ExNO3"))
69 Added:
70 Added: (test-case "Delete nutrient"
71 Added: (define examplium-sulfate (get-nutrient #:name "Examplium Sulfate"))
72 Added: (delete-nutrient! examplium-sulfate)
73 Added: (check-equal? (length (get-nutrients)) 1)
74 Added: (define ignorium (get-nutrient #:name "Ignorium"))
75 Added: (delete-nutrient! ignorium)
76 Added: (check-equal? (length (get-nutrients)) 0)))))
views.rkt
index 00000000..d78c3705 000000..100644
@@ -0,0 +1,152 @@
1 Added: #lang racket
2 Added:
3 Added: (provide index-page
4 Added: new-measurement-page
5 Added: fallback-page)
6 Added:
7 Added: (require web-server/formlets
8 Added: "formlets.rkt"
9 Added: "models/nutrient.rkt"
10 Added: "models/nutrient-measurement.rkt")
11 Added:
12 Added:
13 Added: (define (page-template title body-xexpr)
14 Added: `(html
15 Added: (head
16 Added: (meta ([charset "utf-8"]))
17 Added: (meta ([name "viewport"] [content "width=device-width, initial-scale=1"]))
18 Added: (title ,title)
19 Added: ;; Bootstrap CSS
20 Added: (link ([href "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/css/bootstrap.min.css"]
21 Added: [rel "stylesheet"]
22 Added: [integrity "sha384-QWTKZyjpPEjISv5WaRU9OFeRpok6YctnYmDr5pNlyT2bRjXh0JMhjY6hW+ALEwIH"]
23 Added: [crossorigin "anonymous"])))
24 Added: (body
25 Added: ,navbar
26 Added: (div ([class "container"])
27 Added: ,@body-xexpr)
28 Added: ;; Bootstrap JS bundle
29 Added: (script ([src "https://cdn.jsdelivr.net/npm/bootstrap@5.3.3/dist/js/bootstrap.bundle.min.js"]
30 Added: [integrity "sha384-YvpcrYf0tY3lHB60NNkmXc5s9fDVZLESaAA55NDzOxhy9GkcIdslK1eN7N6jIeHz"]
31 Added: [crossorigin "anonymous"])))))
32 Added:
33 Added:
34 Added: ;; Page components
35 Added:
36 Added: (define navbar
37 Added: '(nav ([class "navbar"])
38 Added: (div ([class "container-fluid"])
39 Added: (a ([class "navbar-brand"] [href "/"]) "FAPG")
40 Added: (button ([class "navbar-toggler"]
41 Added: [type "button"]
42 Added: [data-bs-toggle "collapse"]
43 Added: [data-bs-target "#navbarNav"]
44 Added: [aria-controls "navbarNav"]
45 Added: [aria-expanded "false"]
46 Added: [aria-label "Toggle navigation"])
47 Added: (span ([class "navbar-toggler-icon"])))
48 Added: (div ([class "collapse navbar-collapse"] [id "navbarNav"])
49 Added: (ul ([class "navbar-nav"])
50 Added: (li ([class "nav-item"])
51 Added: (a ([class "nav-link active"]
52 Added: [aria-current "page"]
53 Added: [href "/"])
54 Added: "Home"))
55 Added: (li ([class "nav-item"])
56 Added: (a ([class "nav-link"]
57 Added: [href "/about"])
58 Added: "About"))
59 Added: (li ([class "nav-item"])
60 Added: (a ([class "nav-link"]
61 Added: [href "/contact"])
62 Added: "Contact")))))))
63 Added:
64 Added:
65 Added: ;; Page helpers
66 Added:
67 Added: (define (round n number)
68 Added: (~r number #:precision n))
69 Added:
70 Added:
71 Added: ;; Pages
72 Added:
73 Added: (define (index-page measurements)
74 Added: (page-template
75 Added: "Ferti"
76 Added: `((h1 ([class "display-1 mb-3"]) "Ferti")
77 Added: (a ([class "btn btn-primary mb-3"] [href "/target/new"]) "Créer une cible")
78 Added: (table ([class "table"])
79 Added: (tr (th "Nutriment")
80 Added: (th ([class "text-end"]) "Dernière Cible")
81 Added: (th ([class "text-end"]) "Dernier Relevé")
82 Added: (th ([class "text-end"]) "Delta (%)"))
83 Added: ,@(for/list ([n (get-nutrients)])
84 Added: (define latest-target (+ (get-latest-nutrient-measurement-value n) 1))
85 Added: (define latest-value (get-latest-nutrient-measurement-value n))
86 Added: (define delta (* 100
87 Added: (/ (- latest-target latest-value)
88 Added: latest-target)))
89 Added: `(tr (td ,(nutrient-name n))
90 Added: (td ([class "text-end"]) ,(round 2 latest-target))
91 Added: (td ([class "text-end"]) ,(round 2 latest-value))
92 Added: (td ([class "text-end"]) ,(round 1 delta)))))
93 Added:
94 Added: (a ([class "btn btn-primary mb-3"] [href "/measurement/new"]) "Ajouter un relevé")
95 Added: (table ([class "table table-striped"])
96 Added: (tr (th "Date")
97 Added: (th ([class "text-end"]) "N")
98 Added: (th ([class "text-end"]) "P")
99 Added: (th ([class "text-end"]) "K"))
100 Added: ,@(for/list ([m measurements])
101 Added: (define measured-on (nutrient-measurement-measured-on m))
102 Added: (define-values (n p k)
103 Added: (apply values
104 Added: (for/list ([nutrient '("Nitrate Nitrogen" "Phosphorus" "Potassium")])
105 Added: (define n (get-nutrient #:name nutrient))
106 Added: (define mnv (get-nutrient-measurement-value m n))
107 Added: (if (real? mnv)
108 Added: (round 2 mnv)
109 Added: "—"))))
110 Added: `(tr (td ,measured-on)
111 Added: (td ([class "text-end font-monospace"]) ,n)
112 Added: (td ([class "text-end font-monospace"]) ,p)
113 Added: (td ([class "text-end font-monospace"]) ,k)))))))
114 Added:
115 Added: (define (new-measurement-page)
116 Added: (page-template
117 Added: "Nouveau relevé"
118 Added: `((h1 ([class "display-1 mb-3"]) "Nouveau relevé")
119 Added: (div ([class "mb-3"] [style "max-width: 30em"])
120 Added: (form
121 Added: ([action "/measurement/create"]
122 Added: [method "POST"])
123 Added: ,@(formlet-display (measurements-formlet)))))))
124 Added:
125 Added: (define (fallback-page request-code)
126 Added: (page-template
127 Added: (format "Réponse: ~a" request-code)
128 Added: `((h1 ([class "display-1 text-danger"]) ,(number->string request-code))
129 Added: (p ,(fallback-message request-code))
130 Added: (a ([href "/"]) "Revenir à la page d'accueil"))))
131 Added:
132 Added: (define (fallback-message request-code)
133 Added: (string-join
134 Added: `("Bonjour, je suis votre serveur."
135 Added: ,(format "J'ai répondu '~a'" request-code)
136 Added: "et"
137 Added: ,(case (string-ref (number->string request-code) 0)
138 Added: [(#\4) "c'est de votre faute, malheureusement."]
139 Added: [(#\5) "c'est de ma faute, pardonnez-moi."]
140 Added: [else "je ne sais pas qui est en tort."])
141 Added: ,(case request-code
142 Added: ;; Client errors
143 Added: [(400) "Votre requête ne fait pas sens."]
144 Added: [(401) "Vous n'avez pas vérifié votre identité."]
145 Added: [(403) "Vous n'avez pas le droit de consulter cette page."]
146 Added: [(404) "Vous avez demandé de consulter une page qui n'existe pas."]
147 Added: ;; Server errors
148 Added: [(500) "Je suis dans une situation que je ne sais pas gérer, et ne peux vous en dire davantage."]
149 Added: [(502) "Un tiers ne m'a pas transmis les informations nécessaires pour répondre à votre requête."]
150 Added: [(503) "Je ne peux pas vous aider, il se peut que je sois momentanément surchargé. Revenez plus tard."]
151 Added: ;; Fallback message
152 Added: [else (format "Je ne sais pas encore interpréter le code ~a." request-code)]))))