From 57933beea0d308588968a6a11ec5a28c0467e224 Mon Sep 17 00:00:00 2001 From: Marius Peter Date: Sat, 13 Dec 2025 22:45:27 +0100 Subject: Measurements and fertilizers can now be persisted 2 ways. --- models/fertilizer-product.rkt | 24 +++++++++++++++--------- models/nutrient-measurement.rkt | 14 ++++++++++++-- 2 files changed, 27 insertions(+), 11 deletions(-) (limited to 'models') diff --git a/models/fertilizer-product.rkt b/models/fertilizer-product.rkt index e79a707..652b3c4 100644 --- a/models/fertilizer-product.rkt +++ b/models/fertilizer-product.rkt @@ -7,7 +7,9 @@ (rename-out [fertilizer-product-canonical-name fertilizer-product-name] [fertilizer-product-nutrient-values fertilizer-product-values] [fertilizer-product-brand-name fertilizer-brand-name]) - (contract-out [create-fertilizer-product! (-> fertilizer-product? fertilizer-product?)] + (contract-out [create-fertilizer-product! + (case-> (-> fertilizer-product? fertilizer-product?) + (-> string? string? nutrient-value-hash/c fertilizer-product?))] [get-fertilizer-products (-> (listof fertilizer-product?))] [get-fertilizer-product (->* () (#:id db-id? #:canonical-name string?) (or/c fertilizer-product? #f))] @@ -56,7 +58,14 @@ ;; CREATE -(define (create-fertilizer-product! fp) +(define create-fertilizer-product! + (case-lambda + [(fp) (create-fertilizer-product!/fp fp)] + [(canonical-name brand-name nutrient-values) + (create-fertilizer-product!/fp + (fertilizer-product #f canonical-name brand-name nutrient-values))])) + +(define (create-fertilizer-product!/fp fp) (define canonical-name (fertilizer-product-canonical-name fp)) (define brand-name (fertilizer-product-brand-name fp)) (define nutrient-values (fertilizer-product-nutrient-values fp)) @@ -196,10 +205,9 @@ (define nitrogen (get-nutrient #:name "Nitrogen")) (define phosphorus (get-nutrient #:name "Phosphorus")) - (create-fertilizer-product! (fertilizer-product #f - canonical-product-name - "MasterBlend" - (hash nitrogen 40 phosphorus 200))) + (create-fertilizer-product! canonical-product-name + "MasterBlend" + (hash nitrogen 40 phosphorus 200)) (check-equal? (length (get-fertilizer-products)) 1) @@ -238,9 +246,7 @@ (test-case "Custom write property formatting" (define nitrogen (get-nutrient #:name "Nitrogen")) - (define fp - (create-fertilizer-product! - (fertilizer-product #f "Test Fertilizer" "TestBrand" (hash nitrogen 50)))) + (define fp (create-fertilizer-product! "Test Fertilizer" "TestBrand" (hash nitrogen 50))) (define output (open-output-string)) (write fp output) diff --git a/models/nutrient-measurement.rkt b/models/nutrient-measurement.rkt index f4bfa8e..fea7b89 100644 --- a/models/nutrient-measurement.rkt +++ b/models/nutrient-measurement.rkt @@ -7,7 +7,9 @@ (rename-out [nutrient-measurement-measurement-date nutrient-measurement-date] [nutrient-measurement-nutrient-values nutrient-measurement-values]) (contract-out - [create-nutrient-measurement! (-> string? nutrient-value-hash/c nutrient-measurement?)] + [create-nutrient-measurement! + (case-> (-> nutrient-measurement? nutrient-measurement?) + (-> string? nutrient-value-hash/c nutrient-measurement?))] [get-nutrient-measurements (-> (listof nutrient-measurement?))] [get-nutrient-measurement (->* () (#:id db-id? #:date string?) (or/c nutrient-measurement? #f))] @@ -51,7 +53,15 @@ ;; CREATE -(define (create-nutrient-measurement! measurement-date nutrient-values) +(define create-nutrient-measurement! + (case-lambda + [(nm) (create-nutrient-measurement!/nm nm)] + [(measurement-date nutrient-values) + (create-nutrient-measurement!/nm (nutrient-measurement #f measurement-date nutrient-values))])) + +(define (create-nutrient-measurement!/nm nm) + (define measurement-date (nutrient-measurement-measurement-date nm)) + (define nutrient-values (nutrient-measurement-nutrient-values nm)) (with-tx (define nm-id (insert-id (query (current-conn) (insert #:into nutrient_measurements -- cgit v1.2.3