diff options
Diffstat (limited to 'models')
| -rw-r--r-- | models/crop-requirement.rkt | 69 |
1 files changed, 50 insertions, 19 deletions
diff --git a/models/crop-requirement.rkt b/models/crop-requirement.rkt index 803578c..2dd8071 100644 --- a/models/crop-requirement.rkt +++ b/models/crop-requirement.rkt @@ -5,13 +5,18 @@ crop-requirement-id crop-requirement-profile crop-requirement-crop-id + crop-requirement-value (rename-out [crop-requirement-nutrient-values crop-requirement-values]) (contract-out - [create-crop-requirement! (->* (string? nutrient-value-hash/c) (crop?) crop-requirement?)] + [create-crop-requirement! + (case-> (-> crop-requirement? crop-requirement?) + (-> string? nutrient-value-hash/c crop-requirement?) + (-> string? nutrient-value-hash/c crop? crop-requirement?))] [get-crop-requirements (-> (listof crop-requirement?))] [get-crop-requirement (->* () (#:id db-id? #:profile string?) (or/c crop-requirement? #f))] [get-crop-requirement-values (-> crop-requirement-or-id/c nutrient-value-hash/c)] [get-crop-requirement-value (-> crop-requirement-or-id/c nutrient? maybe-nutrient-value?)] + [update-crop-requirement! (-> crop-requirement? void?)] [delete-crop-requirement! (-> crop-requirement-or-id/c void?)] [average-crop-requirement-nutrient-values (-> (hash/c crop-requirement? (between/c 0 100)) nutrient-value-hash/c)])) @@ -29,6 +34,9 @@ #:guard (λ (id profile crop-id nutrient-values _) (values id profile (if (sql-null? crop-id) #f crop-id) nutrient-values))) +(define (crop-requirement-value cr nutrient) + (hash-ref (crop-requirement-nutrient-values cr) nutrient #f)) + (define crop-requirement-or-id/c (or/c crop-requirement? db-id?)) (define (->cr-id cr-or-id) @@ -38,24 +46,30 @@ ;; CREATE -(define (create-crop-requirement! profile nutrient-values [crop #f]) - (with-tx - (define cr-id - (insert-id - (query (current-conn) - (if crop - (insert #:into crop_requirements #:set [crop_id ,(crop-id crop)] [profile ,profile]) - (insert #:into crop_requirements #:set [profile ,profile]))))) - (define nvs-id - (insert-id (query (current-conn) - (insert #:into nutrient_value_sets #:set [crop_requirement_id ,cr-id])))) - (insert-nutrient-values (current-conn) nvs-id nutrient-values) - (crop-requirement cr-id - profile - (if crop - (crop-id crop) - #f) - nutrient-values))) +(define create-crop-requirement! + (case-lambda + [(cr) (create-crop-requirement!/cr cr)] + [(profile nutrient-values) + (create-crop-requirement!/cr (crop-requirement #f profile #f nutrient-values))] + [(profile nutrient-values crop) + (create-crop-requirement!/cr (crop-requirement #f profile (crop-id crop) nutrient-values))])) + +(define (create-crop-requirement!/cr cr) + (define profile (crop-requirement-profile cr)) + (define nutrient-values (crop-requirement-nutrient-values cr)) + (define crop-id (crop-requirement-crop-id cr)) + (with-tx (define cr-id + (insert-id + (query (current-conn) + (if crop-id + (insert #:into crop_requirements #:set [crop_id ,crop-id] [profile ,profile]) + (insert #:into crop_requirements #:set [profile ,profile]))))) + (define nvs-id + (insert-id (query (current-conn) + (insert #:into nutrient_value_sets + #:set [crop_requirement_id ,cr-id])))) + (insert-nutrient-values (current-conn) nvs-id nutrient-values) + (crop-requirement cr-id profile crop-id nutrient-values))) ;; READ @@ -135,6 +149,23 @@ ;; UPDATE +(define (update-crop-requirement! cr) + (define id + (or (crop-requirement-id cr) + (raise-argument-error 'update-crop-requirement! "db-id?" (crop-requirement-id cr)))) + (define profile (crop-requirement-profile cr)) + (define crop-id (crop-requirement-crop-id cr)) + (with-tx + (query-exec + (current-conn) + (if crop-id + (update crop_requirements #:set [profile ,profile] [crop_id ,crop-id] #:where [= id ,id]) + (update crop_requirements #:set [profile ,profile] #:where [= id ,id]))) + (define nvs-id + (query-value (current-conn) + (select id #:from nutrient_value_sets #:where [= crop_requirement_id ,id]))) + (update-nutrient-values! (current-conn) nvs-id (crop-requirement-nutrient-values cr)))) + ;; DELETE (define (delete-crop-requirement! cr-or-id) |