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
|
#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])
(contract-out [create-crop-rotation!
(-> string? requirement-proportion-hash/c 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) #:transparent)
(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)
(or (get-crop-rotation #:date rotation-date)
(with-tx
(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 (get-crop-requirement #:id requirement-id) proportion)))
(define (grouped-row->crop-rotation grouped-row)
(match-define (vector cr-id cr-rotation-date residuals) grouped-row)
(crop-rotation cr-id cr-rotation-date (residuals->requirement-proportion-hash residuals)))
(define (get-crop-rotations)
(define grouped-rows
(query-rows (current-conn)
(select cr.id
cr.rotation_date
crr.crop_requirement_id
crr.proportion_percent
#:from (TableExpr:AST ,joined)
#:order-by cr.rotation_date
#:desc)
#:group '#(0 1)))
(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
crr.crop_requirement_id
crr.proportion_percent
#:from (TableExpr:AST ,joined)
#:where (ScalarExpr:AST ,where)
#:order-by cr.rotation_date
#:desc)
#:group '#(0 1)))
(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)))))
|
