blob: 7163cbd2d181371911cf0ea73968abf213df0fd1 (
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
|
#lang racket
(provide
;; Struct definitions
crop
crop?
crop-id crop-name
;; SQL CRUD
(contract-out
[create-crop! (-> string? void?)]
[get-crops (->* ()
(#:id (or/c #f exact-nonnegative-integer?)
#:name (or/c #f string?))
(listof crop?))]
[get-crop (->* ()
(#:id (or/c #f exact-nonnegative-integer?)
#:name (or/c #f string?))
(or/c crop? #f))]
[update-crop! (->* (exact-nonnegative-integer?)
(#:name (or/c #f string?))
(or/c crop? #f))]
[delete-crop! (-> exact-nonnegative-integer? void?)]))
(require racket/contract
db
sql
"../db/conn.rkt")
(struct crop (id name) #:transparent)
;; CREATE
(define (create-crop! name)
(query-exec (current-conn)
(insert #:into crops
#:set [canonical_name ,name])))
;; READ
(define (get-crops #:id [id #f]
#:name [name #f])
(define (where-expr)
(define clauses
(filter values
(list
(and id (format "id = ~e" id))
(and name (format "canonical_name = ~e" name)))))
(cond
[(null? clauses) ""]
[else (format "WHERE ~a" (string-join clauses " AND "))]))
(define query (string-join
`("SELECT id, canonical_name"
"FROM crops"
,(where-expr)
"ORDER BY id ASC")))
(for/list ([(id* name*)
(in-query (current-conn) query)])
(crop id* name*)))
(define (get-crop #:id [id #f]
#:name [name #f])
(define (where-expr)
(define clauses
(filter values
(list (and id (format "id = ~e" id))
(and name (format "canonical_name = ~e" name)))))
(cond
[(null? clauses) ""]
[else (format "WHERE ~a" (string-join clauses " AND "))]))
(define query (string-join
`("SELECT id, canonical_name"
"FROM crops"
,(where-expr)
"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! id
#:name [name #f])
(cond
[name
(query-exec (current-conn)
(update crops
#:set [canonical_name ,name]
#:where (= id ,id)))]
[else (void)])
(or (get-crop #:id id)
(error 'update-crop! "No crop with id ~a" id)))
;; DELETE
(define (delete-crop! id)
(query-exec (current-conn)
(delete #:from crops #:where (= id ,id))))
|
