1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
#lang racket
(provide crop-rotation
crop-rotation?
crop-rotation-id
(rename-out [crop-rotation-rotation-date crop-rotation-date]
[crop-rotation-requirement-proportions crop-rotation-requirements]
[crop-rotation-nutrient-measurement-id crop-rotation-measurement-id])
(contract-out [create-crop-rotation!
(->* (string? requirement-proportion-hash/c)
(#:nutrient-measurement exact-nonnegative-integer?)
crop-rotation?)]
[get-crop-rotations (-> (listof crop-rotation?))]
[get-crop-rotation
(->* () (#:id crop-rotation-id? #:date string?) (or/c crop-rotation? #f))]
[get-latest-crop-rotation (-> (or/c crop-rotation? #f))]
[delete-crop-rotation! (-> crop-rotation-or-id/c void?)]))
(require racket/contract
db
sql
"../db/conn.rkt"
"nutrient.rkt"
"crop-requirement.rkt")
(struct crop-rotation (id rotation-date requirement-proportions nutrient-measurement-id)
#:transparent
#:guard (λ (id rotation-date requirement-proportions nutrient-measurement-id _)
(values id
rotation-date
requirement-proportions
(if (sql-null? nutrient-measurement-id) #f nutrient-measurement-id))))
(define crop-rotation-id? exact-nonnegative-integer?)
(define crop-rotation-or-id/c (or/c crop-rotation? crop-rotation-id?))
(define requirement-proportion-hash/c (hash/c crop-requirement? (between/c 0 100) #:immutable #t))
(define (->cr-id cr-or-id)
(match cr-or-id
[(? crop-rotation-id? id) id]
[(crop-rotation id _ _ _) id]
[#f (error '->nt-id "#f can not be converted to an id")]))
;; CREATE
(define (create-crop-rotation! rotation-date
requirement-proportions
#:nutrient-measurement [nutrient-measurement-id #f])
(or (get-crop-rotation #:date rotation-date)
(with-tx
(if nutrient-measurement-id
(query-exec (current-conn)
(insert #:into crop_rotations
#:set [rotation_date ,rotation-date]
[nutrient_measurement_id ,nutrient-measurement-id]))
(query-exec (current-conn)
(insert #:into crop_rotations #:set [rotation_date ,rotation-date])))
(define cr-id
(query-value (current-conn)
(select id #:from crop_rotations #:where (= rotation_date ,rotation-date))))
(for ([(r p) (in-hash requirement-proportions)])
(query-exec (current-conn)
(insert #:into crop_rotation_requirements
#:set [crop_rotation_id ,cr-id]
[crop_requirement_id ,(crop-requirement-id r)]
[proportion_percent ,p])))
(get-crop-rotation #:date rotation-date))))
;; READ
(define joined
(table-expr-qq (inner-join (as crop_rotations cr)
(as crop_rotation_requirements crr)
#:on (= crr.crop_rotation_id cr.id))))
(define (residuals->requirement-proportion-hash residuals)
(for/hash ([r (in-list residuals)])
(match-define (vector requirement-id proportion) r)
(values requirement-id proportion)))
(define (grouped-row->crop-rotation grouped-row)
(match-define (vector cr-id cr-rotation-date cr-nutrient-measurement-id residuals) grouped-row)
(crop-rotation cr-id
cr-rotation-date
(residuals->requirement-proportion-hash residuals)
cr-nutrient-measurement-id))
(define (get-crop-rotations)
(define grouped-rows
(query-rows (current-conn)
(select cr.id
cr.rotation_date
cr.nutrient_measurement_id
crr.crop_requirement_id
crr.proportion_percent
#:from (TableExpr:AST ,joined)
#:order-by cr.rotation_date
#:desc)
#:group '#(0 1 2)))
(map grouped-row->crop-rotation grouped-rows))
(define (get-crop-rotation #:id [cr-id #f] #:date [rotation-date #f])
(define where
(cond
[(and cr-id rotation-date)
(scalar-expr-qq (and (= cr.id ,cr-id) (= cr.rotation_date ,rotation-date)))]
[cr-id (scalar-expr-qq (= cr.id ,cr-id))]
[rotation-date (scalar-expr-qq (= cr.rotation_date ,rotation-date))]
[else (error 'get-crop-rotation "either #:id or #:date must be provided")]))
(define grouped-rows
(query-rows (current-conn)
(select cr.id
cr.rotation_date
cr.nutrient_measurement_id
crr.crop_requirement_id
crr.proportion_percent
#:from (TableExpr:AST ,joined)
#:where (ScalarExpr:AST ,where)
#:order-by cr.rotation_date
#:desc)
#:group '#(0 1 2)))
(match grouped-rows
['() #f]
[(list grouped-row) (grouped-row->crop-rotation grouped-row)]
[many (error 'get-crop-rotation "expected 1 nutrient target, got ~a" (length many))]))
(define (get-latest-crop-rotation)
(define rotations (get-crop-rotations))
(if (null? rotations)
#f
(first rotations)))
;; UPDATE
;; DELETE
(define (delete-crop-rotation! cr-or-id)
(query-exec (current-conn) (delete #:from crop_rotations #:where (= id ,(->cr-id cr-or-id)))))
|
