summaryrefslogtreecommitdiff
path: root/models/crop.rkt
blob: acb5afb9059f8f87dbcd3fe948485818b4fea692 (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
#lang racket

(provide
 ;; Struct definitions
 crop
 crop?
 crop-id crop-name
 ;; SQL CRUD
 (contract-out
  [create-crop! (-> string? void?)]
  [get-crops (-> (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)
  (define existing-crop (get-crop #:name name))
  (define (new-crop)
    (query-exec (current-conn)
                (insert #:into crops
                        #:set [canonical_name ,name])))
  (or existing-crop
      (new-crop)))


;; 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-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))))
Copyright 2019--2025 Marius PETER