blob: b37ec47f237e9121a26acf5b9fc36f38c4b45df5 (
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
|
#lang racket
(provide crop
crop?
crop-id
crop-name
(contract-out [create-crop! (-> string? crop?)]
[get-crops (-> (listof crop?))]
[get-crop (->* () (#:id db-id? #:name string?) (or/c crop? #f))]
[update-crop! (->* (db-id?) (#:name string?) (or/c crop? #f))]
[delete-crop! (-> db-id? void?)]))
(require db
sql
"../db/conn.rkt"
"utils.rkt")
(struct crop (id name) #:transparent)
;; CREATE
(define (create-crop! name)
(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! 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))))
|
