blob: 44305438b229d452a6cfcdd4b560befc5e427d59 (
plain)
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
139
140
141
142
143
144
|
#lang racket
(provide crop
crop?
crop-id
crop-name
(contract-out [create-crop! (-> crop? crop?)]
[get-crops (-> (listof crop?))]
[get-crop (->* () (#:id db-id? #:name string?) (or/c crop? #f))]
[update-crop! (-> crop? void?)]
[delete-crop! (-> db-id? void?)]))
(require db
sql
"../db/conn.rkt"
"utils.rkt")
(struct crop (id name) #:transparent)
;; CREATE
(define (create-crop! c)
(define name (crop-name c))
(or (get-crop #:name name)
(with-tx (query-exec (current-conn) (insert #:into crops #:set [canonical_name ,name]))
(get-crop #:name name))))
;; READ
(define (get-crops)
(for/list ([(id* name*) (in-query (current-conn)
(select id canonical_name #:from crops #:order-by id #:asc))])
(crop id* name*)))
(define (get-crop #:id [id #f] #:name [name #f])
(define where
(cond
[(and id name) (scalar-expr-qq (and (= id ,id) (= canonical_name ,name)))]
[id (scalar-expr-qq (= id ,id))]
[name (scalar-expr-qq (= canonical_name ,name))]))
(define query
(select id
canonical_name
#:from crops
#:where (ScalarExpr:AST ,where)
#:order-by id
#:asc
#:limit 1))
(match (query-maybe-row (current-conn) query)
[(vector id* name*) (crop id* name*)]
[#f #f]))
;; UPDATE
(define (update-crop! c)
(define id (or (crop-id c) (raise-argument-error 'update-crop! "db-id?" (crop-id c))))
(with-tx (query-exec (current-conn)
(update crops #:set [canonical_name ,(crop-name c)] #:where [= id ,id]))))
;; DELETE
(define (delete-crop! id)
(query-exec (current-conn) (delete #:from crops #:where (= id ,id))))
(module+ test
(require rackunit
rackunit/text-ui
"../db/conn.rkt"
"../db/migrations.rkt")
(define test-crop-name "examplium-plant")
(run-tests (test-suite "Crop model"
#:before (λ ()
(connect! #:path 'memory)
(migrate-all!))
#:after (λ () (disconnect!))
(test-case "Create crop"
(check-equal? (length (get-crops)) 0)
(define c1 (create-crop! (crop #f test-crop-name)))
(check-equal? (length (get-crops)) 1)
(check-true (crop? c1))
(check-equal? (crop-name c1) test-crop-name)
(check-true (db-id? (crop-id c1))))
(test-case "Create duplicate crop returns existing"
(define c1 (create-crop! (crop #f test-crop-name)))
(define c2 (create-crop! (crop #f test-crop-name)))
(check-equal? (length (get-crops)) 1)
(check-equal? (crop-id c1) (crop-id c2))
(check-equal? c1 c2))
(test-case "Get crop by id"
(define c1 (get-crop #:name test-crop-name))
(define c2 (get-crop #:id (crop-id c1)))
(check-equal? c1 c2))
(test-case "Get crop by name"
(define c (get-crop #:name test-crop-name))
(check-true (crop? c))
(check-equal? (crop-name c) test-crop-name))
(test-case "Get crop with both id and name"
(define c1 (get-crop #:name test-crop-name))
(define c2 (get-crop #:id (crop-id c1) #:name test-crop-name))
(check-equal? c1 c2))
(test-case "Get non-existent crop"
(check-false (get-crop #:name "non-existent-crop"))
(check-false (get-crop #:id 9999)))
(test-case "Get all crops"
(create-crop! (crop #f "ignorium-plant"))
(create-crop! (crop #f "testium-plant"))
(define crops (get-crops))
(check-equal? (length crops) 3)
(check-true (andmap crop? crops)))
(test-case "Update crop name"
(define c1 (get-crop #:name test-crop-name))
(define updated-crop (crop (crop-id c1) "examplium-updated"))
(update-crop! updated-crop)
(define c2 (get-crop #:id (crop-id c1)))
(check-equal? (crop-name c2) "examplium-updated")
(check-equal? (crop-id c1) (crop-id c2))
(check-equal? (length (get-crops)) 3))
(test-case "Update crop with invalid id raises error"
(define invalid-crop (crop #f "invalid"))
(check-exn exn:fail:contract? (λ () (update-crop! invalid-crop))))
(test-case "Delete crop"
(define c (get-crop #:name "ignorium-plant"))
(delete-crop! (crop-id c))
(check-false (get-crop #:id (crop-id c)))
(check-equal? (length (get-crops)) 2))
(test-case "Delete crop by id"
(define c (get-crop #:name "testium-plant"))
(define crop-id-val (crop-id c))
(delete-crop! crop-id-val)
(check-false (get-crop #:id crop-id-val))
(check-equal? (length (get-crops)) 1)))))
|
